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

Code before:
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                  :: !(Maybe Bool)
  , rCheckMetadataConsistency :: !(Maybe Bool)
  , rReadOnly                 :: !(Maybe Bool)
  } deriving (Show, Eq, Lift)
$(deriveJSON (aesonDrop 1 snakeCase){omitNothingFields=True} ''RunSQL)

runRunSQL :: (CacheBuildM m, UserInfoM m) => RunSQL -> m EncJSON
runRunSQL (RunSQL sql cascade mChkMDCnstcy (fromMaybe False -> isReadOnly)) = do
  adminOnly
  isMDChkNeeded <- maybe (if isReadOnly then pure False else isAltrDropReplace sql) return mChkMDCnstcy
  bool (execRawSQL sql) (withMetadataCheck (or cascade) $ execRawSQL sql) isMDChkNeeded
  where
    execRawSQL :: (MonadTx m) => Text -> m EncJSON
    execRawSQL =
      fmap (encJFromJValue @RunSQLRes) . liftTx . setTransactionAccess . Q.multiQE rawSqlErrHandler . Q.fromText
      where
        rawSqlErrHandler txe =
          let e = err400 PostgresError "query execution failed"
          in e {qeInternal = Just $ toJSON txe}
    setTransactionAccess tx = if isReadOnly then setReadOnly >> tx else tx

    setReadOnly =  Q.unitQE defaultTxErrorHandler "SET TRANSACTION READ ONLY" () False

    isAltrDropReplace :: QErrM m => T.Text -> m Bool
    isAltrDropReplace = either throwErr return . matchRegex regex False
      where
        throwErr s = throw500 $ "compiling regex failed: " <> T.pack s
        regex = "alter|drop|replace|create function|comment on"

data RunSQLRes
  = RunSQLRes
  { rrResultType :: !Text
  , rrResult     :: !Value
  } deriving (Show, Eq)
$(deriveJSON (aesonDrop 2 snakeCase) ''RunSQLRes)


Review comment (suggestion):
Maybe it’s just me, but I feel like all the different ways of handling boolean logic here are getting a little confusing. Personally, I think a lot of this code would read a lot more clearly if we wrote a manual `FromJSON RunSQL` instance that handles the default values there instead of having `Maybe`s. Then maybe we could avoid so much of the twisty logic in this function and just do something like this:

```haskell
isMetadataCheckNeeded <- maybeCheckMetadataConsistency `onNothing` if
  | isReadOnly -> pure False
  | otherwise  -> isAlterDropReplace sql
```

But then I start wondering: is the current logic even right? Does it make sense to not check metadata consistency if the user specifies `check_metadata_consistency: false` in the query, but they also specify `cascade: true`? That seems nonsensical to me, but maybe I’m missing something.

Code after:
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
  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