diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index 4c2d27fee8d65..0f602a6bd1938 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -12,6 +12,7 @@ import Hasura.RQL.DDL.Schema.Diff import Hasura.RQL.DDL.Subscribe import Hasura.RQL.DDL.Utils import Hasura.RQL.Types +import Hasura.Server.Utils (matchRegex) import Hasura.SQL.Types import qualified Database.PG.Query as Q @@ -375,8 +376,9 @@ buildSchemaCache = do data RunSQL = RunSQL - { rSql :: T.Text - , rCascade :: !(Maybe Bool) + { rSql :: T.Text + , rCascade :: !(Maybe Bool) + , rCheckMetadataConsistency :: !(Maybe Bool) } deriving (Show, Eq, Lift) $(deriveJSON (aesonDrop 1 snakeCase){omitNothingFields=True} ''RunSQL) @@ -389,10 +391,18 @@ data RunSQLRes $(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''RunSQLRes) -runSqlP2 +execRawSQL :: (MonadTx m) => T.Text -> m RunSQLRes +execRawSQL = + liftTx . Q.multiQE rawSqlErrHandler . Q.fromText + where + rawSqlErrHandler txe = + let e = err400 PostgresError "query execution failed" + in e {qeInternal = Just $ toJSON txe} + +execWithMDCheck :: (QErrM m, CacheRWM m, MonadTx m, MonadIO m, HasHttpManager m) - => RunSQL -> m RespBody -runSqlP2 (RunSQL t cascade) = do + => RunSQL -> m RunSQLRes +execWithMDCheck (RunSQL t cascade _) = do -- Drop hdb_views so no interference is caused to the sql query liftTx $ Q.catchE defaultTxErrorHandler clearHdbViews @@ -401,7 +411,7 @@ runSqlP2 (RunSQL t cascade) = do oldMetaU <- liftTx $ Q.catchE defaultTxErrorHandler fetchTableMeta -- Run the SQL - res <- liftTx $ Q.multiQE rawSqlErrHandler $ Q.fromText t + res <- execRawSQL t -- Get the metadata after the sql query newMeta <- liftTx $ Q.catchE defaultTxErrorHandler fetchTableMeta @@ -440,19 +450,21 @@ runSqlP2 (RunSQL t cascade) = do -- refresh the gCtxMap in schema cache refreshGCtxMapInSchema - return $ encode (res :: RunSQLRes) + return res +isAltrDropReplace :: QErrM m => T.Text -> m Bool +isAltrDropReplace = either throwErr return . matchRegex regex False where - rawSqlErrHandler :: Q.PGTxErr -> QErr - rawSqlErrHandler txe = - let e = err400 PostgresError "query execution failed" - in e {qeInternal = Just $ toJSON txe} + throwErr s = throw500 $ "compiling regex failed: " <> T.pack s + regex = "alter|drop|replace" runRunSQL :: (QErrM m, UserInfoM m, CacheRWM m, MonadTx m, MonadIO m, HasHttpManager m) => RunSQL -> m RespBody -runRunSQL q = - adminOnly >> runSqlP2 q +runRunSQL q@(RunSQL t _ mChkMDCnstcy) = do + adminOnly + isMDChkNeeded <- maybe (isAltrDropReplace t) return mChkMDCnstcy + encode <$> bool (execRawSQL t) (execWithMDCheck q) isMDChkNeeded -- Should be used only after checking the status resToCSV :: PQ.Result -> ExceptT T.Text IO [[T.Text]] diff --git a/server/src-lib/Hasura/Server/Utils.hs b/server/src-lib/Hasura/Server/Utils.hs index 3302f5c6a881f..2e3cf73ca7abc 100644 --- a/server/src-lib/Hasura/Server/Utils.hs +++ b/server/src-lib/Hasura/Server/Utils.hs @@ -15,6 +15,8 @@ import qualified Data.Text.Encoding.Error as TE import qualified Data.Text.IO as TI import qualified Language.Haskell.TH.Syntax as TH import qualified Text.Ginger as TG +import qualified Text.Regex.TDFA as TDFA +import qualified Text.Regex.TDFA.ByteString as TDFA import Hasura.Prelude @@ -111,3 +113,16 @@ _2 (_, y, _) = y _3 :: (a, b, c) -> c _3 (_, _, z) = z + +-- regex related +matchRegex :: B.ByteString -> Bool -> T.Text -> Either String Bool +matchRegex regex caseSensitive src = + fmap (`TDFA.match` TE.encodeUtf8 src) compiledRegexE + where + compOpt = TDFA.defaultCompOpt + { TDFA.caseSensitive = caseSensitive + , TDFA.multiline = True + , TDFA.lastStarGreedy = True + } + execOption = TDFA.defaultExecOpt {TDFA.captureGroups = False} + compiledRegexE = TDFA.compile compOpt execOption regex