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

Code before:
    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
  metadataCheckRequired <- case rReadOnly of
    True -> pure False
    False -> onNothing rCheckMetadataConsistency $ isAltrDropReplace rSql
  bool (execRawSQL rSql) (withMetadataCheck rCascade $ execRawSQL rSql) metadataCheckRequired
  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
      | rReadOnly = setReadOnly >> tx
      | otherwise = setReadWrite >> tx

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

    setReadWrite =  Q.unitQE defaultTxErrorHandler "SET TRANSACTION READ WRITE" () 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)

instance Q.FromRes RunSQLRes where
  fromRes (Q.ResultOkEmpty _) =
    return $ RunSQLRes "CommandOk" Null
  fromRes (Q.ResultOkData res) = do
    csvRows <- resToCSV res
    return $ RunSQLRes "TuplesOk" $ toJSON csvRows
    where

Review comment (suggestion):
This seems insufficient, right? Since if we have a `bulk` query with a read-only `run_sql` query followed by a non-`run_sql` query that makes modifications, the transaction access state won’t be restored to read/write.

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

    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)

instance Q.FromRes RunSQLRes where
  fromRes (Q.ResultOkEmpty _) =
    return $ RunSQLRes "CommandOk" Null
  fromRes (Q.ResultOkData res) = do
    csvRows <- resToCSV res
    return $ RunSQLRes "TuplesOk" $ toJSON csvRows
    where