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

Code before:
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 (Object 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{..}
  parseJSON _ = fail "expecting an object for args"

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
  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):
This is what [`Data.Aeson.withObject`](https://hackage.haskell.org/package/aeson-1.4.6.0/docs/Data-Aeson.html#v:withObject) is for. :)

Code after:
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
  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"
           in e {qeInternal = Just $ toJSON txe}