Repository: hasura/graphql-engine
File: server/src-lib/Hasura/RQL/DDL/Schema.hs (Haskell)

Code before:
import qualified Data.Text                      as T
import qualified Data.Text.Encoding             as TE
import qualified Database.PG.Query              as Q
import qualified Database.PostgreSQL.LibPQ      as PQ

import           Data.Aeson
import           Data.Aeson.Casing
import           Data.Aeson.TH
import           Language.Haskell.TH.Syntax     (Lift)

import           Hasura.EncJSON
import           Hasura.RQL.DDL.Schema.Cache
import           Hasura.RQL.DDL.Schema.Catalog
import           Hasura.RQL.DDL.Schema.Function
import           Hasura.RQL.DDL.Schema.Rename
import           Hasura.RQL.DDL.Schema.Table
import           Hasura.RQL.Instances           ()
import           Hasura.RQL.Types
import           Hasura.Server.Utils            (matchRegex)

data RunSQL
  = RunSQL
  { rSql                      :: Text
  , rCascade                  :: !Bool
  , rCheckMetadataConsistency :: !(Maybe Bool)
  , rReadOnly                 :: !Bool
  } deriving (Show, Eq, Lift)

instance FromJSON RunSQL where
  parseJSON (Object o) = do
    rSql <- o .: "sql"
    rCascade <- o .:? "cascade" .!= False
    rCheckMetadataConsistency <- o .:? "check_metadata_consistency"
    rReadOnly <- o .:? "read_only" .!= False
    pure RunSQL{..}
  parseJSON _ = fail "expecting an object for args"

$(deriveToJSON (aesonDrop 1 snakeCase){omitNothingFields=True} ''RunSQL)

runRunSQL :: (CacheBuildM m, UserInfoM m) => RunSQL -> m EncJSON
runRunSQL RunSQL {..} = do
  adminOnly
  metadataCheckNeeded <- onNothing rCheckMetadataConsistency $ isAltrDropReplace rSql
  bool (execRawSQL rSql) (withMetadataCheck rCascade $ execRawSQL rSql) metadataCheckNeeded
  where
    execRawSQL :: (MonadTx m) => Text -> m EncJSON
    execRawSQL =
      fmap (encJFromJValue @RunSQLRes) . liftTx . Q.multiQE rawSqlErrHandler . Q.fromText
      where
        rawSqlErrHandler txe =
          let e = err400 PostgresError "query execution failed"

Review comment (suggestion):
Since we have the custom `FromJSON` instance now, anyway, why not make the type of this field `Q.TxAccess` instead of `Bool`? 😄 Or if you’d rather not need to write the `ToJSON` instance by hand, you could add a `newtype IsReadOnly = IsReadOnly (Q.TxAccess)` with custom `ToJSON`/`FromJSON` instances, like we already have with the `SystemDefined` type.

Code after:
import qualified Data.Text                      as T
import qualified Data.Text.Encoding             as TE
import qualified Database.PG.Query              as Q
import qualified Database.PostgreSQL.LibPQ      as PQ

import           Data.Aeson
import           Data.Aeson.Casing
import           Data.Aeson.TH
import           Language.Haskell.TH.Syntax     (Lift)

import           Hasura.EncJSON
import           Hasura.RQL.DDL.Schema.Cache
import           Hasura.RQL.DDL.Schema.Catalog
import           Hasura.RQL.DDL.Schema.Function
import           Hasura.RQL.DDL.Schema.Rename
import           Hasura.RQL.DDL.Schema.Table
import           Hasura.RQL.Instances           ()
import           Hasura.RQL.Types
import           Hasura.Server.Utils            (matchRegex)

data RunSQL
  = RunSQL
  { rSql                          :: Text
  , rCascade                      :: !Bool
  , rCheckMetadataConsistency     :: !(Maybe Bool)
  , rTxAccessMode                 :: !Q.TxAccess
  } deriving (Show, Eq, Lift)

instance FromJSON RunSQL where
  parseJSON = withObject "RunSQL" $ \o -> do
    rSql <- o .: "sql"
    rCascade <- o .:? "cascade" .!= False
    rCheckMetadataConsistency <- o .:? "check_metadata_consistency"
    isReadOnly <- o .:? "read_only" .!= False
    let rTxAccessMode = if isReadOnly then Q.ReadOnly else Q.ReadWrite
    pure RunSQL{..}

instance ToJSON RunSQL where
  toJSON RunSQL {..} =
    object
      [ "sql" .= rSql
      , "cascade" .= rCascade
      , "check_metadata_consistency" .= rCheckMetadataConsistency
      , "read_only" .=
        case rTxAccessMode of
          Q.ReadOnly -> True
          Q.ReadWrite -> False
      ]

runRunSQL :: (CacheBuildM m, UserInfoM m) => RunSQL -> m EncJSON
runRunSQL RunSQL {..} = do