diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 58fa3e2515c9e..1f4f8bb04fb80 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -144,8 +144,9 @@ library , Hasura.Server.CheckUpdates , Hasura.RQL.Types , Hasura.RQL.Instances - , Hasura.RQL.Types.SchemaCache , Hasura.RQL.Types.Common + , Hasura.RQL.Types.BoolExp + , Hasura.RQL.Types.SchemaCache , Hasura.RQL.Types.Permission , Hasura.RQL.Types.Error , Hasura.RQL.Types.DML diff --git a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs index 8eb1c37f56aae..d90a0c858da71 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs @@ -6,11 +6,7 @@ module Hasura.GraphQL.Resolve.BoolExp ( parseBoolExp - , pgColValToBoolExpG , pgColValToBoolExp - , convertBoolExpG - , convertBoolExp - , prepare ) where import Data.Has @@ -20,8 +16,6 @@ import qualified Data.HashMap.Strict as Map import qualified Data.HashMap.Strict.InsOrd as OMap import qualified Language.GraphQL.Draft.Syntax as G -import qualified Hasura.RQL.GBoolExp as RA -import qualified Hasura.RQL.GBoolExp as RG import qualified Hasura.SQL.DML as S import Hasura.GraphQL.Resolve.Context @@ -32,40 +26,42 @@ import Hasura.RQL.Types import Hasura.SQL.Types import Hasura.SQL.Value +type OpExp = OpExpG (PGColType, PGColValue) + parseOpExps :: (MonadError QErr m, MonadReader r m, Has FieldMap r) - => AnnGValue -> m [RA.OpExp] + => AnnGValue -> m [OpExp] parseOpExps annVal = do opExpsM <- flip withObjectM annVal $ \nt objM -> forM objM $ \obj -> forM (OMap.toList obj) $ \(k, v) -> case k of - "_eq" -> fmap RA.AEQ <$> asPGColValM v - "_ne" -> fmap RA.ANE <$> asPGColValM v - "_neq" -> fmap RA.ANE <$> asPGColValM v + "_eq" -> fmap AEQ <$> asPGColValM v + "_ne" -> fmap ANE <$> asPGColValM v + "_neq" -> fmap ANE <$> asPGColValM v "_is_null" -> resolveIsNull v - "_in" -> fmap (RA.AIN . catMaybes) <$> parseMany asPGColValM v - "_nin" -> fmap (RA.ANIN . catMaybes) <$> parseMany asPGColValM v + "_in" -> fmap (AIN . catMaybes) <$> parseMany asPGColValM v + "_nin" -> fmap (ANIN . catMaybes) <$> parseMany asPGColValM v - "_gt" -> fmap RA.AGT <$> asPGColValM v - "_lt" -> fmap RA.ALT <$> asPGColValM v - "_gte" -> fmap RA.AGTE <$> asPGColValM v - "_lte" -> fmap RA.ALTE <$> asPGColValM v + "_gt" -> fmap AGT <$> asPGColValM v + "_lt" -> fmap ALT <$> asPGColValM v + "_gte" -> fmap AGTE <$> asPGColValM v + "_lte" -> fmap ALTE <$> asPGColValM v - "_like" -> fmap RA.ALIKE <$> asPGColValM v - "_nlike" -> fmap RA.ANLIKE <$> asPGColValM v + "_like" -> fmap ALIKE <$> asPGColValM v + "_nlike" -> fmap ANLIKE <$> asPGColValM v - "_ilike" -> fmap RA.AILIKE <$> asPGColValM v - "_nilike" -> fmap RA.ANILIKE <$> asPGColValM v + "_ilike" -> fmap AILIKE <$> asPGColValM v + "_nilike" -> fmap ANILIKE <$> asPGColValM v - "_similar" -> fmap RA.ASIMILAR <$> asPGColValM v - "_nsimilar" -> fmap RA.ANSIMILAR <$> asPGColValM v + "_similar" -> fmap ASIMILAR <$> asPGColValM v + "_nsimilar" -> fmap ANSIMILAR <$> asPGColValM v -- jsonb related operators - "_contains" -> fmap RA.AContains <$> asPGColValM v - "_contained_in" -> fmap RA.AContainedIn <$> asPGColValM v - "_has_key" -> fmap RA.AHasKey <$> asPGColValM v - "_has_keys_any" -> fmap RA.AHasKeysAny <$> parseMany asPGColText v - "_has_keys_all" -> fmap RA.AHasKeysAll <$> parseMany asPGColText v + "_contains" -> fmap AContains <$> asPGColValM v + "_contained_in" -> fmap AContainedIn <$> asPGColValM v + "_has_key" -> fmap AHasKey <$> asPGColValM v + "_has_keys_any" -> fmap AHasKeysAny <$> parseMany asPGColText v + "_has_keys_all" -> fmap AHasKeysAll <$> parseMany asPGColText v _ -> throw500 @@ -73,88 +69,69 @@ parseOpExps annVal = do <> showNamedTy nt <> ": " <> showName k - return $ map RA.OEVal $ catMaybes $ fromMaybe [] opExpsM + return $ catMaybes $ fromMaybe [] opExpsM where resolveIsNull v = case v of AGScalar _ Nothing -> return Nothing AGScalar _ (Just (PGValBoolean b)) -> - return $ Just $ bool RA.ANISNOTNULL RA.ANISNULL b + return $ Just $ bool ANISNOTNULL ANISNULL b AGScalar _ _ -> throw500 "boolean value is expected" _ -> tyMismatch "pgvalue" v parseAsEqOp :: (MonadError QErr m) - => AnnGValue -> m [RA.OpExp] + => AnnGValue -> m [OpExp] parseAsEqOp annVal = do - annValOpExp <- RA.AEQ <$> asPGColVal annVal - return [RA.OEVal annValOpExp] + annValOpExp <- AEQ <$> asPGColVal annVal + return [annValOpExp] parseColExp :: (MonadError QErr m, MonadReader r m, Has FieldMap r) - => G.NamedType + => ((PGColType, PGColValue) -> m S.SQLExp) + -> G.NamedType -> G.Name -> AnnGValue - -> (AnnGValue -> m [RA.OpExp]) - -> m RA.AnnVal -parseColExp nt n val expParser = do + -> (AnnGValue -> m [OpExp]) + -> m AnnBoolExpFldSQL +parseColExp f nt n val expParser = do fldInfo <- getFldInfo nt n case fldInfo of - Left pgColInfo -> RA.AVCol pgColInfo <$> expParser val + Left pgColInfo -> do + opExps <- expParser val + AVCol pgColInfo <$> traverse (traverse f) opExps Right (relInfo, _, permExp, _) -> do - relBoolExp <- parseBoolExp val - return $ RA.AVRel relInfo relBoolExp permExp + relBoolExp <- parseBoolExp f val + return $ AVRel relInfo $ andAnnBoolExps relBoolExp permExp parseBoolExp :: (MonadError QErr m, MonadReader r m, Has FieldMap r) - => AnnGValue - -> m (GBoolExp RA.AnnVal) -parseBoolExp annGVal = do + => ((PGColType, PGColValue) -> m S.SQLExp) + -> AnnGValue + -> m AnnBoolExpSQL +parseBoolExp f annGVal = do boolExpsM <- flip withObjectM annGVal $ \nt objM -> forM objM $ \obj -> forM (OMap.toList obj) $ \(k, v) -> if - | k == "_or" -> BoolOr . fromMaybe [] <$> parseMany parseBoolExp v - | k == "_and" -> BoolAnd . fromMaybe [] <$> parseMany parseBoolExp v - | k == "_not" -> BoolNot <$> parseBoolExp v - | otherwise -> BoolCol <$> parseColExp nt k v parseOpExps + | k == "_or" -> BoolOr . fromMaybe [] + <$> parseMany (parseBoolExp f) v + | k == "_and" -> BoolAnd . fromMaybe [] + <$> parseMany (parseBoolExp f) v + | k == "_not" -> BoolNot <$> parseBoolExp f v + | otherwise -> BoolFld <$> parseColExp f nt k v parseOpExps return $ BoolAnd $ fromMaybe [] boolExpsM -convertBoolExpG - :: (MonadError QErr m, MonadReader r m, Has FieldMap r) - => ((PGColType, PGColValue) -> m S.SQLExp) - -> QualifiedTable - -> AnnGValue - -> m (GBoolExp RG.AnnSQLBoolExp) -convertBoolExpG f tn whereArg = do - whereExp <- parseBoolExp whereArg - RG.convBoolRhs (RG.mkBoolExpBuilder f) (S.mkQual tn) whereExp - -convertBoolExp - :: QualifiedTable - -> AnnGValue - -> Convert (GBoolExp RG.AnnSQLBoolExp) -convertBoolExp = convertBoolExpG prepare - type PGColValMap = Map.HashMap G.Name AnnGValue -pgColValToBoolExpG +pgColValToBoolExp :: (MonadError QErr m, MonadReader r m, Has FieldMap r) => ((PGColType, PGColValue) -> m S.SQLExp) - -> QualifiedTable -> PGColValMap - -> m (GBoolExp RG.AnnSQLBoolExp) -pgColValToBoolExpG f tn colValMap = do + -> m AnnBoolExpSQL +pgColValToBoolExp f colValMap = do colExps <- forM colVals $ \(name, val) -> do (ty, _) <- asPGColVal val let namedTy = mkScalarTy ty - BoolCol <$> parseColExp namedTy name val parseAsEqOp - let whereExp = BoolAnd colExps - RG.convBoolRhs (RG.mkBoolExpBuilder f) (S.mkQual tn) whereExp + BoolFld <$> parseColExp f namedTy name val parseAsEqOp + return $ BoolAnd colExps where colVals = Map.toList colValMap - -pgColValToBoolExp - :: QualifiedTable - -> PGColValMap - -> Convert (GBoolExp RG.AnnSQLBoolExp) -pgColValToBoolExp = - pgColValToBoolExpG prepare diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs index 24415f4d6038e..a305ae34798ee 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs @@ -47,7 +47,7 @@ import qualified Hasura.SQL.DML as S type FieldMap = Map.HashMap (G.NamedType, G.Name) - (Either PGColInfo (RelInfo, Bool, S.BoolExp, Maybe Int)) + (Either PGColInfo (RelInfo, Bool, AnnBoolExpSQL, Maybe Int)) -- data OrdTy -- = OAsc @@ -64,7 +64,7 @@ type RespTx = Q.TxE QErr BL.ByteString -- order by context data OrdByItem = OBIPGCol !PGColInfo - | OBIRel !RelInfo !S.BoolExp + | OBIRel !RelInfo !AnnBoolExpSQL deriving (Show, Eq) type OrdByItemMap = Map.HashMap G.Name OrdByItem @@ -86,7 +86,8 @@ type InsCtxMap = Map.HashMap QualifiedTable InsCtx getFldInfo :: (MonadError QErr m, MonadReader r m, Has FieldMap r) - => G.NamedType -> G.Name -> m (Either PGColInfo (RelInfo, Bool, S.BoolExp, Maybe Int)) + => G.NamedType -> G.Name + -> m (Either PGColInfo (RelInfo, Bool, AnnBoolExpSQL, Maybe Int)) getFldInfo nt n = do fldMap <- asks getter onNothing (Map.lookup (nt,n) fldMap) $ diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index 968b2bda62cfe..d47b9b3ceb608 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -28,12 +28,10 @@ import qualified Database.PG.Query as Q import qualified Hasura.RQL.DML.Insert as RI import qualified Hasura.RQL.DML.Returning as RR import qualified Hasura.RQL.DML.Select as RS -import qualified Hasura.RQL.GBoolExp as RG import qualified Hasura.RQL.GBoolExp as RB import qualified Hasura.SQL.DML as S -import Hasura.GraphQL.Resolve.BoolExp import Hasura.GraphQL.Resolve.Context import Hasura.GraphQL.Resolve.InputValue import Hasura.GraphQL.Resolve.Mutation @@ -214,13 +212,13 @@ mkInsertQ vn onConflictM insCols tableCols defVals role = do mkBoolExp :: (MonadError QErr m, MonadState PrepArgs m) => QualifiedTable -> [(PGColInfo, PGColValue)] - -> m (GBoolExp RG.AnnSQLBoolExp) + -> m S.BoolExp mkBoolExp tn colInfoVals = - RG.convBoolRhs (RG.mkBoolExpBuilder prepare) (S.mkQual tn) boolExp + RB.toSQLBoolExp (S.mkQual tn) . BoolAnd <$> + mapM (fmap BoolFld . uncurry f) colInfoVals where - boolExp = BoolAnd $ map (BoolCol . uncurry f) colInfoVals f ci@(PGColInfo _ colTy _) colVal = - RB.AVCol ci [RB.OEVal $ RB.AEQ (colTy, colVal)] + AVCol ci . pure . AEQ <$> prepare (colTy, colVal) mkSelQ :: MonadError QErr m => QualifiedTable -> [PGColInfo] -> [PGColWithValue] -> m InsWithExp @@ -228,7 +226,7 @@ mkSelQ tn allColInfos pgColsWithVal = do (whereExp, args) <- flip runStateT Seq.Empty $ mkBoolExp tn colWithInfos let sqlSel = S.mkSelect { S.selExtr = [S.selectStar] , S.selFrom = Just $ S.mkSimpleFromExp tn - , S.selWhere = Just $ S.WhereFrag $ RG.cBoolExp whereExp + , S.selWhere = Just $ S.WhereFrag whereExp } return $ InsWithExp (S.CTESelect sqlSel) Nothing args diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index 9ee340ba3e56e..e4280c8cbbf28 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -91,14 +91,14 @@ convDeleteAtPathObj val = convertUpdate :: QualifiedTable -- table - -> S.BoolExp -- the filter expression + -> AnnBoolExpSQL -- the filter expression -> Field -- the mutation field -> Convert RespTx convertUpdate tn filterExp fld = do -- a set expression is same as a row object setExpM <- withArgM args "_set" convertRowObj -- where bool expression to filter column - whereExp <- withArg args "where" $ convertBoolExp tn + whereExp <- withArg args "where" (parseBoolExp prepare) -- increment operator on integer columns incExpM <- withArgM args "_inc" $ convObjWithOp $ rhsExpOp S.incOp S.intType @@ -134,11 +134,11 @@ convertUpdate tn filterExp fld = do convertDelete :: QualifiedTable -- table - -> S.BoolExp -- the filter expression + -> AnnBoolExpSQL -- the filter expression -> Field -- the mutation field -> Convert RespTx convertDelete tn filterExp fld = do - whereExp <- withArg (_fArguments fld) "where" $ convertBoolExp tn + whereExp <- withArg (_fArguments fld) "where" (parseBoolExp prepare) mutFlds <- convertMutResp (_fType fld) $ _fSelSet fld args <- get let p1 = RD.DeleteQueryP1 tn (filterExp, whereExp) mutFlds diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index 38949d1cbe31c..ddd6433b1cb2f 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -81,9 +81,9 @@ fieldAsPath = nameAsPath . _fName parseTableArgs :: (MonadError QErr m, MonadReader r m, Has FieldMap r, Has OrdByCtx r) => ((PGColType, PGColValue) -> m S.SQLExp) - -> QualifiedTable -> ArgsMap -> m RS.TableArgs -parseTableArgs f tn args = do - whereExpM <- withArgM args "where" $ convertBoolExpG f tn + -> ArgsMap -> m RS.TableArgs +parseTableArgs f args = do + whereExpM <- withArgM args "where" $ parseBoolExp f ordByExpML <- withArgM args "order_by" parseOrderBy let ordByExpM = NE.nonEmpty =<< ordByExpML limitExpM <- withArgM args "limit" parseLimit @@ -93,10 +93,10 @@ parseTableArgs f tn args = do fromField :: (MonadError QErr m, MonadReader r m, Has FieldMap r, Has OrdByCtx r) => ((PGColType, PGColValue) -> m S.SQLExp) - -> QualifiedTable -> S.BoolExp -> Maybe Int -> Field -> m RS.AnnSel + -> QualifiedTable -> AnnBoolExpSQL -> Maybe Int -> Field -> m RS.AnnSel fromField f tn permFilter permLimitM fld = fieldAsPath fld $ do - tableArgs <- parseTableArgs f tn args + tableArgs <- parseTableArgs f args annFlds <- fromSelSet f (_fType fld) $ _fSelSet fld let tabFrom = RS.TableFrom tn Nothing tabPerm = RS.TablePerm permFilter permLimitM @@ -175,9 +175,9 @@ parseLimit v = do fromFieldByPKey :: (MonadError QErr m, MonadReader r m, Has FieldMap r, Has OrdByCtx r) => ((PGColType, PGColValue) -> m S.SQLExp) - -> QualifiedTable -> S.BoolExp -> Field -> m RS.AnnSel + -> QualifiedTable -> AnnBoolExpSQL -> Field -> m RS.AnnSel fromFieldByPKey f tn permFilter fld = fieldAsPath fld $ do - boolExp <- pgColValToBoolExpG f tn $ _fArguments fld + boolExp <- pgColValToBoolExp f $ _fArguments fld annFlds <- fromSelSet f (_fType fld) $ _fSelSet fld let tabFrom = RS.TableFrom tn Nothing tabPerm = RS.TablePerm permFilter Nothing @@ -185,7 +185,7 @@ fromFieldByPKey f tn permFilter fld = fieldAsPath fld $ do RS.noTableArgs { RS._taWhere = Just boolExp} convertSelect - :: QualifiedTable -> S.BoolExp -> Maybe Int -> Field -> Convert RespTx + :: QualifiedTable -> AnnBoolExpSQL -> Maybe Int -> Field -> Convert RespTx convertSelect qt permFilter permLimit fld = do selData <- withPathK "selectionSet" $ fromField prepare qt permFilter permLimit fld @@ -193,7 +193,7 @@ convertSelect qt permFilter permLimit fld = do return $ RS.selectP2 False (selData, prepArgs) convertSelectByPKey - :: QualifiedTable -> S.BoolExp -> Field -> Convert RespTx + :: QualifiedTable -> AnnBoolExpSQL -> Field -> Convert RespTx convertSelectByPKey qt permFilter fld = do selData <- withPathK "selectionSet" $ fromFieldByPKey prepare qt permFilter fld @@ -253,9 +253,9 @@ convertAggFld ty selSet = fromAggField :: (MonadError QErr m, MonadReader r m, Has FieldMap r, Has OrdByCtx r) => ((PGColType, PGColValue) -> m S.SQLExp) - -> QualifiedTable -> S.BoolExp -> Maybe Int -> Field -> m RS.AnnAggSel + -> QualifiedTable -> AnnBoolExpSQL -> Maybe Int -> Field -> m RS.AnnAggSel fromAggField fn tn permFilter permLimitM fld = fieldAsPath fld $ do - tableArgs <- parseTableArgs fn tn args + tableArgs <- parseTableArgs fn args aggSelFlds <- fromAggSel (_fType fld) $ _fSelSet fld let tabFrom = RS.TableFrom tn Nothing tabPerm = RS.TablePerm permFilter permLimitM @@ -273,7 +273,7 @@ fromAggField fn tn permFilter permLimitM fld = fieldAsPath fld $ do G.Name t -> throw500 $ "unexpected field in _agg node: " <> t convertAggSelect - :: QualifiedTable -> S.BoolExp -> Maybe Int -> Field -> Convert RespTx + :: QualifiedTable -> AnnBoolExpSQL -> Maybe Int -> Field -> Convert RespTx convertAggSelect qt permFilter permLimit fld = do selData <- withPathK "selectionSet" $ fromAggField prepare qt permFilter permLimit fld diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 6aea90db905e7..77c45602feac0 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -36,8 +36,6 @@ import Hasura.RQL.DML.Internal (mkAdminRolePermInfo) import Hasura.RQL.Types import Hasura.SQL.Types -import qualified Hasura.SQL.DML as S - defaultTypes :: [TypeInfo] defaultTypes = $(fromSchemaDocQ defaultSchema) @@ -61,15 +59,15 @@ data OpCtx -- table, req hdrs = OCInsert QualifiedTable [T.Text] -- tn, filter exp, limit, req hdrs - | OCSelect QualifiedTable S.BoolExp (Maybe Int) [T.Text] + | OCSelect QualifiedTable AnnBoolExpSQL (Maybe Int) [T.Text] -- tn, filter exp, reqt hdrs - | OCSelectPkey QualifiedTable S.BoolExp [T.Text] + | OCSelectPkey QualifiedTable AnnBoolExpSQL [T.Text] -- tn, filter exp, limit, req hdrs - | OCSelectAgg QualifiedTable S.BoolExp (Maybe Int) [T.Text] + | OCSelectAgg QualifiedTable AnnBoolExpSQL (Maybe Int) [T.Text] -- tn, filter exp, req hdrs - | OCUpdate QualifiedTable S.BoolExp [T.Text] + | OCUpdate QualifiedTable AnnBoolExpSQL [T.Text] -- tn, filter exp, req hdrs - | OCDelete QualifiedTable S.BoolExp [T.Text] + | OCDelete QualifiedTable AnnBoolExpSQL [T.Text] deriving (Show, Eq) data GCtx @@ -103,7 +101,7 @@ instance Monoid TyAgg where mempty = TyAgg Map.empty Map.empty Map.empty mappend = (<>) -type SelField = Either PGColInfo (RelInfo, Bool, S.BoolExp, Maybe Int, Bool) +type SelField = Either PGColInfo (RelInfo, Bool, AnnBoolExpSQL, Maybe Int, Bool) qualTableToName :: QualifiedTable -> G.Name qualTableToName = G.Name <$> \case @@ -116,7 +114,7 @@ isValidTableName = isValidName . qualTableToName isValidField :: FieldInfo -> Bool isValidField = \case FIColumn (PGColInfo col _ _) -> isColEligible col - FIRelationship (RelInfo rn _ _ remTab _ _) -> isRelEligible rn remTab + FIRelationship (RelInfo rn _ _ remTab _) -> isRelEligible rn remTab where isColEligible = isValidName . G.Name . getPGColTxt isRelEligible rn rt = isValidName (G.Name $ getRelTxt rn) @@ -329,7 +327,7 @@ mkRelFld -> RelInfo -> Bool -> [ObjFldInfo] -mkRelFld allowAgg (RelInfo rn rTy _ remTab _ isManual) isNullable = case rTy of +mkRelFld allowAgg (RelInfo rn rTy _ remTab isManual) isNullable = case rTy of ArrRel -> bool [arrRelFld] [arrRelFld, aggArrRelFld] allowAgg ObjRel -> [objRelFld] where @@ -574,7 +572,7 @@ mkBoolExpInp tn fields = mkFldExpInp = \case Left (PGColInfo colName colTy _) -> mk (mkColName colName) (mkCompExpTy colTy) - Right (RelInfo relName _ _ remTab _ _, _, _, _, _) -> + Right (RelInfo relName _ _ remTab _, _, _, _, _) -> mk (G.Name $ getRelTxt relName) (mkBoolExpTy remTab) mkPGColInp :: PGColInfo -> InpValInfo @@ -1310,9 +1308,9 @@ getRootFldsRole' -> [TableConstraint] -> FieldInfoMap -> Maybe ([T.Text], Bool) -- insert perm - -> Maybe (S.BoolExp, Maybe Int, [T.Text], Bool) -- select filter - -> Maybe ([PGCol], S.BoolExp, [T.Text]) -- update filter - -> Maybe (S.BoolExp, [T.Text]) -- delete filter + -> Maybe (AnnBoolExpSQL, Maybe Int, [T.Text], Bool) -- select filter + -> Maybe ([PGCol], AnnBoolExpSQL, [T.Text]) -- update filter + -> Maybe (AnnBoolExpSQL, [T.Text]) -- delete filter -> Maybe ViewInfo -> RootFlds getRootFldsRole' tn primCols constraints fields insM selM updM delM viM = @@ -1515,8 +1513,8 @@ mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols (Just (allCols, noFilter, [])) (Just (noFilter, [])) viewInfo -noFilter :: S.BoolExp -noFilter = S.BELit True +noFilter :: AnnBoolExpSQL +noFilter = annBoolExpTrue mkScalarTyInfo :: PGColType -> ScalarTyInfo mkScalarTyInfo = ScalarTyInfo Nothing diff --git a/server/src-lib/Hasura/Prelude.hs b/server/src-lib/Hasura/Prelude.hs index 0a9c511e64acf..66649e1c316a2 100644 --- a/server/src-lib/Hasura/Prelude.hs +++ b/server/src-lib/Hasura/Prelude.hs @@ -21,6 +21,7 @@ import Data.Ord as M (comparing) import Data.Semigroup as M (Semigroup (..)) import Data.String as M (IsString) import Data.Text as M (Text) +import Data.Word as M (Word64) import GHC.Generics as M (Generic) import Prelude as M hiding (fail, init, lookup) import Text.Read as M (readEither, readMaybe) diff --git a/server/src-lib/Hasura/RQL/DDL/Permission.hs b/server/src-lib/Hasura/RQL/DDL/Permission.hs index 72d75862964ed..7f260dcef50c0 100644 --- a/server/src-lib/Hasura/RQL/DDL/Permission.hs +++ b/server/src-lib/Hasura/RQL/DDL/Permission.hs @@ -53,6 +53,7 @@ import Hasura.RQL.DDL.Permission.Internal import Hasura.RQL.DDL.Permission.Triggers import Hasura.RQL.DML.Internal (onlyPositiveInt) import Hasura.RQL.Types +import Hasura.RQL.GBoolExp import Hasura.SQL.Types import qualified Database.PG.Query as Q @@ -109,10 +110,11 @@ buildInsPermInfo :: (QErrM m, CacheRM m) => TableInfo -> PermDef InsPerm - -> m InsPermInfo + -> m (WithDeps InsPermInfo) buildInsPermInfo tabInfo (PermDef rn (InsPerm chk upsrt set mCols) _) = withPathK "permission" $ do (be, beDeps) <- withPathK "check" $ - procBoolExp tn fieldInfoMap (S.QualVar "NEW") chk + -- procBoolExp tn fieldInfoMap (S.QualVar "NEW") chk + procBoolExp tn fieldInfoMap chk let deps = mkParentDep tn : beDeps fltrHeaders = getDependentHeaders chk setObj = fromMaybe mempty set @@ -127,7 +129,7 @@ buildInsPermInfo tabInfo (PermDef rn (InsPerm chk upsrt set mCols) _) = withPath let setHdrs = mapMaybe (fetchHdr . snd) (HM.toList setObj) reqHdrs = fltrHeaders `union` setHdrs preSetCols = HM.union setColsSQL nonInsColVals - return $ InsPermInfo vn be allowUpsrt preSetCols deps reqHdrs + return (InsPermInfo vn be allowUpsrt preSetCols reqHdrs, deps) where fieldInfoMap = tiFieldInfoMap tabInfo tn = tiName tabInfo @@ -143,8 +145,8 @@ buildInsPermInfo tabInfo (PermDef rn (InsPerm chk upsrt set mCols) _) = withPath fetchHdr _ = Nothing buildInsInfra :: QualifiedTable -> InsPermInfo -> Q.TxE QErr () -buildInsInfra tn (InsPermInfo vn be _ _ _ _) = do - trigFnQ <- buildInsTrigFn vn tn be +buildInsInfra tn (InsPermInfo vn be _ _ _) = do + trigFnQ <- buildInsTrigFn vn tn $ toSQLBoolExp (S.QualVar "NEW") be Q.catchE defaultTxErrorHandler $ do -- Create the view Q.unitQ (buildView tn vn) () False @@ -199,12 +201,12 @@ buildSelPermInfo :: (QErrM m, CacheRM m) => TableInfo -> SelPerm - -> m SelPermInfo + -> m (WithDeps SelPermInfo) buildSelPermInfo tabInfo sp = do let pgCols = convColSpec fieldInfoMap $ spColumns sp (be, beDeps) <- withPathK "filter" $ - procBoolExp tn fieldInfoMap (S.mkQual tn) $ spFilter sp + procBoolExp tn fieldInfoMap $ spFilter sp -- check if the columns exist void $ withPathK "columns" $ indexedForM pgCols $ \pgCol -> @@ -216,7 +218,7 @@ buildSelPermInfo tabInfo sp = do withPathK "limit" $ mapM_ onlyPositiveInt mLimit - return $ SelPermInfo (HS.fromList pgCols) tn be mLimit allowAgg deps depHeaders + return (SelPermInfo (HS.fromList pgCols) tn be mLimit allowAgg depHeaders, deps) where tn = tiName tabInfo @@ -265,10 +267,10 @@ buildUpdPermInfo :: (QErrM m, CacheRM m) => TableInfo -> UpdPerm - -> m UpdPermInfo + -> m (WithDeps UpdPermInfo) buildUpdPermInfo tabInfo (UpdPerm colSpec fltr) = do (be, beDeps) <- withPathK "filter" $ - procBoolExp tn fieldInfoMap (S.mkQual tn) fltr + procBoolExp tn fieldInfoMap fltr -- check if the columns exist _ <- withPathK "columns" $ indexedForM updCols $ \updCol -> @@ -277,7 +279,7 @@ buildUpdPermInfo tabInfo (UpdPerm colSpec fltr) = do let deps = mkParentDep tn : beDeps ++ map (mkColDep "untyped" tn) updCols depHeaders = getDependentHeaders fltr - return $ UpdPermInfo (HS.fromList updCols) tn be deps depHeaders + return (UpdPermInfo (HS.fromList updCols) tn be depHeaders, deps) where tn = tiName tabInfo @@ -322,13 +324,13 @@ buildDelPermInfo :: (QErrM m, CacheRM m) => TableInfo -> DelPerm - -> m DelPermInfo + -> m (WithDeps DelPermInfo) buildDelPermInfo tabInfo (DelPerm fltr) = do (be, beDeps) <- withPathK "filter" $ - procBoolExp tn fieldInfoMap (S.mkQual tn) fltr + procBoolExp tn fieldInfoMap fltr let deps = mkParentDep tn : beDeps depHeaders = getDependentHeaders fltr - return $ DelPermInfo tn be deps depHeaders + return (DelPermInfo tn be depHeaders, deps) where tn = tiName tabInfo fieldInfoMap = tiFieldInfoMap tabInfo diff --git a/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs b/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs index 438837de5dc11..2a8a5b5d04f94 100644 --- a/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs +++ b/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs @@ -170,23 +170,19 @@ createPermP1 tn = do procBoolExp :: (QErrM m, CacheRM m) - => QualifiedTable -> FieldInfoMap -> S.Qual -> BoolExp - -> m (S.BoolExp, [SchemaDependency]) -procBoolExp tn fieldInfoMap tq be = do - abe <- annBoolExp valueParser fieldInfoMap be - sqlbe <- convFilterExp tq abe + => QualifiedTable -> FieldInfoMap -> BoolExp + -> m (AnnBoolExpSQL, [SchemaDependency]) +procBoolExp tn fieldInfoMap be = do + abe <- annBoolExp valueParser fieldInfoMap be let deps = getBoolExpDeps tn abe - return (sqlbe, deps) + return (abe, deps) isReqUserId :: T.Text -> Bool isReqUserId = (== "req_user_id") . T.toLower getDependentHeaders :: BoolExp -> [T.Text] -getDependentHeaders boolExp = case boolExp of - BoolAnd exps -> concatMap getDependentHeaders exps - BoolOr exps -> concatMap getDependentHeaders exps - BoolCol (ColExp _ v) -> parseValue v - BoolNot be -> getDependentHeaders be +getDependentHeaders (BoolExp boolExp) = + flip foldMap boolExp $ \(ColExp _ v) -> parseValue v where parseValue val = case val of (Object o) -> parseObject o @@ -198,8 +194,11 @@ getDependentHeaders boolExp = case boolExp of | isReqUserId t -> [userIdHeader] | otherwise -> [] _ -> [] - parseObject o = flip concatMap (M.toList o) $ \(k, v) -> - bool (parseValue v) (parseOnlyString v) $ isRQLOp k + parseObject o = + concatMap parseOnlyString (M.elems o) + -- if isRQLOp k + -- then parseOnlyString v + -- else [] valueParser :: (MonadError QErr m) => PGColType -> Value -> m S.SQLExp valueParser columnType = \case @@ -216,14 +215,6 @@ valueParser columnType = \case S.SEOpApp (S.SQLOp "->>") [curSess, S.SELit $ T.toLower hdr] `S.SETyAnn` (S.AnnType $ T.pack $ show columnType) --- Convert where clause into SQL BoolExp -convFilterExp :: (MonadError QErr m) - => S.Qual -> GBoolExp AnnValS -> m S.BoolExp -convFilterExp tq be = - cBoolExp <$> convBoolRhs builderStrategy tq be - where - builderStrategy = mkBoolExpBuilder return - injectDefaults :: QualifiedTable -> QualifiedTable -> Q.Query injectDefaults qv qt = Q.fromText $ mconcat @@ -263,7 +254,7 @@ class (ToJSON a) => IsPerm a where :: (QErrM m, CacheRM m) => TableInfo -> PermDef a - -> m (PermInfo a) + -> m (WithDeps (PermInfo a)) addPermP2Setup :: (MonadTx m, QErrM m) => QualifiedTable -> PermDef a -> PermInfo a -> m () @@ -297,16 +288,18 @@ validateViewPerm permDef tableInfo = viewInfo = tiViewInfo tableInfo permAcc = getPermAcc1 permDef -addPermP1 :: (QErrM m, CacheRM m, IsPerm a) => TableInfo -> PermDef a -> m (PermInfo a) +addPermP1 + :: (QErrM m, CacheRM m, IsPerm a) + => TableInfo -> PermDef a -> m (WithDeps (PermInfo a)) addPermP1 tabInfo pd = do assertPermNotDefined (pdRole pd) (getPermAcc1 pd) tabInfo buildPermInfo tabInfo pd addPermP2 :: (IsPerm a, QErrM m, CacheRWM m, MonadTx m) - => QualifiedTable -> PermDef a -> PermInfo a -> m () -addPermP2 tn pd permInfo = do + => QualifiedTable -> PermDef a -> WithDeps (PermInfo a) -> m () +addPermP2 tn pd (permInfo, deps) = do addPermP2Setup tn pd permInfo - addPermToCache tn (pdRole pd) pa permInfo + addPermToCache tn (pdRole pd) pa permInfo deps liftTx $ savePermToCatalog pt tn pd where pa = getPermAcc1 pd @@ -314,7 +307,7 @@ addPermP2 tn pd permInfo = do instance (IsPerm a) => HDBQuery (CreatePerm a) where - type Phase1Res (CreatePerm a) = PermInfo a + type Phase1Res (CreatePerm a) = WithDeps (PermInfo a) phaseOne (WithTable tn pd) = do tabInfo <- createPermP1 tn diff --git a/server/src-lib/Hasura/RQL/DDL/QueryTemplate.hs b/server/src-lib/Hasura/RQL/DDL/QueryTemplate.hs index 190dff51c0b0c..37e6e994afaaf 100644 --- a/server/src-lib/Hasura/RQL/DDL/QueryTemplate.hs +++ b/server/src-lib/Hasura/RQL/DDL/QueryTemplate.hs @@ -124,7 +124,9 @@ collectDeps qt = case qt of QTP1Bulk qp1 -> concatMap collectDeps qp1 createQueryTemplateP1 - :: (P1C m) => CreateQueryTemplate -> m QueryTemplateInfo + :: (P1C m) + => CreateQueryTemplate + -> m (WithDeps QueryTemplateInfo) createQueryTemplateP1 (CreateQueryTemplate qtn qt _) = do adminOnly ui <- askUserInfo @@ -134,7 +136,7 @@ createQueryTemplateP1 (CreateQueryTemplate qtn qt _) = do let qCtx = QCtx ui sc qtp1 <- withPathK "template" $ liftP1 qCtx $ validateTQuery qt let deps = collectDeps qtp1 - return $ QueryTemplateInfo qtn qt deps + return (QueryTemplateInfo qtn qt, deps) addQTemplateToCatalog :: CreateQueryTemplate @@ -149,15 +151,17 @@ addQTemplateToCatalog (CreateQueryTemplate qtName qtDef mComment) = createQueryTemplateP2 :: (P2C m) - => CreateQueryTemplate -> QueryTemplateInfo -> m RespBody -createQueryTemplateP2 cqt qti = do - addQTemplateToCache qti + => CreateQueryTemplate + -> WithDeps QueryTemplateInfo + -> m RespBody +createQueryTemplateP2 cqt (qti, deps) = do + addQTemplateToCache qti deps liftTx $ addQTemplateToCatalog cqt return successMsg instance HDBQuery CreateQueryTemplate where - type Phase1Res CreateQueryTemplate = QueryTemplateInfo + type Phase1Res CreateQueryTemplate = WithDeps QueryTemplateInfo phaseOne = createQueryTemplateP1 phaseTwo = createQueryTemplateP2 diff --git a/server/src-lib/Hasura/RQL/DDL/Relationship.hs b/server/src-lib/Hasura/RQL/DDL/Relationship.hs index fb07fe58d081c..65d45e86873d9 100644 --- a/server/src-lib/Hasura/RQL/DDL/Relationship.hs +++ b/server/src-lib/Hasura/RQL/DDL/Relationship.hs @@ -172,13 +172,13 @@ createObjRelP1 (WithTable qt rd) = do objRelP2Setup :: (P2C m) => QualifiedTable -> RelDef ObjRelUsing -> m () objRelP2Setup qt (RelDef rn ru _) = do - relInfo <- case ru of + (relInfo, deps) <- case ru of RUManual (ObjRelManualConfig rm) -> do let refqt = rmTable rm (lCols, rCols) = unzip $ M.toList $ rmColumns rm deps = map (\c -> SchemaDependency (SOTableObj qt $ TOCol c) "lcol") lCols <> map (\c -> SchemaDependency (SOTableObj refqt $ TOCol c) "rcol") rCols - return $ RelInfo rn ObjRel (zip lCols rCols) refqt deps True + return (RelInfo rn ObjRel (zip lCols rCols) refqt True, deps) RUFKeyOn cn -> do res <- liftTx $ Q.catchE defaultTxErrorHandler $ fetchFKeyDetail cn case mapMaybe processRes res of @@ -190,10 +190,10 @@ objRelP2Setup qt (RelDef rn ru _) = do ] refqt = QualifiedTable refsn reftn void $ askTabInfo refqt - return $ RelInfo rn ObjRel colMapping refqt deps False + return (RelInfo rn ObjRel colMapping refqt False, deps) _ -> throw400 ConstraintError "more than one foreign key constraint exists on the given column" - addFldToCache (fromRel rn) (FIRelationship relInfo) qt + addRelToCache rn relInfo deps qt where QualifiedTable sn tn = qt fetchFKeyDetail cn = @@ -267,13 +267,13 @@ arrRelP1 tabInfo (RelDef rn ru _) = do arrRelP2Setup :: (P2C m) => QualifiedTable -> ArrRelDef -> m () arrRelP2Setup qt (RelDef rn ru _) = do - relInfo <- case ru of + (relInfo, deps) <- case ru of RUManual (ArrRelManualConfig rm) -> do let refqt = rmTable rm (lCols, rCols) = unzip $ M.toList $ rmColumns rm deps = map (\c -> SchemaDependency (SOTableObj qt $ TOCol c) "lcol") lCols <> map (\c -> SchemaDependency (SOTableObj refqt $ TOCol c) "rcol") rCols - return $ RelInfo rn ArrRel (zip lCols rCols) refqt deps True + return (RelInfo rn ArrRel (zip lCols rCols) refqt True, deps) RUFKeyOn (ArrRelUsingFKeyOn refqt refCol) -> do let QualifiedTable refSn refTn = refqt res <- liftTx $ Q.catchE defaultTxErrorHandler $ @@ -285,10 +285,10 @@ arrRelP2Setup qt (RelDef rn ru _) = do let deps = [ SchemaDependency (SOTableObj refqt $ TOCons consName) "remote_fkey" , SchemaDependency (SOTableObj refqt $ TOCol refCol) "using_col" ] - return $ RelInfo rn ArrRel (map swap mapping) refqt deps False + return (RelInfo rn ArrRel (map swap mapping) refqt False, deps) _ -> throw400 ConstraintError "more than one foreign key constraint exists on the given column" - addFldToCache (fromRel rn) (FIRelationship relInfo) qt + addRelToCache rn relInfo deps qt where QualifiedTable sn tn = qt fetchFKeyDetail refsn reftn refcn = Q.listQ [Q.sql| @@ -354,7 +354,7 @@ purgeRelDep d = throw500 $ "unexpected dependency of relationship : " dropRelP2 :: (P2C m) => DropRel -> [SchemaObjId] -> m RespBody dropRelP2 (DropRel qt rn _) depObjs = do mapM_ purgeRelDep depObjs - delFldFromCache (fromRel rn) qt + delRelFromCache rn qt liftTx $ delRelFromCatalog qt rn return successMsg diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index cf5d12b742c17..76e174b85bb02 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveLift #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} @@ -168,7 +169,7 @@ purgeDep schemaObjId = case schemaObjId of (SOTableObj qt (TORel rn)) -> do liftTx $ delRelFromCatalog qt rn - delFldFromCache (fromRel rn) qt + delRelFromCache rn qt (SOQTemplate qtn) -> do liftTx $ delQTemplateFromCatalog qtn @@ -190,7 +191,7 @@ processTableChanges ti tableDiff = do -- for all the dropped columns forM_ droppedCols $ \droppedCol -> -- Drop the column from the cache - delFldFromCache (fromPGCol droppedCol) tn + delColFromCache droppedCol tn -- In the newly added columns check that there is no conflict with relationships forM_ addedCols $ \colInfo@(PGColInfo colName _ _) -> @@ -199,7 +200,7 @@ processTableChanges ti tableDiff = do throw400 AlreadyExists $ "cannot add column " <> colName <<> " in table " <> tn <<> " as a relationship with the name already exists" - _ -> addFldToCache (fromPGCol colName) (FIColumn colInfo) tn + _ -> addColToCache colName colInfo tn sc <- askSchemaCache -- for rest of the columns @@ -211,37 +212,40 @@ processTableChanges ti tableDiff = do let colId = SOTableObj tn $ TOCol oColName depObjs = getDependentObjsWith (== "on_type") sc colId if null depObjs - then updateFldInCache oColName $ FIColumn nci + then updateFldInCache oColName nci else throw400 DependencyError $ "cannot change type of column " <> oColName <<> " in table " <> tn <<> " because of the following dependencies : " <> reportSchemaObjs depObjs | otherwise -> return () where updateFldInCache cn ci = do - delFldFromCache (fromPGCol cn) tn - addFldToCache (fromPGCol cn) ci tn + delColFromCache cn tn + addColToCache cn ci tn tn = tiName ti TableDiff mNewName droppedCols addedCols alteredCols _ = tableDiff +delTableAndDirectDeps :: (P2C m) => QualifiedTable -> m () +delTableAndDirectDeps qtn@(QualifiedTable sn tn) = do + liftTx $ Q.catchE defaultTxErrorHandler $ do + Q.unitQ [Q.sql| + DELETE FROM "hdb_catalog"."hdb_relationship" + WHERE table_schema = $1 AND table_name = $2 + |] (sn, tn) False + Q.unitQ [Q.sql| + DELETE FROM "hdb_catalog"."hdb_permission" + WHERE table_schema = $1 AND table_name = $2 + |] (sn, tn) False + Q.unitQ [Q.sql| + DELETE FROM "hdb_catalog"."event_triggers" + WHERE schema_name = $1 AND table_name = $2 + |] (sn, tn) False + delTableFromCatalog qtn + delTableFromCache qtn + processSchemaChanges :: (P2C m) => SchemaDiff -> m () processSchemaChanges schemaDiff = do -- Purge the dropped tables - forM_ droppedTables $ \qtn@(QualifiedTable sn tn) -> do - liftTx $ Q.catchE defaultTxErrorHandler $ do - Q.unitQ [Q.sql| - DELETE FROM "hdb_catalog"."hdb_relationship" - WHERE table_schema = $1 AND table_name = $2 - |] (sn, tn) False - Q.unitQ [Q.sql| - DELETE FROM "hdb_catalog"."hdb_permission" - WHERE table_schema = $1 AND table_name = $2 - |] (sn, tn) False - Q.unitQ [Q.sql| - DELETE FROM "hdb_catalog"."event_triggers" - WHERE schema_name = $1 AND table_name = $2 - |] (sn, tn) False - delTableFromCatalog qtn - delTableFromCache qtn + mapM_ delTableAndDirectDeps droppedTables -- Get schema cache sc <- askSchemaCache forM_ alteredTables $ \(oldQtn, tableDiff) -> do @@ -259,81 +263,48 @@ data UntrackTable = } deriving (Show, Eq, Lift) $(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''UntrackTable) -unTrackExistingTableOrViewP1 :: UntrackTable -> P1 (UntrackTable, TableInfo) -unTrackExistingTableOrViewP1 ut@(UntrackTable vn _) = do +unTrackExistingTableOrViewP1 :: UntrackTable -> P1 () +unTrackExistingTableOrViewP1 (UntrackTable vn _) = do adminOnly rawSchemaCache <- getSchemaCache <$> lift ask case M.lookup vn (scTables rawSchemaCache) of - Just ti -> do + Just ti -> -- Check if table/view is system defined when (tiSystemDefined ti) $ throw400 NotSupported $ vn <<> " is system defined, cannot untrack" - return (ut, ti) Nothing -> throw400 AlreadyUntracked $ "view/table already untracked : " <>> vn -unTrackExistingTableOrViewP2 :: (P2C m) - => UntrackTable -> TableInfo -> m RespBody -unTrackExistingTableOrViewP2 (UntrackTable vn cascade) tableInfo = do +unTrackExistingTableOrViewP2 + :: (P2C m) + => UntrackTable -> m RespBody +unTrackExistingTableOrViewP2 (UntrackTable qtn cascade) = do sc <- askSchemaCache - -- Get Foreign key constraints to this table - fKeyTables <- liftTx getFKeyTables - let fKeyDepIds = mkFKeyObjIds $ filterTables fKeyTables $ scTables sc - - -- Report back with an error if any fkey object ids are present - when (fKeyDepIds /= []) $ reportDepsExt fKeyDepIds [] - -- Get relational and query template dependants - let allRels = getAllRelations $ scTables sc - directRelDep = (vn, getRels $ tiFieldInfoMap tableInfo) - relDeps = directRelDep : foldl go [] allRels - relDepIds = concatMap mkObjIdFromRel relDeps - queryTDepIds = getDependentObjsOfQTemplateCache (SOTable vn) - (scQTemplates sc) - allDepIds = relDepIds <> queryTDepIds + let allDeps = getDependentObjs sc (SOTable qtn) + indirectDeps = filter (not . isDirectDep) allDeps -- Report bach with an error if cascade is not set - when (allDepIds /= [] && not (or cascade)) $ reportDepsExt allDepIds [] + when (indirectDeps /= [] && not (or cascade)) $ reportDepsExt indirectDeps [] -- Purge all the dependants from state - mapM_ purgeDep allDepIds + mapM_ purgeDep indirectDeps - -- update the schema cache with the changes - processSchemaChanges $ SchemaDiff [vn] [] + -- delete the table and its direct dependencies + delTableAndDirectDeps qtn return successMsg where - QualifiedTable sn tn = vn - getFKeyTables = Q.catchE defaultTxErrorHandler $ Q.listQ [Q.sql| - SELECT constraint_name, - table_schema, - table_name - FROM hdb_catalog.hdb_foreign_key_constraint - WHERE ref_table_table_schema = $1 - AND ref_table = $2 - |] (sn, tn) False - filterTables tables tc = flip filter tables $ \(_, s, t) -> - isJust $ M.lookup (QualifiedTable s t) tc - - mkFKeyObjIds tables = flip map tables $ \(cn, s, t) -> - SOTableObj (QualifiedTable s t) (TOCons cn) - - getAllRelations tc = map getRelInfo $ M.toList tc - getRelInfo (qt, ti) = (qt, getRels $ tiFieldInfoMap ti) - - go l (qt, ris) = if any isDep ris - then (qt, filter isDep ris):l - else l - isDep relInfo = vn == riRTable relInfo - mkObjIdFromRel (qt, ris) = flip map ris $ \ri -> - SOTableObj qt (TORel $ riName ri) + isDirectDep = \case + (SOTableObj dtn _) -> qtn == dtn + _ -> False instance HDBQuery UntrackTable where - type Phase1Res UntrackTable = (UntrackTable, TableInfo) + type Phase1Res UntrackTable = () phaseOne = unTrackExistingTableOrViewP1 - phaseTwo _ = uncurry unTrackExistingTableOrViewP2 + phaseTwo q _ = unTrackExistingTableOrViewP2 q schemaCachePolicy = SCPReload @@ -371,9 +342,9 @@ buildSchemaCache = flip execStateT emptySchemaCache $ do forM_ qtemplates $ \(qtn, Q.AltJ qtDefVal) -> do qtDef <- decodeValue qtDefVal qCtx <- mkAdminQCtx <$> get - qti <- liftP1 qCtx $ createQueryTemplateP1 $ + (qti, deps) <- liftP1 qCtx $ createQueryTemplateP1 $ CreateQueryTemplate qtn qtDef Nothing - addQTemplateToCache qti + addQTemplateToCache qti deps eventTriggers <- lift $ Q.catchE defaultTxErrorHandler fetchEventTriggers forM_ eventTriggers $ \(sn, tn, trid, trn, Q.AltJ configuration) -> do @@ -390,9 +361,9 @@ buildSchemaCache = flip execStateT emptySchemaCache $ do let qt = QualifiedTable sn tn permDef = PermDef rn perm Nothing createPerm = WithTable qt permDef - p1Res <- liftP1 qCtx $ phaseOne createPerm - addPermP2Setup qt permDef p1Res - addPermToCache qt rn pa p1Res + (permInfo, deps) <- liftP1 qCtx $ phaseOne createPerm + addPermP2Setup qt permDef permInfo + addPermToCache qt rn pa permInfo deps -- p2F qt rn p1Res fetchTables = @@ -482,11 +453,9 @@ runSqlP2 (RunSQL t cascade) = do let tn = tiName ti cols = getCols $ tiFieldInfoMap ti forM_ (M.toList $ tiEventTriggerInfoMap ti) $ \(trn, eti) -> do - let insert = otiCols <$> etiInsert eti - update = otiCols <$> etiUpdate eti - delete = otiCols <$> etiDelete eti + let opsDef = etiOpsDef eti trid = etiId eti - liftTx $ mkTriggerQ trid trn tn cols (TriggerOpsDef insert update delete) + liftTx $ mkTriggerQ trid trn tn cols opsDef return $ encode (res :: RunSQLRes) diff --git a/server/src-lib/Hasura/RQL/DDL/Subscribe.hs b/server/src-lib/Hasura/RQL/DDL/Subscribe.hs index 97e0a54fec9fa..3cb78593fec7b 100644 --- a/server/src-lib/Hasura/RQL/DDL/Subscribe.hs +++ b/server/src-lib/Hasura/RQL/DDL/Subscribe.hs @@ -238,7 +238,29 @@ subTableP2Setup qt trid (EventTriggerConf name def webhook webhookFromEnv rconf let headerConfs = fromMaybe [] mheaders webhookInfo <- getWebhookInfoFromConf webhookConf headerInfos <- getHeaderInfosFromConf headerConfs - addEventTriggerToCache qt trid name def rconf webhookInfo headerInfos + let eTrigInfo = EventTriggerInfo trid name def rconf webhookInfo headerInfos + tabDep = SchemaDependency (SOTable qt) "parent" + addEventTriggerToCache qt eTrigInfo (tabDep:getTrigDefDeps qt def) + +getTrigDefDeps :: QualifiedTable -> TriggerOpsDef -> [SchemaDependency] +getTrigDefDeps qt (TriggerOpsDef mIns mUpd mDel) = + mconcat $ catMaybes [ subsOpSpecDeps <$> mIns + , subsOpSpecDeps <$> mUpd + , subsOpSpecDeps <$> mDel + ] + where + subsOpSpecDeps :: SubscribeOpSpec -> [SchemaDependency] + subsOpSpecDeps os = + let cols = getColsFromSub $ sosColumns os + colDeps = flip map cols $ \col -> + SchemaDependency (SOTableObj qt (TOCol col)) "column" + payload = maybe [] getColsFromSub (sosPayload os) + payloadDeps = flip map payload $ \col -> + SchemaDependency (SOTableObj qt (TOCol col)) "payload" + in colDeps <> payloadDeps + getColsFromSub sc = case sc of + SubCStar -> [] + SubCArray pgcols -> pgcols subTableP2 :: (P2C m) => QualifiedTable -> Bool -> EventTriggerConf -> m () subTableP2 qt replace etc = do diff --git a/server/src-lib/Hasura/RQL/DML/Count.hs b/server/src-lib/Hasura/RQL/DML/Count.hs index 5fcc703cb4e45..85945a61aa4b8 100644 --- a/server/src-lib/Hasura/RQL/DML/Count.hs +++ b/server/src-lib/Hasura/RQL/DML/Count.hs @@ -23,7 +23,7 @@ import qualified Hasura.SQL.DML as S data CountQueryP1 = CountQueryP1 { cqp1Table :: !QualifiedTable - , cqp1Where :: !(S.BoolExp, Maybe (GBoolExp AnnSQLBoolExp)) + , cqp1Where :: !(AnnBoolExpSQL, Maybe AnnBoolExpSQL) , cqp1Distinct :: !(Maybe [PGCol]) } deriving (Show, Eq) @@ -48,8 +48,8 @@ mkSQLCount (CountQueryP1 tn (permFltr, mWc) mDistCols) = where finalWC = - S.BEBin S.AndOp permFltr $ - maybe (S.BELit True) cBoolExp mWc + toSQLBoolExp (S.QualTable tn) $ + maybe permFltr (andAnnBoolExps permFltr) mWc innerSel = partSel { S.selFrom = Just $ S.mkSimpleFromExp tn @@ -90,7 +90,7 @@ countP1 prepValBuilder (CountQuery qt mDistCols mWhere) = do -- convert the where clause annSQLBoolExp <- forM mWhere $ \be -> withPathK "where" $ - convBoolExp' colInfoMap qt selPerm be prepValBuilder + convBoolExp' colInfoMap selPerm be prepValBuilder return $ CountQueryP1 qt @@ -105,7 +105,8 @@ countP1 prepValBuilder (CountQuery qt mDistCols mWhere) = do countP2 :: (P2C m) => (CountQueryP1, DS.Seq Q.PrepArg) -> m RespBody countP2 (u, p) = do - qRes <- liftTx $ Q.rawQE dmlTxErrorHandler (Q.fromBuilder countSQL) (toList p) True + qRes <- liftTx $ Q.rawQE dmlTxErrorHandler + (Q.fromBuilder countSQL) (toList p) True return $ BB.toLazyByteString $ encodeCount qRes where countSQL = toSQL $ mkSQLCount u diff --git a/server/src-lib/Hasura/RQL/DML/Delete.hs b/server/src-lib/Hasura/RQL/DML/Delete.hs index eaab1d91bf95b..02786b944d6e7 100644 --- a/server/src-lib/Hasura/RQL/DML/Delete.hs +++ b/server/src-lib/Hasura/RQL/DML/Delete.hs @@ -23,7 +23,7 @@ import qualified Hasura.SQL.DML as S data DeleteQueryP1 = DeleteQueryP1 { dqp1Table :: !QualifiedTable - , dqp1Where :: !(S.BoolExp, GBoolExp AnnSQLBoolExp) + , dqp1Where :: !(AnnBoolExpSQL, AnnBoolExpSQL) , dqp1MutFlds :: !MutFlds } deriving (Show, Eq) @@ -33,7 +33,8 @@ mkSQLDelete (DeleteQueryP1 tn (fltr, wc) mutFlds) = mkSelWith tn (S.CTEDelete delete) mutFlds False where delete = S.SQLDelete tn Nothing tableFltr $ Just S.returningStar - tableFltr = Just $ S.WhereFrag $ S.BEBin S.AndOp fltr $ cBoolExp wc + tableFltr = Just $ S.WhereFrag $ + toSQLBoolExp (S.QualTable tn) $ andAnnBoolExps fltr wc getDeleteDeps :: DeleteQueryP1 -> [SchemaDependency] @@ -74,7 +75,7 @@ convDeleteQuery prepValBuilder (DeleteQuery tableName rqlBE mRetCols) = do -- convert the where clause annSQLBoolExp <- withPathK "where" $ - convBoolExp' fieldInfoMap tableName selPerm rqlBE prepValBuilder + convBoolExp' fieldInfoMap selPerm rqlBE prepValBuilder return $ DeleteQueryP1 tableName (dpiFilter delPerm, annSQLBoolExp) diff --git a/server/src-lib/Hasura/RQL/DML/Internal.hs b/server/src-lib/Hasura/RQL/DML/Internal.hs index 6aa598e592b9f..27e7b41fd6574 100644 --- a/server/src-lib/Hasura/RQL/DML/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Internal.hs @@ -24,9 +24,6 @@ import qualified Data.HashSet as HS import qualified Data.Sequence as DS import qualified Data.Text as T --- class (P1C m) => Preparable m where --- prepValBuilder :: PGColType -> Value -> m S.SQLExp - type DMLP1 = StateT (DS.Seq Q.PrepArg) P1 instance CacheRM DMLP1 where @@ -35,12 +32,6 @@ instance CacheRM DMLP1 where instance UserInfoM DMLP1 where askUserInfo = lift askUserInfo --- instance P1C DMLP1 where --- askUserInfo = lift askUserInfo - --- instance Preparable DMLP1 where --- prepValBuilder = binRHSBuilder - peelDMLP1 :: QCtx -> DMLP1 a -> Either QErr (a, [Q.PrepArg]) peelDMLP1 qEnv m = do (a, prepSeq) <- runP1 qEnv $ runStateT m DS.empty @@ -55,10 +46,11 @@ mkAdminRolePermInfo ti = . map fieldInfoToEither . M.elems $ tiFieldInfoMap ti tn = tiName ti - i = InsPermInfo tn (S.BELit True) True M.empty [] [] - s = SelPermInfo (HS.fromList pgCols) tn (S.BELit True) Nothing True [] [] - u = UpdPermInfo (HS.fromList pgCols) tn (S.BELit True) [] [] - d = DelPermInfo tn (S.BELit True) [] [] + i = InsPermInfo tn annBoolExpTrue True M.empty [] + s = SelPermInfo (HS.fromList pgCols) tn annBoolExpTrue + Nothing True [] + u = UpdPermInfo (HS.fromList pgCols) tn annBoolExpTrue [] + d = DelPermInfo tn annBoolExpTrue [] askPermInfo' :: (P1C m) @@ -178,47 +170,39 @@ fetchRelDet relName refTabName = do , " table " <>> rTable ] -checkOnColExp :: (P1C m) - => SelPermInfo -> AnnValS -> m AnnValS -checkOnColExp spi annVal = - case annVal of - AVCol pci@(PGColInfo cn _ _) opExps -> do - checkSelOnCol spi cn - return $ AVCol pci opExps - AVRel relInfo nesAnn _ -> do - relSPI <- snd <$> fetchRelDet (riName relInfo) (riRTable relInfo) - modAnn <- checkSelPerm relSPI nesAnn - return $ AVRel relInfo modAnn $ spiFilter relSPI - -checkSelPerm :: (P1C m) - => SelPermInfo -> GBoolExp AnnValS -> m (GBoolExp AnnValS) -checkSelPerm spi = mapBoolExp (checkOnColExp spi) - -convBoolExp +checkOnColExp :: (P1C m) - => FieldInfoMap - -> QualifiedTable - -> SelPermInfo - -> BoolExp - -> (PGColType -> Value -> m S.SQLExp) - -> m S.BoolExp -convBoolExp cim tn spi be prepValBuilder = - cBoolExp <$> convBoolExp' cim tn spi be prepValBuilder + => SelPermInfo + -> AnnBoolExpFldSQL + -> m AnnBoolExpFldSQL +checkOnColExp spi annFld = case annFld of + AVCol (PGColInfo cn _ _) _ -> do + checkSelOnCol spi cn + return annFld + AVRel relInfo nesAnn -> do + relSPI <- snd <$> fetchRelDet (riName relInfo) (riRTable relInfo) + modAnn <- checkSelPerm relSPI nesAnn + return $ AVRel relInfo $ + andAnnBoolExps modAnn $ spiFilter relSPI + +checkSelPerm + :: (P1C m) + => SelPermInfo + -> AnnBoolExpSQL + -> m AnnBoolExpSQL +checkSelPerm spi = + traverse (checkOnColExp spi) convBoolExp' :: (P1C m) => FieldInfoMap - -> QualifiedTable -> SelPermInfo -> BoolExp -> (PGColType -> Value -> m S.SQLExp) - -> m (GBoolExp AnnSQLBoolExp) -convBoolExp' cim tn spi be prepValBuilder = do + -> m AnnBoolExpSQL +convBoolExp' cim spi be prepValBuilder = do abe <- annBoolExp prepValBuilder cim be - modABE <- checkSelPerm spi abe - convBoolRhs binStrat (S.mkQual tn) modABE - where - binStrat = mkBoolExpBuilder return + checkSelPerm spi abe dmlTxErrorHandler :: Q.PGTxErr -> QErr dmlTxErrorHandler p2Res = diff --git a/server/src-lib/Hasura/RQL/DML/QueryTemplate.hs b/server/src-lib/Hasura/RQL/DML/QueryTemplate.hs index e6403e5afd167..b9b28b9407be1 100644 --- a/server/src-lib/Hasura/RQL/DML/QueryTemplate.hs +++ b/server/src-lib/Hasura/RQL/DML/QueryTemplate.hs @@ -125,7 +125,7 @@ convQT args qt = case qt of execQueryTemplateP1 :: ExecQueryTemplate -> P1 QueryTProc execQueryTemplateP1 (ExecQueryTemplate qtn args) = do - (QueryTemplateInfo _ qt _) <- askQTemplateInfo qtn + (QueryTemplateInfo _ qt) <- askQTemplateInfo qtn convQT args qt execQueryTP2 :: (P2C m) => QueryTProc -> m RespBody diff --git a/server/src-lib/Hasura/RQL/DML/Returning.hs b/server/src-lib/Hasura/RQL/DML/Returning.hs index ecb3733b8b0dc..f678096d4188f 100644 --- a/server/src-lib/Hasura/RQL/DML/Returning.hs +++ b/server/src-lib/Hasura/RQL/DML/Returning.hs @@ -59,8 +59,9 @@ mkMutFldExp qt singleObj = \case } MExp t -> S.SELit t MRet selFlds -> - let tabFrom = TableFrom qt $ Just frmItem - tabPerm = TablePerm (S.BELit True) Nothing + -- let tabFrom = TableFrom qt $ Just frmItem + let tabFrom = TableFrom qt $ Just $ qualTableToAliasIden qt + tabPerm = TablePerm annBoolExpTrue Nothing in S.SESelect $ mkSQLSelect singleObj $ AnnSelG selFlds tabFrom tabPerm noTableArgs where diff --git a/server/src-lib/Hasura/RQL/DML/Select.hs b/server/src-lib/Hasura/RQL/DML/Select.hs index c0fed46b6d252..6841a84345a18 100644 --- a/server/src-lib/Hasura/RQL/DML/Select.hs +++ b/server/src-lib/Hasura/RQL/DML/Select.hs @@ -47,7 +47,7 @@ convSelCol fieldInfoMap _ (SCExtRel rn malias selQ) = do let pgWhenRelErr = "only relationships can be expanded" relInfo <- withPathK "name" $ askRelType fieldInfoMap rn pgWhenRelErr - let (RelInfo _ _ _ relTab _ _) = relInfo + let (RelInfo _ _ _ relTab _) = relInfo (rfim, rspi) <- fetchRelDet rn relTab resolvedSelQ <- resolveStar rfim rspi selQ return [ECRel rn malias resolvedSelQ] @@ -60,7 +60,7 @@ convWildcard -> SelPermInfo -> Wildcard -> m [ExtCol] -convWildcard fieldInfoMap (SelPermInfo cols _ _ _ _ _ _) wildcard = +convWildcard fieldInfoMap (SelPermInfo cols _ _ _ _ _) wildcard = case wildcard of Star -> return simpleCols (StarDot wc) -> (simpleCols ++) <$> (catMaybes <$> relExtCols wc) @@ -165,12 +165,12 @@ convSelectQ fieldInfoMap selPermInfo selQ prepValBuilder = do annRel <- convExtRel fieldInfoMap relName mAlias relSelQ prepValBuilder return (fromRel $ fromMaybe relName mAlias, FRel annRel) - let spiT = spiTable selPermInfo + -- let spiT = spiTable selPermInfo -- Convert where clause wClause <- forM (sqWhere selQ) $ \be -> withPathK "where" $ - convBoolExp' fieldInfoMap spiT selPermInfo be prepValBuilder + convBoolExp' fieldInfoMap selPermInfo be prepValBuilder annOrdByML <- forM (sqOrderBy selQ) $ \(OrderByExp obItems) -> withPathK "order_by" $ indexedForM obItems $ mapM $ @@ -216,7 +216,7 @@ convExtRel fieldInfoMap relName mAlias selQ prepValBuilder = do -- Point to the name key relInfo <- withPathK "name" $ askRelType fieldInfoMap relName pgWhenRelErr - let (RelInfo _ relTy colMapping relTab _ _) = relInfo + let (RelInfo _ relTy colMapping relTab _) = relInfo (relCIM, relSPI) <- fetchRelDet relName relTab when (relTy == ObjRel && misused) $ throw400 UnexpectedPayload objRelMisuseMsg @@ -258,11 +258,11 @@ getSelectDeps (AnnSelG flds tabFrm _ tableArgs) = TableFrom tn _ = tabFrm annWc = _taWhere tableArgs (sCols, rCols) = partAnnFlds $ map snd flds - colDeps = map (mkColDep "untyped" tn . fst) sCols - relDeps = map (mkRelDep . arName) rCols - nestedDeps = concatMap (getSelectDeps . arAnnSel) rCols - whereDeps = getBoolExpDeps tn <$> annWc - mkRelDep rn = + colDeps = map (mkColDep "untyped" tn . fst) sCols + relDeps = map (mkRelDep . arName) rCols + nestedDeps = concatMap (getSelectDeps . arAnnSel) rCols + whereDeps = getBoolExpDeps tn <$> annWc + mkRelDep rn = SchemaDependency (SOTableObj tn (TORel rn)) "untyped" convSelectQuery diff --git a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs index 954ee0cdb9e20..3c25ed6ea06ce 100644 --- a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs @@ -55,7 +55,7 @@ instance FromJSON ExtCol where data AnnObCol = AOCPG !PGColInfo - | AOCRel !RelInfo !S.BoolExp !AnnObCol + | AOCRel !RelInfo !AnnBoolExpSQL !AnnObCol deriving (Show, Eq) type AnnOrderByItem = OrderByItemG AnnObCol @@ -85,7 +85,7 @@ data AnnFld data TableArgs = TableArgs - { _taWhere :: !(Maybe (GBoolExp AnnSQLBoolExp)) + { _taWhere :: !(Maybe AnnBoolExpSQL) , _taOrderBy :: !(Maybe (NE.NonEmpty AnnOrderByItem)) , _taLimit :: !(Maybe Int) , _taOffset :: !(Maybe S.SQLExp) @@ -124,14 +124,24 @@ data TableAggFld data TableFrom = TableFrom { _tfTable :: !QualifiedTable - , _tfFrom :: !(Maybe S.FromItem) + , _tfIden :: !(Maybe Iden) } deriving (Show, Eq) +tableFromToFromItem :: TableFrom -> S.FromItem +tableFromToFromItem = \case + TableFrom tn Nothing -> S.FISimple tn Nothing + TableFrom _ (Just i) -> S.FIIden i + +tableFromToQual :: TableFrom -> S.Qual +tableFromToQual = \case + TableFrom tn Nothing -> S.QualTable tn + TableFrom _ (Just i) -> S.QualIden i + data TablePerm = TablePerm - { _tpFilter :: !S.BoolExp + { _tpFilter :: !AnnBoolExpSQL , _tpLimit :: !(Maybe Int) - } deriving (Show, Eq) + } deriving (Eq, Show) data AnnSelG a = AnnSelG @@ -339,12 +349,13 @@ processAnnOrderByCol pfx = \case , Nothing ) -- "pfx.or.relname"."pfx.ob.or.relname.rest" AS "pfx.ob.or.relname.rest" - AOCRel (RelInfo rn _ colMapping relTab _ _) relFltr rest -> + AOCRel (RelInfo rn _ colMapping relTab _) relFltr rest -> let relPfx = mkObjRelTableAls pfx rn ((nesAls, nesCol), nesNodeM) = processAnnOrderByCol relPfx rest qualCol = S.mkQIdenExp relPfx nesAls relBaseNode = - BaseNode relPfx (S.FISimple relTab Nothing) relFltr + BaseNode relPfx (S.FISimple relTab Nothing) + (toSQLBoolExp (S.QualTable relTab) relFltr) Nothing Nothing Nothing (HM.singleton nesAls nesCol) (maybe HM.empty (uncurry HM.singleton) nesNodeM) @@ -360,8 +371,7 @@ mkEmptyBaseNode pfx tableFrom = selOne HM.empty HM.empty HM.empty where selOne = HM.singleton (S.Alias $ pfx <> Iden "__one") (S.SEUnsafe "1") - TableFrom tn fromItemM = tableFrom - fromItem = fromMaybe (S.FISimple tn Nothing) fromItemM + fromItem = tableFromToFromItem tableFrom -- If query limit > permission limit then consider permission limit Else consider query limit applyPermLimit @@ -413,7 +423,6 @@ mkBaseNode pfx fldAls annSelFlds tableFrom tablePerm tableArgs = BaseNode pfx fromItem finalWhere ordByExpM finalLimit offsetM allExtrs allObjsWithOb allArrs aggs where - TableFrom tn fromItemM = tableFrom TablePerm fltr permLimitM = tablePerm TableArgs whereM orderByM limitM offsetM = tableArgs (allExtrs, allObjsWithOb, allArrs, aggs) = case annSelFlds of @@ -460,11 +469,12 @@ mkBaseNode pfx fldAls annSelFlds tableFrom tablePerm tableArgs = in Just (S.Alias colAls, qualCol) mkColExp _ = Nothing - finalWhere = maybe fltr (S.BEBin S.AndOp fltr . cBoolExp) whereM + finalWhere = + toSQLBoolExp tableQual $ maybe fltr (andAnnBoolExps fltr) whereM + fromItem = tableFromToFromItem tableFrom + tableQual = tableFromToQual tableFrom finalLimit = applyPermLimit permLimitM limitM - fromItem = fromMaybe (S.FISimple tn Nothing) fromItemM - _1 (a, _, _) = a _2 (_, b, _) = b _3 (_, _, c) = c diff --git a/server/src-lib/Hasura/RQL/DML/Update.hs b/server/src-lib/Hasura/RQL/DML/Update.hs index 7579a0631c198..c57979afa3fac 100644 --- a/server/src-lib/Hasura/RQL/DML/Update.hs +++ b/server/src-lib/Hasura/RQL/DML/Update.hs @@ -26,7 +26,7 @@ data UpdateQueryP1 = UpdateQueryP1 { uqp1Table :: !QualifiedTable , uqp1SetExps :: ![(PGCol, S.SQLExp)] - , uqp1Where :: !(S.BoolExp, GBoolExp AnnSQLBoolExp) + , uqp1Where :: !(AnnBoolExpSQL, AnnBoolExpSQL) , pqp1MutFlds :: !MutFlds } deriving (Show, Eq) @@ -37,7 +37,8 @@ mkSQLUpdate (UpdateQueryP1 tn setExps (permFltr, wc) mutFlds) = where update = S.SQLUpdate tn setExp Nothing tableFltr $ Just S.returningStar setExp = S.SetExp $ map S.SetExpItem setExps - tableFltr = Just $ S.WhereFrag $ S.BEBin S.AndOp permFltr $ cBoolExp wc + tableFltr = Just $ S.WhereFrag $ + toSQLBoolExp (S.QualTable tn) $ andAnnBoolExps permFltr wc getUpdateDeps :: UpdateQueryP1 @@ -147,14 +148,13 @@ convUpdateQuery f uq = do withPathK "returning" $ checkRetCols fieldInfoMap selPerm retCols let setExpItems = setItems ++ incItems ++ mulItems ++ defItems - updTable = upiTable updPerm when (null setExpItems) $ throw400 UnexpectedPayload "atleast one of $set, $inc, $mul has to be present" -- convert the where clause annSQLBoolExp <- withPathK "where" $ - convBoolExp' fieldInfoMap updTable selPerm (uqWhere uq) f + convBoolExp' fieldInfoMap selPerm (uqWhere uq) f return $ UpdateQueryP1 tableName diff --git a/server/src-lib/Hasura/RQL/GBoolExp.hs b/server/src-lib/Hasura/RQL/GBoolExp.hs index cd4ff7d1ef239..cd91580ea7c91 100644 --- a/server/src-lib/Hasura/RQL/GBoolExp.hs +++ b/server/src-lib/Hasura/RQL/GBoolExp.hs @@ -6,7 +6,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} -module Hasura.RQL.GBoolExp where +module Hasura.RQL.GBoolExp + ( toSQLBoolExp + , getBoolExpDeps + , annBoolExp + , txtRHSBuilder + , pgValParser + ) where import Hasura.Prelude import Hasura.RQL.Types @@ -20,221 +26,120 @@ import Data.Aeson import qualified Data.HashMap.Strict as M import qualified Data.Text.Extended as T -data AnnValOpExpG a - = AEQ !a - | ANE !a - - | AIN ![a] - | ANIN ![a] +parseOpExp + :: (MonadError QErr m) + => ValueParser m a + -> FieldInfoMap + -> PGColInfo + -> (T.Text, Value) -> m (OpExpG a) +parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = case opStr of + "$eq" -> parseEq + "_eq" -> parseEq - | AGT !a - | ALT !a - | AGTE !a - | ALTE !a + "$ne" -> parseNe + "_ne" -> parseNe + "$neq" -> parseNe + "_neq" -> parseNe - | ALIKE !a -- LIKE - | ANLIKE !a -- NOT LIKE + "$in" -> parseIn + "_in" -> parseIn - | AILIKE !a -- ILIKE, case insensitive - | ANILIKE !a-- NOT ILIKE, case insensitive + "$nin" -> parseNin + "_nin" -> parseNin - | ASIMILAR !a -- similar, regex - | ANSIMILAR !a-- not similar, regex + "$gt" -> parseGt + "_gt" -> parseGt - | AContains !a - | AContainedIn !a - | AHasKey !a - | AHasKeysAny [Text] - | AHasKeysAll [Text] + "$lt" -> parseLt + "_lt" -> parseLt - | ANISNULL -- IS NULL - | ANISNOTNULL -- IS NOT NULL + "$gte" -> parseGte + "_gte" -> parseGte - deriving (Eq, Show) + "$lte" -> parseLte + "_lte" -> parseLte -data OpExpG a - = OEVal !(AnnValOpExpG a) - | OECol !ColOp !PGCol - deriving (Show, Eq) + "$like" -> parseLike + "_like" -> parseLike -type OpExpJ = OpExpG Value -type OpExp = OpExpG (PGColType, PGColValue) + "$nlike" -> parseNlike + "_nlike" -> parseNlike -data AnnValG a - = AVCol !PGColInfo !a - | AVRel !RelInfo !(GBoolExp (AnnValG a)) S.BoolExp - deriving (Show, Eq) + "$ilike" -> parseIlike + "_ilike" -> parseIlike -type AnnValS = AnnValG [OpExpG S.SQLExp] -type AnnValO a = AnnValG [OpExpG a] -type AnnVal = AnnValO (PGColType, PGColValue) + "$nilike" -> parseNilike + "_nilike" -> parseNilike -type AnnValJ = AnnValG [OpExpJ] + "$similar" -> parseSimilar + "_similar" -> parseSimilar + "$nsimilar" -> parseNsimilar + "_nsimilar" -> parseNsimilar -type AnnSQLBoolExp = AnnValG S.BoolExp + "$is_null" -> parseIsNull + "_is_null" -> parseIsNull -data ColOp - = CEQ - | CNE - | CGT - | CLT - | CGTE - | CLTE - deriving (Eq) + "$ceq" -> parseCeq + "_ceq" -> parseCeq -instance Show ColOp where - show CEQ = "$ceq" - show CNE = "$cne" + "$cne" -> parseCne + "_cne" -> parseCne + "$cneq" -> parseCne + "_cneq" -> parseCne - show CGT = "$cgt" - show CLT = "$clt" - show CGTE = "$cgte" - show CLTE = "$clte" + "$cgt" -> parseCgt + "_cgt" -> parseCgt -data RQLOp - = REQ -- equals - | RNE -- <> - - | RIN -- in an array - | RNIN -- not in an array - - | RGT -- > - | RLT -- < - | RGTE -- >= - | RLTE -- <= - - | RLIKE -- LIKE - | RNLIKE -- NOT LIKE - - | RILIKE -- ILIKE, case insensitive - | RNILIKE -- NOT ILIKE, case insensitive - - | RSIMILAR -- similar, regex - | RNSIMILAR -- not similar, regex - - | RISNULL -- is null - - deriving (Eq) - -instance Show RQLOp where - show REQ = "$eq" - show RNE = "$ne" - - show RIN = "$in" - show RNIN = "$nin" - - show RGT = "$gt" - show RLT = "$lt" - show RGTE = "$gte" - show RLTE = "$lte" - - show RLIKE = "$like" - show RNLIKE = "$nlike" - - show RILIKE = "$ilike" - show RNILIKE = "$nilike" - - show RSIMILAR = "$similar" - show RNSIMILAR = "$nsimilar" - - show RISNULL = "$is_null" - -instance DQuote RQLOp where - dquoteTxt op = T.pack $ show op - -parseOp :: (MonadError QErr m) => T.Text -> m (Either RQLOp ColOp) -parseOp opStr = case opStr of - "$eq" -> return $ Left REQ - "_eq" -> return $ Left REQ - "$ne" -> return $ Left RNE - "_ne" -> return $ Left RNE - "$neq" -> return $ Left RNE - "_neq" -> return $ Left RNE - - "$in" -> return $ Left RIN - "_in" -> return $ Left RIN - "$nin" -> return $ Left RNIN - "_nin" -> return $ Left RNIN - - "$gt" -> return $ Left RGT - "_gt" -> return $ Left RGT - "$lt" -> return $ Left RLT - "_lt" -> return $ Left RLT - "$gte" -> return $ Left RGTE - "_gte" -> return $ Left RGTE - "$lte" -> return $ Left RLTE - "_lte" -> return $ Left RLTE - - "$like" -> return $ Left RLIKE - "_like" -> return $ Left RLIKE - "$nlike" -> return $ Left RNLIKE - "_nlike" -> return $ Left RNLIKE - - "$ilike" -> return $ Left RILIKE - "_ilike" -> return $ Left RILIKE - "$nilike" -> return $ Left RNILIKE - "_nilike" -> return $ Left RNILIKE - - "$similar" -> return $ Left RSIMILAR - "_similar" -> return $ Left RSIMILAR - "$nsimilar" -> return $ Left RNSIMILAR - "_nsimilar" -> return $ Left RNSIMILAR - - "$is_null" -> return $ Left RISNULL - "_is_null" -> return $ Left RISNULL - - "$ceq" -> return $ Right CEQ - "_ceq" -> return $ Right CEQ - "$cne" -> return $ Right CNE - "_cne" -> return $ Right CNE - "$cneq" -> return $ Right CNE - "_cneq" -> return $ Right CNE - - "$cgt" -> return $ Right CGT - "_cgt" -> return $ Right CGT - "$clt" -> return $ Right CLT - "_clt" -> return $ Right CLT - "$cgte" -> return $ Right CGTE - "_cgte" -> return $ Right CGTE - "$clte" -> return $ Right CLTE - "_clte" -> return $ Right CLTE + "$clt" -> parseClt + "_clt" -> parseClt - x -> throw400 UnexpectedPayload $ "Unknown operator : " <> x + "$cgte" -> parseCgte + "_cgte" -> parseCgte -isRQLOp :: T.Text -> Bool -isRQLOp t = case runIdentity . runExceptT $ parseOp t of - Left _ -> False - Right r -> either (const True) (const False) r + "$clte" -> parseClte + "_clte" -> parseClte -type ValueParser m a = PGColType -> Value -> m a - -parseAnnOpExpG - :: (MonadError QErr m) - => (PGColType -> Value -> m a) - -> RQLOp -> PGColType -> Value -> m (AnnValOpExpG a) -parseAnnOpExpG parser op ty val = case op of - REQ -> AEQ <$> parseOne -- equals - RNE -> ANE <$> parseOne -- <> - RIN -> AIN <$> parseMany -- in an array - RNIN -> ANIN <$> parseMany -- not in an array - RGT -> AGT <$> parseOne -- > - RLT -> ALT <$> parseOne -- < - RGTE -> AGTE <$> parseOne -- >= - RLTE -> ALTE <$> parseOne -- <= - RLIKE -> ALIKE <$> parseOne -- LIKE - RNLIKE -> ANLIKE <$> parseOne -- NOT LIKE - RILIKE -> AILIKE <$> parseOne -- ILIKE, case insensitive - RNILIKE -> ANILIKE <$> parseOne -- NOT ILIKE, case insensitive - RSIMILAR -> ASIMILAR <$> parseOne -- similar, regex - RNSIMILAR -> ANSIMILAR <$> parseOne -- not similar, regex - RISNULL -> bool ANISNOTNULL ANISNULL -- is null - <$> decodeValue val + x -> throw400 UnexpectedPayload $ "Unknown operator : " <> x where - parseOne = parser ty val - -- runAesonParser (parsePGValue ty) val + parseEq = AEQ <$> parseOne -- equals + parseNe = ANE <$> parseOne -- <> + parseIn = AIN <$> parseMany -- in an array + parseNin = ANIN <$> parseMany -- not in an array + parseGt = AGT <$> parseOne -- > + parseLt = ALT <$> parseOne -- < + parseGte = AGTE <$> parseOne -- >= + parseLte = ALTE <$> parseOne -- <= + parseLike = textOnlyOp colTy >> ALIKE <$> parseOne + parseNlike = textOnlyOp colTy >> ANLIKE <$> parseOne + parseIlike = textOnlyOp colTy >> AILIKE <$> parseOne + parseNilike = textOnlyOp colTy >> ANILIKE <$> parseOne + parseSimilar = textOnlyOp colTy >> ASIMILAR <$> parseOne + parseNsimilar = textOnlyOp colTy >> ANSIMILAR <$> parseOne + + parseIsNull = bool ANISNOTNULL ANISNULL -- is null + <$> decodeValue val + parseCeq = CEQ <$> decodeAndValidateRhsCol + parseCne = CNE <$> decodeAndValidateRhsCol + parseCgt = CGT <$> decodeAndValidateRhsCol + parseClt = CLT <$> decodeAndValidateRhsCol + parseCgte = CGTE <$> decodeAndValidateRhsCol + parseClte = CLTE <$> decodeAndValidateRhsCol + + decodeAndValidateRhsCol = + decodeValue val >>= validateRhsCol + + validateRhsCol rhsCol = do + let errMsg = "column operators can only compare postgres columns" + rhsType <- askPGType fim rhsCol errMsg + if colTy /= rhsType + then throw400 UnexpectedPayload $ + "incompatible column types : " <> cn <<> ", " <>> rhsCol + else return rhsCol + + parseOne = parser colTy val parseMany = do vals <- runAesonParser parseJSON val - indexedForM vals (parser ty) + indexedForM vals (parser colTy) parseOpExps :: (MonadError QErr m) @@ -243,27 +148,11 @@ parseOpExps -> PGColInfo -> Value -> m [OpExpG a] -parseOpExps valParser cim (PGColInfo cn colTy _) (Object o) = - forM (M.toList o) $ \(k, v) -> do - op <- parseOp k - case (op, v) of - (Left rqlOp, _) -> do - modifyErr (cn <<>) $ getOpTypeChecker rqlOp colTy - annValOp <- withPathK (T.pack $ show rqlOp) $ - parseAnnOpExpG valParser rqlOp colTy v - return $ OEVal annValOp - (Right colOp, String c) -> do - let pgCol = PGCol c - errMsg = "column operators can only compare postgres columns" - rhsType <- askPGType cim pgCol errMsg - when (colTy /= rhsType) $ - throw400 UnexpectedPayload $ - "incompatible column types : " <> cn <<> ", " <>> pgCol - return $ OECol colOp pgCol - (Right _, _) -> throw400 UnexpectedPayload "expecting a string for column operator" -parseOpExps valParser _ (PGColInfo _ colTy _) val = do - annValOp <- parseAnnOpExpG valParser REQ colTy val - return [OEVal annValOp] +parseOpExps valParser cim colInfo = \case + (Object o) -> mapM (parseOpExp valParser cim colInfo)(M.toList o) + val -> pure . AEQ <$> valParser (pgiType colInfo) val + +type ValueParser m a = PGColType -> Value -> m a buildMsg :: PGColType -> [PGColType] -> QErr buildMsg ty expTys = @@ -274,34 +163,12 @@ buildMsg ty expTys = , T.intercalate "/" $ map (T.dquote . T.pack . show) expTys ] -type OpTypeChecker m = PGColType -> m () - -textOnlyOp :: (MonadError QErr m) => OpTypeChecker m +textOnlyOp :: (MonadError QErr m) => PGColType -> m () textOnlyOp PGText = return () textOnlyOp PGVarchar = return () textOnlyOp ty = throwError $ buildMsg ty [PGVarchar, PGText] -validOnAllTypes :: (MonadError QErr m) => OpTypeChecker m -validOnAllTypes _ = return () - -getOpTypeChecker :: (MonadError QErr m) => RQLOp -> OpTypeChecker m -getOpTypeChecker REQ = validOnAllTypes -getOpTypeChecker RNE = validOnAllTypes -getOpTypeChecker RIN = validOnAllTypes -getOpTypeChecker RNIN = validOnAllTypes -getOpTypeChecker RGT = validOnAllTypes -getOpTypeChecker RLT = validOnAllTypes -getOpTypeChecker RGTE = validOnAllTypes -getOpTypeChecker RLTE = validOnAllTypes -getOpTypeChecker RLIKE = textOnlyOp -getOpTypeChecker RNLIKE = textOnlyOp -getOpTypeChecker RILIKE = textOnlyOp -getOpTypeChecker RNILIKE = textOnlyOp -getOpTypeChecker RSIMILAR = textOnlyOp -getOpTypeChecker RNSIMILAR = textOnlyOp -getOpTypeChecker RISNULL = validOnAllTypes - -- This convoluted expression instead of col = val -- to handle the case of col : null equalsBoolExpBuilder :: S.SQLExp -> S.SQLExp -> S.BoolExp @@ -318,32 +185,21 @@ notEqualsBoolExpBuilder qualColExp rhsExp = (S.BENotNull qualColExp) (S.BENull rhsExp)) -mapBoolExp :: (Monad m) - => (a -> m b) - -> GBoolExp a -> m (GBoolExp b) -mapBoolExp f (BoolAnd bes) = BoolAnd <$> mapM (mapBoolExp f) bes -mapBoolExp f (BoolOr bes) = BoolOr <$> mapM (mapBoolExp f) bes -mapBoolExp f (BoolCol ce) = BoolCol <$> f ce -mapBoolExp f (BoolNot notExp) = BoolNot <$> mapBoolExp f notExp - annBoolExp :: (QErrM m, CacheRM m) => ValueParser m a -> FieldInfoMap - -> GBoolExp ColExp - -> m (GBoolExp (AnnValG [OpExpG a])) -annBoolExp valParser cim = \case - (BoolAnd bes) -> BoolAnd <$> mapM (annBoolExp valParser cim) bes - (BoolOr bes) -> BoolOr <$> mapM (annBoolExp valParser cim) bes - (BoolCol ce) -> BoolCol <$> annColExp valParser cim ce - (BoolNot notExp) -> BoolNot <$> annBoolExp valParser cim notExp + -> BoolExp + -> m (AnnBoolExp a) +annBoolExp valParser fim (BoolExp boolExp) = + traverse (annColExp valParser fim) boolExp annColExp :: (QErrM m, CacheRM m) => ValueParser m a -> FieldInfoMap -> ColExp - -> m (AnnValG [OpExpG a]) + -> m (AnnBoolExpFld a) annColExp valueParser colInfoMap (ColExp fieldName colVal) = do colInfo <- askFieldInfo colInfoMap fieldName case colInfo of @@ -357,64 +213,42 @@ annColExp valueParser colInfoMap (ColExp fieldName colVal) = do relBoolExp <- decodeValue colVal relFieldInfoMap <- askFieldInfoMap $ riRTable relInfo annRelBoolExp <- annBoolExp valueParser relFieldInfoMap relBoolExp - return $ AVRel relInfo annRelBoolExp $ S.BELit True + return $ AVRel relInfo annRelBoolExp -type BoolExpBuilder m a = S.SQLExp -> AnnValOpExpG a -> m S.BoolExp +toSQLBoolExp + :: S.Qual -> AnnBoolExpSQL -> S.BoolExp +toSQLBoolExp tq e = + evalState (convBoolRhs' tq e) 0 -convBoolRhs - :: (Monad m) - => BoolExpBuilder m a -> S.Qual - -> GBoolExp (AnnValO a) -> m (GBoolExp AnnSQLBoolExp) -convBoolRhs vp tq = - traverse (convColRhs vp tq ) +convBoolRhs' + :: S.Qual -> AnnBoolExpSQL -> State Word64 S.BoolExp +convBoolRhs' tq = + foldBoolExp (convColRhs tq) convColRhs - :: (Monad m) - => BoolExpBuilder m a - -> S.Qual -> AnnValO a -> m (AnnValG S.BoolExp) -convColRhs bExpBuilder tableQual annVal = case annVal of - AVCol pci@(PGColInfo cn _ _) opExps -> do - let qualColExp = S.SEQIden $ S.QIden tableQual (toIden cn) - bExps <- forM opExps $ \case - OEVal annOpValExp -> bExpBuilder qualColExp annOpValExp - OECol op rCol -> do - let rhsColExp = S.SEQIden $ S.QIden tableQual (toIden rCol) - return $ mkColOpSQLExp op qualColExp rhsColExp - -- And them all - return $ AVCol pci $ foldr (S.BEBin S.AndOp) (S.BELit True) bExps - - AVRel ri@(RelInfo _ _ colMapping relTN _ _) nesAnn fltr -> do + :: S.Qual -> AnnBoolExpFldSQL -> State Word64 S.BoolExp +convColRhs tableQual = \case + AVCol (PGColInfo cn _ _) opExps -> do + let bExps = map (mkColCompExp tableQual cn) opExps + return $ foldr (S.BEBin S.AndOp) (S.BELit True) bExps + + AVRel (RelInfo _ _ colMapping relTN _) nesAnn -> do -- Convert the where clause on the relationship - annRelBoolExp <- convBoolRhs bExpBuilder (S.mkQual relTN) nesAnn - let backCompExp = foldr (S.BEBin S.AndOp) (S.BELit True) $ + curVarNum <- get + put $ curVarNum + 1 + let newIden = Iden $ "_be_" <> T.pack (show curVarNum) <> "_" + <> snakeCaseTable relTN + newIdenQ = S.QualIden newIden + annRelBoolExp <- convBoolRhs' newIdenQ nesAnn + let backCompExp = foldr (S.BEBin S.AndOp) (S.BELit True) $ flip map colMapping $ \(lCol, rCol) -> - S.BECompare S.SEQ (S.mkSIdenExp rCol) - (S.SEQIden $ S.QIden tableQual (toIden lCol)) - return $ AVRel ri annRelBoolExp $ S.BEBin S.AndOp fltr backCompExp - -cBoolExp - :: GBoolExp AnnSQLBoolExp - -> S.BoolExp -cBoolExp be = - runIdentity $ flip foldBoolExp be $ \ace -> - return $ cColExp ace - -cColExp - :: AnnSQLBoolExp - -> S.BoolExp -cColExp annVal = case annVal of - AVCol _ be -> be - AVRel (RelInfo _ _ _ relTN _ _) nesAnn backCompExp -> do - -- Convert the where clause on the relationship - let annRelBoolExp = cBoolExp nesAnn + S.BECompare S.SEQ + (mkQCol (S.QualIden newIden) rCol) + (mkQCol tableQual lCol) innerBoolExp = S.BEBin S.AndOp backCompExp annRelBoolExp - S.mkExists relTN innerBoolExp - --- txtValParser --- :: (MonadError QErr m) --- => ValueParser m (AnnValOpExpG S.SQLExp) --- txtValParser = --- undefined + return $ S.mkExists (S.FISimple relTN $ Just $ S.Alias newIden) innerBoolExp + where + mkQCol q = S.SEQIden . S.QIden q . toIden pgValParser :: (MonadError QErr m) @@ -428,83 +262,54 @@ txtRHSBuilder txtRHSBuilder ty val = txtEncoder <$> pgValParser ty val --- this does not parse the value -noValParser - :: (MonadError QErr m) - => ValueParser m Value -noValParser _ = return - --- binExpBuilder --- :: (Monad m) --- => BoolExpBuilder m PGColValue --- binExpBuilder = --- mkBoolExpBuilder - -mkBoolExpBuilder - :: (Monad m) - => (a -> m S.SQLExp) - -> BoolExpBuilder m a -mkBoolExpBuilder rhsBldr lhs = \case - AEQ val -> mkSimpleBoolExpBuilder equalsBoolExpBuilder val - ANE val -> mkSimpleBoolExpBuilder notEqualsBoolExpBuilder val - AIN vals -> mkInOrNotBoolExpBuilder True vals - ANIN vals -> mkInOrNotBoolExpBuilder False vals - AGT val -> mkSimpleBoolExpBuilder (S.BECompare S.SGT) val - ALT val -> mkSimpleBoolExpBuilder (S.BECompare S.SLT) val - AGTE val -> mkSimpleBoolExpBuilder (S.BECompare S.SGTE) val - ALTE val -> mkSimpleBoolExpBuilder (S.BECompare S.SLTE) val - ALIKE val -> mkSimpleBoolExpBuilder (S.BECompare S.SLIKE) val - ANLIKE val -> mkSimpleBoolExpBuilder (S.BECompare S.SNLIKE) val - AILIKE val -> mkSimpleBoolExpBuilder (S.BECompare S.SILIKE) val - ANILIKE val -> mkSimpleBoolExpBuilder (S.BECompare S.SNILIKE) val - ASIMILAR val -> mkSimpleBoolExpBuilder (S.BECompare S.SSIMILAR) val - ANSIMILAR val -> mkSimpleBoolExpBuilder (S.BECompare S.SNSIMILAR) val - AContains val -> mkSimpleBoolExpBuilder (S.BECompare S.SContains) val - AContainedIn val -> mkSimpleBoolExpBuilder (S.BECompare S.SContainedIn) val - AHasKey val -> mkSimpleBoolExpBuilder (S.BECompare S.SHasKey) val - AHasKeysAny keys -> return $ S.BECompare S.SHasKeysAny lhs $ toTextArray keys - AHasKeysAll keys -> return $ S.BECompare S.SHasKeysAll lhs $ toTextArray keys - ANISNULL -> return $ S.BENull lhs - ANISNOTNULL -> return $ S.BENotNull lhs +mkColCompExp + :: S.Qual -> PGCol -> OpExpG S.SQLExp -> S.BoolExp +mkColCompExp qual lhsCol = \case + AEQ val -> equalsBoolExpBuilder lhs val + ANE val -> notEqualsBoolExpBuilder lhs val + AIN vals -> S.BEEqualsAny lhs vals + ANIN vals -> S.BENot $ S.BEEqualsAny lhs vals + AGT val -> S.BECompare S.SGT lhs val + ALT val -> S.BECompare S.SLT lhs val + AGTE val -> S.BECompare S.SGTE lhs val + ALTE val -> S.BECompare S.SLTE lhs val + ALIKE val -> S.BECompare S.SLIKE lhs val + ANLIKE val -> S.BECompare S.SNLIKE lhs val + AILIKE val -> S.BECompare S.SILIKE lhs val + ANILIKE val -> S.BECompare S.SNILIKE lhs val + ASIMILAR val -> S.BECompare S.SSIMILAR lhs val + ANSIMILAR val -> S.BECompare S.SNSIMILAR lhs val + AContains val -> S.BECompare S.SContains lhs val + AContainedIn val -> S.BECompare S.SContainedIn lhs val + AHasKey val -> S.BECompare S.SHasKey lhs val + AHasKeysAny keys -> S.BECompare S.SHasKeysAny lhs $ toTextArray keys + AHasKeysAll keys -> S.BECompare S.SHasKeysAll lhs $ toTextArray keys + ANISNULL -> S.BENull lhs + ANISNOTNULL -> S.BENotNull lhs + CEQ rhsCol -> S.BECompare S.SEQ lhs $ mkQCol rhsCol + CNE rhsCol -> S.BECompare S.SNE lhs $ mkQCol rhsCol + CGT rhsCol -> S.BECompare S.SGT lhs $ mkQCol rhsCol + CLT rhsCol -> S.BECompare S.SLT lhs $ mkQCol rhsCol + CGTE rhsCol -> S.BECompare S.SGTE lhs $ mkQCol rhsCol + CLTE rhsCol -> S.BECompare S.SLTE lhs $ mkQCol rhsCol where + mkQCol = S.SEQIden . S.QIden qual . toIden + lhs = mkQCol lhsCol + toTextArray arr = S.SETyAnn (S.SEArray $ map (txtEncoder . PGValText) arr) S.textArrType - mkSimpleBoolExpBuilder beF pgColVal = - beF lhs <$> rhsBldr pgColVal - - mkInOrNotBoolExpBuilder isIn arrVals = do - rhsExps <- mapM rhsBldr arrVals - let boolExp = S.BEEqualsAny lhs rhsExps - return $ bool (S.BENot boolExp) boolExp isIn - --- txtRHSBuilder :: (MonadError QErr m) => RHSBuilder m --- txtRHSBuilder colType = runAesonParser (convToTxt colType) - -mkColOpSQLExp :: ColOp -> S.SQLExp -> S.SQLExp -> S.BoolExp -mkColOpSQLExp colOp = - case colOp of - CEQ -> S.BECompare S.SEQ - CNE -> S.BECompare S.SNE - CGT -> S.BECompare S.SGT - CLT -> S.BECompare S.SLT - CGTE -> S.BECompare S.SGTE - CLTE -> S.BECompare S.SLTE - -getColExpDeps :: QualifiedTable -> AnnValG a -> [SchemaDependency] -getColExpDeps tn (AVCol pgCI _) = - [SchemaDependency (SOTableObj tn (TOCol $ pgiName pgCI)) "on_type"] -getColExpDeps tn (AVRel relInfo nesAnn _) = - pd : getBoolExpDeps (riRTable relInfo) nesAnn - where - pd = SchemaDependency (SOTableObj tn (TORel $ riName relInfo)) "on_type" - -getBoolExpDeps :: QualifiedTable -> GBoolExp (AnnValG a) -> [SchemaDependency] -getBoolExpDeps tn (BoolAnd exps) = - mconcat $ map (getBoolExpDeps tn) exps -getBoolExpDeps tn (BoolOr exps) = - mconcat $ map (getBoolExpDeps tn) exps -getBoolExpDeps tn (BoolCol colExp) = - getColExpDeps tn colExp -getBoolExpDeps tn (BoolNot notExp) = - getBoolExpDeps tn notExp +getColExpDeps :: QualifiedTable -> AnnBoolExpFld a -> [SchemaDependency] +getColExpDeps tn = \case + AVCol colInfo _ -> + let cn = pgiName colInfo + in [SchemaDependency (SOTableObj tn (TOCol cn)) "on_type"] + AVRel relInfo relBoolExp -> + let rn = riName relInfo + relTN = riRTable relInfo + pd = SchemaDependency (SOTableObj tn (TORel rn)) "on_type" + in pd : getBoolExpDeps relTN relBoolExp + +getBoolExpDeps :: QualifiedTable -> AnnBoolExp a -> [SchemaDependency] +getBoolExpDeps tn = + foldr (\annFld deps -> getColExpDeps tn annFld <> deps) [] diff --git a/server/src-lib/Hasura/RQL/Types.hs b/server/src-lib/Hasura/RQL/Types.hs index 78e8b899382c2..8c5ac35be6175 100644 --- a/server/src-lib/Hasura/RQL/Types.hs +++ b/server/src-lib/Hasura/RQL/Types.hs @@ -48,6 +48,7 @@ module Hasura.RQL.Types ) where import Hasura.Prelude +import Hasura.RQL.Types.BoolExp as R import Hasura.RQL.Types.Common as R import Hasura.RQL.Types.DML as R import Hasura.RQL.Types.Error as R diff --git a/server/src-lib/Hasura/RQL/Types/BoolExp.hs b/server/src-lib/Hasura/RQL/Types/BoolExp.hs new file mode 100644 index 0000000000000..a22841326fa92 --- /dev/null +++ b/server/src-lib/Hasura/RQL/Types/BoolExp.hs @@ -0,0 +1,211 @@ +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} + +module Hasura.RQL.Types.BoolExp + ( GBoolExp(..) + , gBoolExpTrue + , gBoolExpToJSON + , parseGBoolExp + + , OpExpG(..) + + , AnnBoolExpFld(..) + , AnnBoolExp + , annBoolExpTrue + , andAnnBoolExps + + , AnnBoolExpFldSQL + , AnnBoolExpSQL + , foldBoolExp + ) where + +import Hasura.Prelude +import Hasura.RQL.Types.Common +import qualified Hasura.SQL.DML as S +import Hasura.SQL.Types + +import Data.Aeson +import Data.Aeson.Internal +import qualified Data.Aeson.Types as J +import qualified Data.HashMap.Strict as M +import Instances.TH.Lift () +import Language.Haskell.TH.Syntax (Lift) + +data GBoolExp a + = BoolAnd ![GBoolExp a] + | BoolOr ![GBoolExp a] + | BoolNot !(GBoolExp a) + | BoolFld !a + deriving (Show, Eq, Lift, Functor, Foldable, Traversable) + +gBoolExpTrue :: GBoolExp a +gBoolExpTrue = BoolAnd [] + +gBoolExpToJSON :: (a -> (Text, Value)) -> GBoolExp a -> Value +gBoolExpToJSON f be = case be of + -- special encoding for _and + BoolAnd bExps -> + let m = M.fromList $ map getKV bExps + -- if the keys aren't repeated, then object encoding can be used + in if length m == length bExps + then toJSON m + else object $ pure kv + _ -> object $ pure kv + where + kv = getKV be + getKV = \case + BoolAnd bExps -> "_and" .= map (gBoolExpToJSON f) bExps + BoolOr bExps -> "_or" .= map (gBoolExpToJSON f) bExps + BoolNot bExp -> "_not" .= gBoolExpToJSON f bExp + BoolFld a -> f a + + +parseGBoolExp + :: ((Text, Value) -> J.Parser a) -> Value -> J.Parser (GBoolExp a) +parseGBoolExp f = \case + Object o -> do + boolExps <- forM (M.toList o) $ \(k, v) -> if + | k == "$or" -> BoolOr <$> parseGBoolExpL v Key k + | k == "_or" -> BoolOr <$> parseGBoolExpL v Key k + | k == "$and" -> BoolAnd <$> parseGBoolExpL v Key k + | k == "_and" -> BoolAnd <$> parseGBoolExpL v Key k + | k == "$not" -> BoolNot <$> parseGBoolExp f v Key k + | k == "_not" -> BoolNot <$> parseGBoolExp f v Key k + | otherwise -> BoolFld <$> f (k, v) + return $ BoolAnd boolExps + _ -> fail "expecting an Object for boolean exp" + where + parseGBoolExpL v = + parseJSON v >>= mapM (parseGBoolExp f) + +foldBoolExp :: (Monad m) + => (a -> m S.BoolExp) + -> GBoolExp a + -> m S.BoolExp +foldBoolExp f (BoolAnd bes) = do + sqlBExps <- mapM (foldBoolExp f) bes + return $ foldr (S.BEBin S.AndOp) (S.BELit True) sqlBExps +foldBoolExp f (BoolOr bes) = do + sqlBExps <- mapM (foldBoolExp f) bes + return $ foldr (S.BEBin S.OrOp) (S.BELit False) sqlBExps +foldBoolExp f (BoolNot notExp) = + S.BENot <$> foldBoolExp f notExp +foldBoolExp f (BoolFld ce) = + f ce + +data OpExpG a + = AEQ !a + | ANE !a + + | AIN ![a] + | ANIN ![a] + + | AGT !a + | ALT !a + | AGTE !a + | ALTE !a + + | ALIKE !a -- LIKE + | ANLIKE !a -- NOT LIKE + + | AILIKE !a -- ILIKE, case insensitive + | ANILIKE !a-- NOT ILIKE, case insensitive + + | ASIMILAR !a -- similar, regex + | ANSIMILAR !a-- not similar, regex + + | AContains !a + | AContainedIn !a + | AHasKey !a + | AHasKeysAny [Text] + | AHasKeysAll [Text] + + | ANISNULL -- IS NULL + | ANISNOTNULL -- IS NOT NULL + + | CEQ !PGCol + | CNE !PGCol + | CGT !PGCol + | CLT !PGCol + | CGTE !PGCol + | CLTE !PGCol + deriving (Eq, Show, Functor, Foldable, Traversable) + + +opExpToJPair :: (a -> Value) -> OpExpG a -> (Text, Value) +opExpToJPair f = \case + AEQ a -> ("_eq", f a) + ANE a -> ("_ne", f a) + + AIN a -> ("_in", toJSON $ map f a) + ANIN a -> ("_nin", toJSON $ map f a) + + AGT a -> ("_gt", f a) + ALT a -> ("_lt", f a) + AGTE a -> ("_gte", f a) + ALTE a -> ("_lte", f a) + + ALIKE a -> ("_like", f a) + ANLIKE a -> ("_nlike", f a) + + AILIKE a -> ("_ilike", f a) + ANILIKE a -> ("_nilike", f a) + + ASIMILAR a -> ("_similar", f a) + ANSIMILAR a -> ("_nsimilar", f a) + + AContains a -> ("_contains", f a) + AContainedIn a -> ("_contained_in", f a) + AHasKey a -> ("_has_key", f a) + AHasKeysAny a -> ("_has_keys_any", toJSON a) + AHasKeysAll a -> ("_has_keys_all", toJSON a) + + ANISNULL -> ("_is_null", toJSON True) + ANISNOTNULL -> ("_is_null", toJSON False) + + CEQ a -> ("_ceq", toJSON a) + CNE a -> ("_cne", toJSON a) + CGT a -> ("_cgt", toJSON a) + CLT a -> ("_clt", toJSON a) + CGTE a -> ("_cgte", toJSON a) + CLTE a -> ("_clte", toJSON a) + +data AnnBoolExpFld a + = AVCol !PGColInfo ![OpExpG a] + | AVRel !RelInfo !(AnnBoolExp a) + deriving (Show, Eq, Functor, Foldable, Traversable) + +type AnnBoolExp a + = GBoolExp (AnnBoolExpFld a) + +annBoolExpTrue :: AnnBoolExp a +annBoolExpTrue = gBoolExpTrue + +andAnnBoolExps :: AnnBoolExp a -> AnnBoolExp a -> AnnBoolExp a +andAnnBoolExps l r = + BoolAnd [l, r] + +type AnnBoolExpFldSQL = AnnBoolExpFld S.SQLExp +type AnnBoolExpSQL = AnnBoolExp S.SQLExp + +instance ToJSON AnnBoolExpSQL where + toJSON = gBoolExpToJSON f + where + f annFld = case annFld of + AVCol pci opExps -> + ( getPGColTxt $ pgiName pci + , toJSON (pci, map opExpSToJSON opExps) + ) + AVRel ri relBoolExp -> + ( getRelTxt $ riName ri + , toJSON (ri, toJSON relBoolExp) + ) + opExpSToJSON :: OpExpG S.SQLExp -> Value + opExpSToJSON = + object . pure . opExpToJPair (toJSON . toSQLTxt) diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index c8f9e421044c4..3743adc29ea88 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -1,25 +1,22 @@ {-# LANGUAGE DeriveLift #-} -{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Hasura.RQL.Types.Common - ( RelName(..) + ( PGColInfo(..) + , RelName(..) , RelType(..) , relTypeToTxt + , RelInfo(..) , FieldName(..) , fromPGCol , fromRel - , ColExp(..) - , GBoolExp(..) - , BoolExp - , foldBoolExp - , TQueryName(..) , TemplateParam(..) @@ -28,18 +25,26 @@ module Hasura.RQL.Types.Common ) where import Hasura.Prelude -import qualified Hasura.SQL.DML as S import Hasura.SQL.Types import Data.Aeson -import Data.Aeson.Internal -import qualified Data.HashMap.Strict as M +import Data.Aeson.TH +import Data.Aeson.Casing import qualified Data.Text as T import qualified Database.PG.Query as Q import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift) import qualified PostgreSQL.Binary.Decoding as PD +data PGColInfo + = PGColInfo + { pgiName :: !PGCol + , pgiType :: !PGColType + , pgiIsNullable :: !Bool + } deriving (Show, Eq) + +$(deriveToJSON (aesonDrop 3 snakeCase) ''PGColInfo) + newtype RelName = RelName {getRelTxt :: T.Text} deriving (Show, Eq, Hashable, FromJSON, ToJSON, Q.ToPrepArg, Q.FromCol, Lift) @@ -73,6 +78,17 @@ instance Q.FromCol RelType where "array" -> Just ArrRel _ -> Nothing +data RelInfo + = RelInfo + { riName :: !RelName + , riType :: !RelType + , riMapping :: ![(PGCol, PGCol)] + , riRTable :: !QualifiedTable + , riIsManual :: !Bool + } deriving (Show, Eq) + +$(deriveToJSON (aesonDrop 2 snakeCase) ''RelInfo) + newtype FieldName = FieldName { getFieldNameTxt :: T.Text } deriving (Show, Eq, Hashable, FromJSON, ToJSON, FromJSONKey, ToJSONKey, Lift) @@ -89,67 +105,6 @@ fromPGCol (PGCol c) = FieldName c fromRel :: RelName -> FieldName fromRel (RelName r) = FieldName r -type BoolExp = GBoolExp ColExp - -data ColExp - = ColExp - { ceCol :: !FieldName - , ceVal :: !Value - } deriving (Show, Eq, Lift) - -data GBoolExp a - = BoolAnd ![GBoolExp a] - | BoolOr ![GBoolExp a] - | BoolCol !a - | BoolNot !(GBoolExp a) - deriving (Show, Eq, Lift, Functor, Foldable, Traversable) - -instance ToJSON (GBoolExp ColExp) where - toJSON (BoolAnd bExps) = - object $ flip map bExps $ \bExp -> case bExp of - BoolOr cbExps -> "$or" .= cbExps - BoolAnd cbExps -> "$and" .= cbExps - BoolCol (ColExp k v) -> getFieldNameTxt k .= v - BoolNot notExp -> "$not" .= notExp - toJSON (BoolOr bExps) = - object $ flip map bExps $ \bExp -> case bExp of - BoolOr cbExps -> "$or" .= cbExps - BoolAnd cbExps -> "$and" .= cbExps - BoolCol (ColExp k v) -> getFieldNameTxt k .= v - BoolNot notExp -> "$not" .= notExp - toJSON (BoolCol (ColExp k v)) = - object [ getFieldNameTxt k .= v ] - toJSON (BoolNot notExp) = - object [ "$not" .= notExp ] - -instance FromJSON (GBoolExp ColExp) where - parseJSON (Object o) = do - boolExps <- forM (M.toList o) $ \(k, v) -> if - | k == "$or" -> BoolOr <$> parseJSON v Key k - | k == "_or" -> BoolOr <$> parseJSON v Key k - | k == "$and" -> BoolAnd <$> parseJSON v Key k - | k == "_and" -> BoolAnd <$> parseJSON v Key k - | k == "$not" -> BoolNot <$> parseJSON v Key k - | k == "_not" -> BoolNot <$> parseJSON v Key k - | otherwise -> fmap (BoolCol . ColExp (FieldName k)) $ parseJSON v - return $ BoolAnd boolExps - parseJSON _ = fail "expecting an Object for boolean exp" - -foldBoolExp :: (Monad m) - => (a -> m S.BoolExp) - -> GBoolExp a - -> m S.BoolExp -foldBoolExp f (BoolAnd bes) = do - sqlBExps <- mapM (foldBoolExp f) bes - return $ foldr (S.BEBin S.AndOp) (S.BELit True) sqlBExps -foldBoolExp f (BoolOr bes) = do - sqlBExps <- mapM (foldBoolExp f) bes - return $ foldr (S.BEBin S.OrOp) (S.BELit False) sqlBExps -foldBoolExp f (BoolNot notExp) = - S.BENot <$> foldBoolExp f notExp -foldBoolExp f (BoolCol ce) = - f ce - newtype TQueryName = TQueryName { getTQueryName :: T.Text } deriving ( Show, Eq, Hashable, FromJSONKey, ToJSONKey diff --git a/server/src-lib/Hasura/RQL/Types/DML.hs b/server/src-lib/Hasura/RQL/Types/DML.hs index 99ee19ff0f711..97ab63c3165ff 100644 --- a/server/src-lib/Hasura/RQL/Types/DML.hs +++ b/server/src-lib/Hasura/RQL/Types/DML.hs @@ -10,7 +10,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Hasura.RQL.Types.DML - ( DMLQuery(..) + ( BoolExp(..) + , ColExp(..) + , DMLQuery(..) , OrderByExp(..) , OrderByItemG(..) @@ -49,6 +51,7 @@ import qualified Hasura.SQL.DML as S import Hasura.Prelude import Hasura.RQL.Types.Common +import Hasura.RQL.Types.BoolExp import Hasura.SQL.Types import Data.Aeson @@ -63,6 +66,28 @@ import Hasura.RQL.Instances () import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift) +data ColExp + = ColExp + { ceCol :: !FieldName + , ceVal :: !Value + } deriving (Show, Eq, Lift) + +newtype BoolExp + = BoolExp { unBoolExp :: GBoolExp ColExp } deriving (Show, Eq, Lift) + +instance ToJSON BoolExp where + toJSON (BoolExp gBoolExp) = + gBoolExpToJSON f gBoolExp + where + f (ColExp k v) = + (getFieldNameTxt k, v) + +instance FromJSON BoolExp where + parseJSON = + fmap BoolExp . parseGBoolExp f + where + f (k, v) = ColExp (FieldName k) <$> parseJSON v + data DMLQuery a = DMLQuery !QualifiedTable a deriving (Show, Eq, Lift) diff --git a/server/src-lib/Hasura/RQL/Types/Permission.hs b/server/src-lib/Hasura/RQL/Types/Permission.hs index c7b0ddc7c279a..4aea4bc34330b 100644 --- a/server/src-lib/Hasura/RQL/Types/Permission.hs +++ b/server/src-lib/Hasura/RQL/Types/Permission.hs @@ -35,7 +35,6 @@ import qualified Database.PG.Query as Q import Data.Aeson import Data.Hashable -import Data.Word import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift) diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index 4ba218bd61a42..309fe72d01e96 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -1,11 +1,12 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} module Hasura.RQL.Types.SchemaCache ( TableCache @@ -27,6 +28,8 @@ module Hasura.RQL.Types.SchemaCache , modTableInCache , delTableFromCache + , WithDeps + , CacheRM(..) , CacheRWM(..) @@ -42,8 +45,12 @@ module Hasura.RQL.Types.SchemaCache , isPGColInfo , getColInfos , RelInfo(..) - , addFldToCache - , delFldFromCache + -- , addFldToCache + , addColToCache + , addRelToCache + + , delColFromCache + , delRelFromCache , RolePermInfo(..) , permIns @@ -55,6 +62,7 @@ module Hasura.RQL.Types.SchemaCache , permAccToType , withPermType , RolePermInfoMap + , InsPermInfo(..) , SelPermInfo(..) , UpdPermInfo(..) @@ -70,10 +78,8 @@ module Hasura.RQL.Types.SchemaCache , addEventTriggerToCache , delEventTriggerFromCache - , getOpInfo , EventTriggerInfo(..) , EventTriggerInfoMap - , OpTriggerInfo(..) , TableObjId(..) , SchemaObjId(..) @@ -84,17 +90,12 @@ module Hasura.RQL.Types.SchemaCache , mkColDep , getDependentObjs , getDependentObjsWith - , getDependentObjsOfTable - , getDependentObjsOfQTemplateCache - , getDependentPermsOfTable - , getDependentRelsOfTable - , getDependentTriggersOfTable - , isDependentOn ) where import qualified Database.PG.Query as Q import Hasura.Prelude import Hasura.RQL.Types.Common +import Hasura.RQL.Types.BoolExp import Hasura.RQL.Types.DML import Hasura.RQL.Types.Error import Hasura.RQL.Types.Permission @@ -104,6 +105,7 @@ import Hasura.SQL.Types import Control.Lens import Data.Aeson +import Data.Aeson.Types import Data.Aeson.Casing import Data.Aeson.TH import GHC.Generics (Generic) @@ -156,14 +158,19 @@ instance Show SchemaObjId where instance ToJSON SchemaObjId where toJSON = String . reportSchemaObj +instance ToJSONKey SchemaObjId where + toJSONKey = toJSONKeyText reportSchemaObj + data SchemaDependency = SchemaDependency { sdObjId :: !SchemaObjId , sdReason :: !T.Text - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) $(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaDependency) +instance Hashable SchemaDependency + mkParentDep :: QualifiedTable -> SchemaDependency mkParentDep tn = SchemaDependency (SOTable tn) "table" @@ -171,40 +178,16 @@ mkColDep :: T.Text -> QualifiedTable -> PGCol -> SchemaDependency mkColDep reason tn col = flip SchemaDependency reason . SOTableObj tn $ TOCol col -class CachedSchemaObj a where - dependsOn :: a -> [SchemaDependency] - -isDependentOn :: (CachedSchemaObj a) => (T.Text -> Bool) -> SchemaObjId -> a -> Bool -isDependentOn reasonFn objId = any compareFn . dependsOn - where - compareFn (SchemaDependency depObjId rsn) = induces objId depObjId && reasonFn rsn - induces (SOTable tn1) (SOTable tn2) = tn1 == tn2 - induces (SOTable tn1) (SOTableObj tn2 _) = tn1 == tn2 - induces objId1 objId2 = objId1 == objId2 - data QueryTemplateInfo = QueryTemplateInfo { qtiName :: !TQueryName , qtiQuery :: !QueryT - , qtiDeps :: ![SchemaDependency] } deriving (Show, Eq) $(deriveToJSON (aesonDrop 3 snakeCase) ''QueryTemplateInfo) -instance CachedSchemaObj QueryTemplateInfo where - dependsOn = qtiDeps - type QTemplateCache = M.HashMap TQueryName QueryTemplateInfo -data PGColInfo - = PGColInfo - { pgiName :: !PGCol - , pgiType :: !PGColType - , pgiIsNullable :: !Bool - } deriving (Show, Eq) - -$(deriveToJSON (aesonDrop 3 snakeCase) ''PGColInfo) - onlyIntCols :: [PGColInfo] -> [PGColInfo] onlyIntCols = filter (isIntegerType . pgiType) @@ -221,20 +204,7 @@ getColInfos :: [PGCol] -> [PGColInfo] -> [PGColInfo] getColInfos cols allColInfos = flip filter allColInfos $ \ci -> pgiName ci `elem` cols -data RelInfo - = RelInfo - { riName :: !RelName - , riType :: !RelType - , riMapping :: ![(PGCol, PGCol)] - , riRTable :: !QualifiedTable - , riDeps :: ![SchemaDependency] - , riIsManual :: !Bool - } deriving (Show, Eq) - -$(deriveToJSON (aesonDrop 2 snakeCase) ''RelInfo) - -instance CachedSchemaObj RelInfo where - dependsOn = riDeps +type WithDeps a = (a, [SchemaDependency]) data FieldInfo = FIColumn !PGColInfo @@ -273,9 +243,6 @@ isPGColInfo :: FieldInfo -> Bool isPGColInfo (FIColumn _) = True isPGColInfo _ = False -instance ToJSON S.BoolExp where - toJSON = String . T.pack . show - instance ToJSON S.SQLExp where toJSON = String . T.pack . show @@ -284,61 +251,45 @@ type InsSetCols = M.HashMap PGCol S.SQLExp data InsPermInfo = InsPermInfo { ipiView :: !QualifiedTable - , ipiCheck :: !S.BoolExp + , ipiCheck :: !AnnBoolExpSQL , ipiAllowUpsert :: !Bool , ipiSet :: !InsSetCols - , ipiDeps :: ![SchemaDependency] , ipiRequiredHeaders :: ![T.Text] } deriving (Show, Eq) $(deriveToJSON (aesonDrop 3 snakeCase) ''InsPermInfo) -instance CachedSchemaObj InsPermInfo where - dependsOn = ipiDeps - data SelPermInfo = SelPermInfo { spiCols :: !(HS.HashSet PGCol) , spiTable :: !QualifiedTable - , spiFilter :: !S.BoolExp + , spiFilter :: !AnnBoolExpSQL , spiLimit :: !(Maybe Int) , spiAllowAgg :: !Bool - , spiDeps :: ![SchemaDependency] , spiRequiredHeaders :: ![T.Text] } deriving (Show, Eq) $(deriveToJSON (aesonDrop 3 snakeCase) ''SelPermInfo) -instance CachedSchemaObj SelPermInfo where - dependsOn = spiDeps - data UpdPermInfo = UpdPermInfo { upiCols :: !(HS.HashSet PGCol) , upiTable :: !QualifiedTable - , upiFilter :: !S.BoolExp - , upiDeps :: ![SchemaDependency] + , upiFilter :: !AnnBoolExpSQL , upiRequiredHeaders :: ![T.Text] } deriving (Show, Eq) $(deriveToJSON (aesonDrop 3 snakeCase) ''UpdPermInfo) -instance CachedSchemaObj UpdPermInfo where - dependsOn = upiDeps - data DelPermInfo = DelPermInfo { dpiTable :: !QualifiedTable - , dpiFilter :: !S.BoolExp - , dpiDeps :: ![SchemaDependency] + , dpiFilter :: !AnnBoolExpSQL , dpiRequiredHeaders :: ![T.Text] } deriving (Show, Eq) $(deriveToJSON (aesonDrop 3 snakeCase) ''DelPermInfo) -instance CachedSchemaObj DelPermInfo where - dependsOn = dpiDeps - mkRolePermInfo :: RolePermInfo mkRolePermInfo = RolePermInfo Nothing Nothing Nothing Nothing @@ -355,25 +306,11 @@ makeLenses ''RolePermInfo type RolePermInfoMap = M.HashMap RoleName RolePermInfo -data OpTriggerInfo - = OpTriggerInfo - { otiTable :: !QualifiedTable - , otiTriggerName :: !TriggerName - , otiCols :: !SubscribeOpSpec - , otiDeps :: ![SchemaDependency] - } deriving (Show, Eq) -$(deriveToJSON (aesonDrop 3 snakeCase) ''OpTriggerInfo) - -instance CachedSchemaObj OpTriggerInfo where - dependsOn = otiDeps - data EventTriggerInfo = EventTriggerInfo { etiId :: !TriggerId , etiName :: !TriggerName - , etiInsert :: !(Maybe OpTriggerInfo) - , etiUpdate :: !(Maybe OpTriggerInfo) - , etiDelete :: !(Maybe OpTriggerInfo) + , etiOpsDef :: !TriggerOpsDef , etiRetryConf :: !RetryConf , etiWebhookInfo :: !WebhookConfInfo , etiHeaders :: ![EventHeaderInfo] @@ -383,12 +320,6 @@ $(deriveToJSON (aesonDrop 3 snakeCase) ''EventTriggerInfo) type EventTriggerInfoMap = M.HashMap TriggerName EventTriggerInfo -getTriggers :: EventTriggerInfoMap -> [OpTriggerInfo] -getTriggers etim = toOpTriggerInfo $ M.elems etim - where - toOpTriggerInfo etis = catMaybes $ foldl (\acc eti -> acc ++ [etiInsert eti, etiUpdate eti, etiDelete eti]) [] etis - - data ConstraintType = CTCHECK | CTFOREIGNKEY @@ -477,14 +408,37 @@ mkTableInfo tn isSystemDefined rawCons cols pcols mVI = type TableCache = M.HashMap QualifiedTable TableInfo -- info of all tables +type DepMap = M.HashMap SchemaObjId (HS.HashSet SchemaDependency) + +addToDepMap :: SchemaObjId -> [SchemaDependency] -> DepMap -> DepMap +addToDepMap schObj deps = + M.insert schObj (HS.fromList deps) + + -- M.unionWith HS.union objDepMap + -- where + -- objDepMap = M.fromList + -- [ (dep, HS.singleton $ SchemaDependency schObj reason) + -- | (SchemaDependency dep reason) <- deps + -- ] + +removeFromDepMap :: SchemaObjId -> DepMap -> DepMap +removeFromDepMap = + M.delete + data SchemaCache = SchemaCache { scTables :: !TableCache , scQTemplates :: !QTemplateCache + , scDepMap :: !DepMap } deriving (Show, Eq) $(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaCache) +modDepMapInCache :: (CacheRWM m) => (DepMap -> DepMap) -> m () +modDepMapInCache f = do + sc <- askSchemaCache + writeSchemaCache $ sc { scDepMap = f (scDepMap sc)} + class (Monad m) => CacheRM m where -- Get the schema cache @@ -501,9 +455,12 @@ class (CacheRM m) => CacheRWM m where instance (Monad m) => CacheRWM (StateT SchemaCache m) where writeSchemaCache = put -addQTemplateToCache :: (QErrM m, CacheRWM m) - => QueryTemplateInfo -> m () -addQTemplateToCache qti = do +addQTemplateToCache + :: (QErrM m, CacheRWM m) + => QueryTemplateInfo + -> [SchemaDependency] + -> m () +addQTemplateToCache qti deps = do sc <- askSchemaCache let templateCache = scQTemplates sc case M.lookup qtn templateCache of @@ -511,8 +468,10 @@ addQTemplateToCache qti = do Nothing -> do let newTemplateCache = M.insert qtn qti templateCache writeSchemaCache $ sc {scQTemplates = newTemplateCache} + modDepMapInCache (addToDepMap objId deps) where qtn = qtiName qti + objId = SOQTemplate qtn delQTemplateFromCache :: (QErrM m, CacheRWM m) => TQueryName -> m () @@ -524,12 +483,12 @@ delQTemplateFromCache qtn = do Just _ -> do let newTemplateCache = M.delete qtn templateCache writeSchemaCache $ sc {scQTemplates = newTemplateCache} - --- instance CacheRM where --- askSchemaCache = get + modDepMapInCache (removeFromDepMap objId) + where + objId = SOQTemplate qtn emptySchemaCache :: SchemaCache -emptySchemaCache = SchemaCache (M.fromList []) (M.fromList []) +emptySchemaCache = SchemaCache (M.fromList []) (M.fromList []) mempty modTableCache :: (CacheRWM m) => TableCache -> m () modTableCache tc = do @@ -551,6 +510,10 @@ delTableFromCache tn = do sc <- askSchemaCache void $ getTableInfoFromCache tn sc modTableCache $ M.delete tn $ scTables sc + modDepMapInCache (M.filterWithKey notThisTableObj) + where + notThisTableObj (SOTableObj depTn _) _ = depTn /= tn + notThisTableObj _ _ = True getTableInfoFromCache :: (QErrM m) => QualifiedTable @@ -580,9 +543,27 @@ modTableInCache f tn = do newTi <- f ti modTableCache $ M.insert tn newTi $ scTables sc -addFldToCache :: (QErrM m, CacheRWM m) - => FieldName -> FieldInfo - -> QualifiedTable -> m () +addColToCache + :: (QErrM m, CacheRWM m) + => PGCol -> PGColInfo + -> QualifiedTable -> m () +addColToCache cn ci = + addFldToCache (fromPGCol cn) (FIColumn ci) + +addRelToCache + :: (QErrM m, CacheRWM m) + => RelName -> RelInfo -> [SchemaDependency] + -> QualifiedTable -> m () +addRelToCache rn ri deps tn = do + addFldToCache (fromRel rn) (FIRelationship ri) tn + modDepMapInCache (addToDepMap schObjId deps) + where + schObjId = SOTableObj tn $ TORel $ riName ri + +addFldToCache + :: (QErrM m, CacheRWM m) + => FieldName -> FieldInfo + -> QualifiedTable -> m () addFldToCache fn fi = modTableInCache modFieldInfoMap where @@ -605,6 +586,19 @@ delFldFromCache fn = ti { tiFieldInfoMap = M.delete fn fim } Nothing -> throw500 "field does not exist" +delColFromCache :: (QErrM m, CacheRWM m) + => PGCol -> QualifiedTable -> m () +delColFromCache cn = + delFldFromCache (fromPGCol cn) + +delRelFromCache :: (QErrM m, CacheRWM m) + => RelName -> QualifiedTable -> m () +delRelFromCache rn tn = do + delFldFromCache (fromRel rn) tn + modDepMapInCache (removeFromDepMap schObjId) + where + schObjId = SOTableObj tn $ TORel rn + data PermAccessor a where PAInsert :: PermAccessor InsPermInfo PASelect :: PermAccessor SelPermInfo @@ -632,41 +626,32 @@ withPermType PTDelete f = f PADelete addEventTriggerToCache :: (QErrM m, CacheRWM m) => QualifiedTable - -> TriggerId - -> TriggerName - -> TriggerOpsDef - -> RetryConf - -> WebhookConfInfo - -> [EventHeaderInfo] + -> EventTriggerInfo + -> [SchemaDependency] -> m () -addEventTriggerToCache qt trid trn tdef rconf webhookInfo headers = +addEventTriggerToCache qt eti deps = do modTableInCache modEventTriggerInfo qt + modDepMapInCache (addToDepMap schObjId deps) where + trn = etiName eti modEventTriggerInfo ti = do - let eti = EventTriggerInfo - trid - trn - (getOpInfo trn ti $ tdInsert tdef) - (getOpInfo trn ti $ tdUpdate tdef) - (getOpInfo trn ti $ tdDelete tdef) - rconf - webhookInfo - headers - etim = tiEventTriggerInfoMap ti - -- fail $ show (toJSON eti) + let etim = tiEventTriggerInfoMap ti return $ ti { tiEventTriggerInfoMap = M.insert trn eti etim} + schObjId = SOTableObj qt $ TOTrigger trn delEventTriggerFromCache :: (QErrM m, CacheRWM m) => QualifiedTable -> TriggerName -> m () -delEventTriggerFromCache qt trn = +delEventTriggerFromCache qt trn = do modTableInCache modEventTriggerInfo qt + modDepMapInCache (removeFromDepMap schObjId) where modEventTriggerInfo ti = do let etim = tiEventTriggerInfoMap ti return $ ti { tiEventTriggerInfoMap = M.delete trn etim } + schObjId = SOTableObj qt $ TOTrigger trn addPermToCache :: (QErrM m, CacheRWM m) @@ -674,17 +659,20 @@ addPermToCache -> RoleName -> PermAccessor a -> a + -> [SchemaDependency] -> m () -addPermToCache tn rn pa i = +addPermToCache tn rn pa i deps = do modTableInCache modRolePermInfo tn + modDepMapInCache (addToDepMap schObjId deps) where paL = permAccToLens pa modRolePermInfo ti = do let rpim = tiRolePermInfoMap ti rpi = fromMaybe mkRolePermInfo $ M.lookup rn rpim - newRPI = rpi & paL .~ Just i + newRPI = rpi & paL ?~ i assertPermNotExists pa rpi return $ ti { tiRolePermInfoMap = M.insert rn newRPI rpim } + schObjId = SOTableObj tn $ TOPerm rn $ permAccToType pa assertPermNotExists :: (QErrM m) @@ -706,8 +694,9 @@ delPermFromCache -> RoleName -> QualifiedTable -> m () -delPermFromCache pa rn = - modTableInCache modRolePermInfo +delPermFromCache pa rn tn = do + modTableInCache modRolePermInfo tn + modDepMapInCache (removeFromDepMap schObjId) where paL = permAccToLens pa modRolePermInfo ti = do @@ -716,6 +705,7 @@ delPermFromCache pa rn = assertPermExists pa rpi let newRPI = rpi & paL .~ Nothing return $ ti { tiRolePermInfoMap = M.insert rn newRPI rpim } + schObjId = SOTableObj tn $ TOPerm rn $ permAccToType pa data TemplateParamInfo = TemplateParamInfo @@ -726,96 +716,17 @@ data TemplateParamInfo getDependentObjs :: SchemaCache -> SchemaObjId -> [SchemaObjId] getDependentObjs = getDependentObjsWith (const True) -getDependentObjsWith :: (T.Text -> Bool) -> SchemaCache -> SchemaObjId -> [SchemaObjId] +getDependentObjsWith + :: (T.Text -> Bool) -> SchemaCache -> SchemaObjId -> [SchemaObjId] getDependentObjsWith f sc objId = - HS.toList $ getDependentObjsRWith f HS.empty sc objId - -getDependentObjsRWith :: (T.Text -> Bool) - -> HS.HashSet SchemaObjId - -> SchemaCache -> SchemaObjId - -> HS.HashSet SchemaObjId -getDependentObjsRWith f visited sc objId = - foldr go visited thisLevelDeps - where - thisLevelDeps = concatMap (getDependentObjsOfTableWith f objId) (scTables sc) - <> getDependentObjsOfQTemplateCache objId (scQTemplates sc) - go lObjId vis = - if HS.member lObjId vis - then vis - else getDependentObjsRWith f (HS.insert lObjId vis) sc lObjId - -getDependentObjsOfQTemplateCache :: SchemaObjId -> QTemplateCache -> [SchemaObjId] -getDependentObjsOfQTemplateCache objId qtc = - map (SOQTemplate . qtiName) $ filter (isDependentOn (const True) objId) $ - M.elems qtc - -getDependentObjsOfTable :: SchemaObjId -> TableInfo -> [SchemaObjId] -getDependentObjsOfTable objId ti = - rels ++ perms ++ triggers - where - rels = getDependentRelsOfTable (const True) objId ti - perms = getDependentPermsOfTable (const True) objId ti - triggers = getDependentTriggersOfTable (const True) objId ti - - -getDependentObjsOfTableWith :: (T.Text -> Bool) -> SchemaObjId -> TableInfo -> [SchemaObjId] -getDependentObjsOfTableWith f objId ti = - rels ++ perms ++ triggers + -- [ sdObjId sd | sd <- filter (f . sdReason) allDeps] + map fst $ filter (isDependency . snd) $ M.toList $ scDepMap sc where - rels = getDependentRelsOfTable f objId ti - perms = getDependentPermsOfTable f objId ti - triggers = getDependentTriggersOfTable f objId ti - -getDependentRelsOfTable :: (T.Text -> Bool) -> SchemaObjId - -> TableInfo -> [SchemaObjId] -getDependentRelsOfTable rsnFn objId (TableInfo tn _ fim _ _ _ _ _) = - map (SOTableObj tn . TORel . riName) $ - filter (isDependentOn rsnFn objId) $ getRels fim - -getDependentPermsOfTable :: (T.Text -> Bool) -> SchemaObjId - -> TableInfo -> [SchemaObjId] -getDependentPermsOfTable rsnFn objId (TableInfo tn _ _ rpim _ _ _ _) = - concat $ flip M.mapWithKey rpim $ - \rn rpi -> map (SOTableObj tn . TOPerm rn) $ getDependentPerms' rsnFn objId rpi - -getDependentPerms' :: (T.Text -> Bool) -> SchemaObjId -> RolePermInfo -> [PermType] -getDependentPerms' rsnFn objId (RolePermInfo mipi mspi mupi mdpi) = - mapMaybe join - [ forM mipi $ toPermRow PTInsert - , forM mspi $ toPermRow PTSelect - , forM mupi $ toPermRow PTUpdate - , forM mdpi $ toPermRow PTDelete - ] - where - toPermRow :: forall a. (CachedSchemaObj a) => PermType -> a -> Maybe PermType - toPermRow pt = - bool Nothing (Just pt) . isDependentOn rsnFn objId - -getDependentTriggersOfTable :: (T.Text -> Bool) -> SchemaObjId - -> TableInfo -> [SchemaObjId] -getDependentTriggersOfTable rsnFn objId (TableInfo tn _ _ _ _ _ _ et) = - map (SOTableObj tn . TOTrigger . otiTriggerName ) $ filter (isDependentOn rsnFn objId) $ getTriggers et + isDependency deps = not $ HS.null $ flip HS.filter deps $ + \(SchemaDependency depId reason) -> objId `induces` depId && f reason -getOpInfo :: TriggerName -> TableInfo -> Maybe SubscribeOpSpec -> Maybe OpTriggerInfo -getOpInfo trn ti mos= fromSubscrOpSpec <$> mos - where - fromSubscrOpSpec :: SubscribeOpSpec -> OpTriggerInfo - fromSubscrOpSpec os = - let qt = tiName ti - tableDep = SchemaDependency (SOTable qt) ("event trigger " <> trn <> " is dependent on table") - cols = getColsFromSub $ sosColumns os - colDeps = map (\col -> - SchemaDependency (SOTableObj qt (TOCol col)) - ("event trigger " <> trn <> " is dependent on column " <> getPGColTxt col)) - (toList cols) - payload = maybe HS.empty getColsFromSub (sosPayload os) - payloadDeps = map (\col -> - SchemaDependency (SOTableObj qt (TOCol col)) - ("event trigger " <> trn <> " is dependent on column " <> getPGColTxt col)) - (toList payload) - schemaDeps = tableDep : colDeps ++ payloadDeps - in OpTriggerInfo qt trn os schemaDeps - where - getColsFromSub sc = case sc of - SubCStar -> HS.fromList [] - SubCArray pgcols -> HS.fromList pgcols + -- induces a b : is b dependent on a + induces (SOTable tn1) (SOTable tn2) = tn1 == tn2 + induces (SOTable tn1) (SOTableObj tn2 _) = tn1 == tn2 + induces objId1 objId2 = objId1 == objId2 + -- allDeps = toList $ fromMaybe HS.empty $ M.lookup objId $ scDepMap sc diff --git a/server/src-lib/Hasura/SQL/DML.hs b/server/src-lib/Hasura/SQL/DML.hs index 3a6cda4fdce4b..5d6612a9cf2c7 100644 --- a/server/src-lib/Hasura/SQL/DML.hs +++ b/server/src-lib/Hasura/SQL/DML.hs @@ -483,12 +483,12 @@ simplifyBoolExp be = case be of | otherwise -> BEBin OrOp e1s e2s e -> e -mkExists :: QualifiedTable -> BoolExp -> BoolExp -mkExists qt whereFrag = - BEExists mkSelect { - selExtr = [Extractor (SEUnsafe "1") Nothing], - selFrom = Just $ mkSimpleFromExp qt, - selWhere = Just $ WhereFrag whereFrag +mkExists :: FromItem -> BoolExp -> BoolExp +mkExists fromItem whereFrag = + BEExists mkSelect + { selExtr = [Extractor (SEUnsafe "1") Nothing] + , selFrom = Just $ FromExp $ pure fromItem + , selWhere = Just $ WhereFrag whereFrag } instance ToSQL BoolExp where diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index a7f466fbfbe27..ba4f10e378b00 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -31,8 +31,7 @@ import Hasura.Prelude import Hasura.RQL.Types import Hasura.Server.Auth.JWT.Internal (parseHmacKey, parseRsaKey) import Hasura.Server.Auth.JWT.Logging -import Hasura.Server.Utils (accessKeyHeader, bsToTxt, - userRoleHeader) +import Hasura.Server.Utils (bsToTxt, userRoleHeader) import qualified Control.Concurrent as C import qualified Data.Aeson as A @@ -66,10 +65,11 @@ data JWTCtx { jcxKey :: !(IORef JWKSet) , jcxClaimNs :: !(Maybe T.Text) , jcxAudience :: !(Maybe T.Text) - } deriving (Show, Eq) + } deriving (Eq) -instance Show (IORef JWKSet) where - show _ = "" +instance Show JWTCtx where + show (JWTCtx _ nsM audM) = + show ["", show nsM, show audM] data HasuraClaims = HasuraClaims diff --git a/server/tests-py/queries/graphql_query/boolexp/basic/self_referential_relationships.yaml b/server/tests-py/queries/graphql_query/boolexp/basic/self_referential_relationships.yaml new file mode 100644 index 0000000000000..9d68a92293dea --- /dev/null +++ b/server/tests-py/queries/graphql_query/boolexp/basic/self_referential_relationships.yaml @@ -0,0 +1,35 @@ +description: Self referential relationships +url: /v1alpha1/graphql +status: 200 +response: + data: + m1: + - id: 1 + - id: 4 + - id: 6 + level1: + - id: 2 + - id: 3 + - id: 5 + - id: 6 +query: + query: | + query { + m1: message ( + where : { + _or: [ + {content: {_ilike: "%hello%"}} + {children: {content: {_ilike: "%hello%"}}} + ] + } + ) { + id + } + level1: message ( + where : { + parent: {parent_id: {_is_null: true}} + } + ) { + id + } + } diff --git a/server/tests-py/queries/graphql_query/boolexp/basic/setup.yaml b/server/tests-py/queries/graphql_query/boolexp/basic/setup.yaml index d8d452cf8fa9c..6ab57be4a3dfd 100644 --- a/server/tests-py/queries/graphql_query/boolexp/basic/setup.yaml +++ b/server/tests-py/queries/graphql_query/boolexp/basic/setup.yaml @@ -6,7 +6,7 @@ args: args: sql: | create table author( - id serial primary key, + id serial primary key, name text unique, is_registered boolean not null default false ); @@ -86,6 +86,66 @@ args: column: author_id +#Message table +- type: run_sql + args: + sql: | + CREATE TABLE message ( + id int PRIMARY KEY, + content TEXT NOT NULL, + parent_id INT NULL + ); + alter table message + add constraint parent_fk foreign key (parent_id) + references message(id) + +- type: track_table + args: + schema: public + name: message + +# parent obj rel +- type: create_object_relationship + args: + table: message + name: parent + using: + foreign_key_constraint_on: parent_id + +# children array rel +- type: create_array_relationship + args: + table: message + name: children + using: + foreign_key_constraint_on: + table: message + column: parent_id + +#Insert messages +- type: insert + args: + table: message + objects: + - id: 1 + content: "hello world" + parent_id: null + - id: 2 + content: "content 2" + parent_id: 1 + - id: 3 + content: "content 3" + parent_id: 1 + - id: 4 + content: "ahoy" + parent_id: null + - id: 5 + content: "content 5" + parent_id: 4 + - id: 6 + content: "hello there" + parent_id: 4 + #Insert Authors - type: insert args: @@ -134,12 +194,12 @@ args: table: city objects: - name: Durham - country: USA + country: USA - name: New York country: USA - name: Framlingham country: UK - - name: New Orleans + - name: New Orleans country: USA - type: insert diff --git a/server/tests-py/queries/graphql_query/boolexp/basic/teardown.yaml b/server/tests-py/queries/graphql_query/boolexp/basic/teardown.yaml index 44eed5b73d22a..9d3a2e2b6b441 100644 --- a/server/tests-py/queries/graphql_query/boolexp/basic/teardown.yaml +++ b/server/tests-py/queries/graphql_query/boolexp/basic/teardown.yaml @@ -7,7 +7,7 @@ args: table: schema: public name: author - + - type: run_sql args: sql: | @@ -27,3 +27,8 @@ args: args: sql: | drop table orders + +- type: run_sql + args: + sql: | + drop table message diff --git a/server/tests-py/test_graphql_queries.py b/server/tests-py/test_graphql_queries.py index 0f1ad537fc406..edf323d6fce86 100644 --- a/server/tests-py/test_graphql_queries.py +++ b/server/tests-py/test_graphql_queries.py @@ -166,6 +166,9 @@ def test_article_author_not_published_nor_registered(self, hge_ctx): def test_article_author_unexpected_operator_in_where_err(self, hge_ctx): check_query_f(hge_ctx, self.dir() + '/select_author_article_unexpected_operator_in_where_err.yaml') + def test_self_referential_relationships(self, hge_ctx): + check_query_f(hge_ctx, self.dir() + '/self_referential_relationships.yaml') + @classmethod def dir(cls): return 'queries/graphql_query/boolexp/basic'