From 4336d0bc188ad0c9b61ce7f8b9ac792bee08d4b9 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Wed, 12 Sep 2018 17:37:35 +0530 Subject: [PATCH 01/12] implement nested mutations, close #343 --- server/graphql-engine.cabal | 1 + server/src-lib/Hasura/GraphQL/Resolve.hs | 5 +- .../src-lib/Hasura/GraphQL/Resolve/Context.hs | 14 +- .../Hasura/GraphQL/Resolve/InputValue.hs | 12 + .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 397 ++++++++++++++++++ .../Hasura/GraphQL/Resolve/Mutation.hs | 37 +- server/src-lib/Hasura/GraphQL/Schema.hs | 217 ++++++++-- .../src-lib/Hasura/GraphQL/Validate/Types.hs | 4 + server/src-lib/Hasura/RQL/DML/Select.hs | 4 +- server/src-lib/Hasura/RQL/Types/Error.hs | 13 +- server/test/Spec.hs | 4 + .../article_author_nested.yaml | 42 ++ .../article_author_nested_error.yaml | 44 ++ .../author_articles_nested.yaml | 32 ++ .../author_articles_nested_error.yaml | 33 ++ 15 files changed, 787 insertions(+), 72 deletions(-) create mode 100644 server/src-lib/Hasura/GraphQL/Resolve/Insert.hs create mode 100644 server/test/testcases/insert_mutation/article_author_nested.yaml create mode 100644 server/test/testcases/insert_mutation/article_author_nested_error.yaml create mode 100644 server/test/testcases/insert_mutation/author_articles_nested.yaml create mode 100644 server/test/testcases/insert_mutation/author_articles_nested_error.yaml diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index cea175434a2ba..1de8cfa16362a 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -189,6 +189,7 @@ library , Hasura.GraphQL.Resolve.Context , Hasura.GraphQL.Resolve.InputValue , Hasura.GraphQL.Resolve.Introspect + , Hasura.GraphQL.Resolve.Insert , Hasura.GraphQL.Resolve.Mutation , Hasura.GraphQL.Resolve.Select diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 342bbab8d7412..1a99e26573a90 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -23,6 +23,7 @@ import Hasura.GraphQL.Validate.Field import Hasura.RQL.Types import Hasura.SQL.Types +import qualified Hasura.GraphQL.Resolve.Insert as RI import qualified Hasura.GraphQL.Resolve.Mutation as RM import qualified Hasura.GraphQL.Resolve.Select as RS @@ -38,8 +39,8 @@ buildTx userInfo gCtx fld = do OCSelectPkey tn permFilter hdrs -> validateHdrs hdrs >> RS.convertSelectByPKey tn permFilter fld -- RS.convertSelect tn permFilter fld - OCInsert tn vn cols hdrs -> - validateHdrs hdrs >> RM.convertInsert roleName (tn, vn) cols fld + OCInsert insCtx pCols hdrs -> + validateHdrs hdrs >> RI.convertInsert roleName insCtx pCols fld -- RM.convertInsert (tn, vn) cols fld OCUpdate tn permFilter hdrs -> validateHdrs hdrs >> RM.convertUpdate tn permFilter fld diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs index 898968a06b94d..b39fbbd3f9fa4 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs @@ -3,9 +3,11 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Hasura.GraphQL.Resolve.Context - ( FieldMap + ( InsResp(..) + , FieldMap , OrdByResolveCtx , OrdByResolveCtxElem , NullsOrder(..) @@ -28,6 +30,9 @@ module Hasura.GraphQL.Resolve.Context import Data.Has import Hasura.Prelude +import qualified Data.Aeson as J +import qualified Data.Aeson.Casing as J +import qualified Data.Aeson.TH as J import qualified Data.ByteString.Lazy as BL import qualified Data.HashMap.Strict as Map import qualified Data.Sequence as Seq @@ -43,6 +48,13 @@ import Hasura.SQL.Value import qualified Hasura.SQL.DML as S +data InsResp + = InsResp + { _irAffectedRows :: !Int + , _irResponse :: !(Maybe J.Object) + } deriving (Show, Eq) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''InsResp) + type FieldMap = Map.HashMap (G.NamedType, G.Name) (Either PGColInfo (RelInfo, S.BoolExp, Maybe Int, Bool)) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs index f387306c1180a..ac6d47d2b803c 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs @@ -12,8 +12,10 @@ module Hasura.GraphQL.Resolve.InputValue , asPGColVal , asEnumVal , withObject + , asObject , withObjectM , withArray + , asArray , withArrayM , parseMany ) where @@ -79,6 +81,11 @@ withObject fn v = case v of <> G.showGT (G.TypeNamed nt) _ -> tyMismatch "object" v +asObject + :: (MonadError QErr m) + => AnnGValue -> m AnnGObject +asObject = withObject (\_ o -> return o) + withObjectM :: (MonadError QErr m) => (G.NamedType -> Maybe AnnGObject -> m a) -> AnnGValue -> m a @@ -102,6 +109,11 @@ withArray fn v = case v of <> G.showGT (G.TypeList lt) _ -> tyMismatch "array" v +asArray + :: (MonadError QErr m) + => AnnGValue -> m [AnnGValue] +asArray = withArray (\_ vals -> return vals) + parseMany :: (MonadError QErr m) => (AnnGValue -> m a) -> AnnGValue -> m (Maybe [a]) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs new file mode 100644 index 0000000000000..db79c21231024 --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -0,0 +1,397 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +module Hasura.GraphQL.Resolve.Insert + (convertInsert) +where + +import Data.Foldable (foldrM) +import Hasura.Prelude + +import qualified Data.Aeson as J +import qualified Data.Text as T +import qualified Data.ByteString.Builder as BB +import qualified Data.HashMap.Strict as Map +import qualified Data.Sequence as Seq +import qualified Data.Vector as V +import qualified Language.GraphQL.Draft.Syntax as G + +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.Mutation +import Hasura.GraphQL.Resolve.InputValue +import Hasura.GraphQL.Schema +import Hasura.GraphQL.Validate.Field +import Hasura.GraphQL.Validate.Types +import Hasura.RQL.Types +import Hasura.SQL.Types +import Hasura.SQL.Value + +data RelData a + = RelData + { _rdInsObj :: a + , _rdConflictClause :: !(Maybe AnnGValue) + } deriving (Show, Eq) + +type ObjRelData = RelData AnnGObject +type ArrRelData = RelData [AnnGObject] + +type PGColWithValue = (PGCol, PGColValue) +type PGColWithType = (PGCol, PGColType) + +parseRelObj + :: MonadError QErr m + => AnnGObject + -> m (Either ObjRelData ArrRelData) +parseRelObj annObj = do + let conflictClauseM = Map.lookup "on_conflict" annObj + dataVal <- onNothing (Map.lookup "data" annObj) $ throw500 "data object not found" + case dataVal of + AGObject _ (Just obj) -> return $ Left $ RelData obj conflictClauseM + AGArray _ (Just vals) -> do + objs <- forM vals asObject + return $ Right $ RelData objs conflictClauseM + _ -> throw500 "unexpected type for data " + +pgColToAnnGVal + :: (PGCol, PGColType, PGColValue) + -> (PGCol, AnnGValue) +pgColToAnnGVal (col, colTy, colVal) = (col, pgColValToAnnGVal colTy colVal) + +toSQLExps :: (MonadError QErr m, MonadState PrepArgs m) + => [(PGCol, AnnGValue)] -> m [(PGCol, S.SQLExp)] +toSQLExps cols = + forM cols $ \(c, v) -> do + prepExpM <- asPGColValM v >>= mapM prepare + let prepExp = fromMaybe (S.SEUnsafe "NULL") prepExpM + return (c, prepExp) + +-- | insert a single row with returning expected columns +insertRow + :: (QualifiedTable, QualifiedTable) -- (table, view) + -> Maybe AnnGValue -- ^ conflict clause + -> [(PGCol, AnnGValue)] -- ^ inserting row columns with graphQL value + -> [PGCol] -- ^ all table columns + -> [PGColWithType] -- ^ expected returning columns + -> RoleName -- ^ role + -> Q.TxE QErr (Int, Maybe [PGColWithValue]) -- ^ +insertRow (tn, vn) onConflictValM insCols tableCols expectedCols role = do + (givenCols, args) <- flip runStateT Seq.Empty $ toSQLExps insCols + onConflictM <- forM onConflictValM $ parseOnConflict (map fst insCols) + let sqlExps = Map.elems $ Map.union (Map.fromList givenCols) defVals + p1Query = RI.InsertQueryP1 tn vn tableCols [sqlExps] onConflictM mutFlds + p1 = (p1Query, args) + res <- bool (RI.nonAdminInsert p1) (RI.insertP2 p1) $ isAdmin role + InsResp affRows respObjM <- decodeFromBS res + retColValuesM <- mapM mkRetColValues respObjM + return (affRows, retColValuesM) + where + defVals = Map.fromList $ zip tableCols (repeat $ S.SEUnsafe "DEFAULT") + mutFlds = Map.fromList [ ("affected_rows", RR.MCount) + , ("response", RR.MRet selData) + ] + selData = RS.SelectData flds tn frmExpM (S.BELit True, Nothing) + Nothing [] Nothing Nothing True + frmExpM = Just $ S.FromExp $ pure $ + S.FIIden $ qualTableToAliasIden tn + flds = Map.fromList $ flip map expectedCols $ \(c, ty) -> + (fromPGCol c, RS.FCol (c, ty)) + + mkRetColValues obj = forM expectedCols $ \(col, colty) -> do + val <- onNothing (Map.lookup (getPGColTxt col) obj) $ + throw500 $ "column " <> col <<> "not found in postgres returning" + pgColValue <- RB.pgValParser colty val + return (col, pgColValue) + +-- | resolve a graphQL object to columns, object and array relations +fetchColsAndRels + :: MonadError QErr m + => AnnGObject + -> m ( [(PGCol, PGColType, PGColValue)] -- ^ columns + , [(RelName, ObjRelData)] -- ^ object relations + , [(RelName, ArrRelData)] -- ^ array relations + ) +fetchColsAndRels annObj = foldrM go ([], [], []) $ Map.toList annObj + where + go (gName, annVal) (cols, objRels, arrRels) = + case annVal of + AGScalar colty mColVal -> do + let col = PGCol $ G.unName gName + colVal = fromMaybe (PGNull colty) mColVal + return ((col, colty, colVal):cols, objRels, arrRels) + AGObject _ (Just obj) -> do + let relName = RelName $ G.unName gName + relObj <- parseRelObj obj + return $ either + (\relData -> (cols, (relName, relData):objRels, arrRels)) + (\relData -> (cols, objRels, (relName, relData):arrRels)) + relObj + _ -> throw500 "unexpected Array or Enum for input cols" + +parentColValidation + :: MonadError QErr m + => QualifiedTable -- ^ parent table + -> RelName -- ^ object relation name + -> [PGCol] -- ^ parent insert columns + -> [(PGCol, PGCol)] -- ^ child object relation column mapping + -> m () +parentColValidation tn rn parentCols colMapping = + unless (null conflictingCols) $ throwVE $ + "inserting columns: " <> T.pack (show $ map getPGColTxt conflictingCols) + <> " into table " <> tn <<> " not allowed due to inserting " + <> "object relationship " <>> rn + where + conflictingCols = + flip filter parentCols $ \col -> col `elem` map fst colMapping + +arrayRelObjValidation + :: MonadError QErr m + => RelName -- ^ array relation name + -> AnnGObject -- ^ array relation inserting object + -> [(PGCol, PGCol)] -- ^ relation column mapping + -> m () +arrayRelObjValidation rn insObj colMapping = do + (insCols, _, _) <- fetchColsAndRels insObj + let cols = map _1 insCols + conflictingCols = + flip filter cols $ \col -> col `elem` map snd colMapping + unless (null conflictingCols) $ throwVE $ + "inserting columns " <> T.pack (show $ map getPGColTxt conflictingCols) + <> " into relationship " <> rn <<> " not allowed" + +insertObjRel + :: QualifiedTable -- ^ parent table + -> [PGCol] -- ^ parent insert columns + -> RoleName + -> RelName + -> RelationInfoMap + -> ObjRelData + -> Q.TxE QErr (Int, [(PGCol, PGColValue)]) +insertObjRel parentTab parentCols role relName relInfoMap relData = do + relIns <- onNothing (Map.lookup relName relInfoMap) $ throw500 $ + "relations " <> relName <<> " not found" + case relIns of + RINotInsertable reason -> throw400 NotSupported $ + "cannot insert with relation " <> relName <<> " due to " <> reason + RIInsertable (insCtx, relInfo) -> do + let mapCols = riMapping relInfo + tn = riRTable relInfo + -- validate parent inserting columns + parentColValidation parentTab relName parentCols mapCols + + let rCols = map snd mapCols + cs = icColumns insCtx + insCols = map (\(PGColInfo cn ty _) -> (cn, ty)) $ + getColInfos rCols cs + res <- processInsObj role insObj insCtx insCols onConflictM + let aRows = fst res + respColsM = snd res + respCols <- maybe (cannotInsObjRelErr tn) return respColsM + let c = mergeListsWith mapCols respCols + (\(_, rCol) (col, _) -> rCol == col) + (\(lCol, _) (_, colVal) -> (lCol, colVal)) + return (aRows, c) + where + RelData insObj onConflictM = relData + cannotInsObjRelErr tn = throwVE $ + "cannot insert object relation " + <> relName <<> " since inserting into remote table " + <> tn <<> " returns nothing" + +-- | process array relation and return dependent columns, +-- | relation data, insert context of remote table and relation info +processArrRel + :: (MonadError QErr m) + => [(RelName, ArrRelData)] + -> RelationInfoMap + -> m [([PGCol], ArrRelData, InsCtx, RelInfo)] +processArrRel arrRels relInfoMap = + forM arrRels $ \(relName, rd) -> do + relIns <- onNothing (Map.lookup relName relInfoMap) $ throw500 $ + "relation with name " <> relName <<> " not found" + case relIns of + RINotInsertable reason -> throw400 NotSupported $ + "cannot insert array relation " <> relName <<> " due to " <> reason + RIInsertable (insCtx, ri) -> do + let depCols = map fst $ riMapping ri + return (depCols, rd, insCtx, ri) + +insertArrRel + :: RoleName + -> InsCtx + -> RelInfo + -> [PGColWithValue] + -> RelData [AnnGObject] + -> Q.TxE QErr Int +insertArrRel role insCtx relInfo resCols relData = do + let iObjCols = mergeListsWith resCols colMapping + (\(col, _) (lCol, _) -> col == lCol) + (\(_, colVal) (_, rCol) -> (rCol, colVal)) + rTableInfos = icColumns insCtx + iObj = Map.fromList $ mergeListsWith iObjCols rTableInfos + (\(c, _) ci -> c == pgiName ci) + (\(c, v) ci -> ( G.Name $ getPGColTxt c + , pgColValToAnnGVal (pgiType ci) v + ) + ) + res <- forM insObjs $ \annGObj -> do + -- validate array rel inserting columns + arrayRelObjValidation relName annGObj colMapping + let withParentObj = annGObj `Map.union` iObj + processInsObj role withParentObj insCtx [] onConflictM + return $ sum $ map fst res + where + colMapping = riMapping relInfo + relName = riName relInfo + RelData insObjs onConflictM = relData + +-- | insert a object with object and array relationships +processInsObj + :: RoleName + -> AnnGObject -- ^ object to be inserted + -> InsCtx -- ^ required insert context + -> [PGColWithType] -- ^ expected returning columns + -> Maybe AnnGValue -- ^ on conflict context + -> Q.TxE QErr (Int, Maybe [PGColWithValue]) +processInsObj role annObj ctx retCols onConflictM = do + (cols, objRels, arrRels) <- fetchColsAndRels annObj + + objInsRes <- forM objRels $ \(relName, relData) -> + insertObjRel tn (map _1 cols) role relName relInfoMap relData + + -- prepare final insert columns + let objInsAffRows = sum $ map fst objInsRes + addInsCols = concatMap snd objInsRes + addColInfos = getColInfos (map fst addInsCols) tableColInfos + objInsCols = mergeListsWith addInsCols addColInfos + (\(col, _) colInfo -> col == pgiName colInfo) + (\(col, colVal) colInfo -> (col, pgiType colInfo, colVal)) + finalInsCols = map pgColToAnnGVal (cols <> objInsCols) + + -- fetch array rel deps Cols + processedArrRels <- processArrRel arrRels relInfoMap + + -- prepare final returning columns + let arrDepCols = concatMap (\(a, _, _, _) -> a) processedArrRels + arrDepColsWithType = mergeListsWith arrDepCols tableColInfos + (\c ci -> c == pgiName ci) + (\c ci -> (c, pgiType ci)) + finalRetCols = retCols <> arrDepColsWithType + + (insAffRows, resColsM) <- insertRow (tn, vn) onConflictM finalInsCols + (map pgiName tableColInfos) finalRetCols role + + + arrInsRes <- forM processedArrRels $ \(_, rd, insCtx, relInfo) -> do + resCols <- maybe cannotInsArrRelErr return resColsM + insertArrRel role insCtx relInfo resCols rd + + let retColsWithValM = flip fmap resColsM $ \resCols -> + mergeListsWith retCols resCols + (\(colA, _) (colB, _) -> colA == colB) + (\(col, _) (_, colVal) -> (col, colVal)) + arrInsAffRows = sum arrInsRes + return (insAffRows + objInsAffRows + arrInsAffRows, retColsWithValM) + + where + InsCtx (tn, vn) tableColInfos _ relInfoMap = ctx + cannotInsArrRelErr = throwVE $ + "cannot proceed to insert array relations since insert to " + <> tn <<> " returns nothing" + + +mkBoolExp + :: (MonadError QErr m, MonadState PrepArgs m) + => QualifiedTable -> [(PGColInfo, PGColValue)] + -> m (GBoolExp RG.AnnSQLBoolExp) +mkBoolExp tn colInfoVals = + RG.convBoolRhs (RG.mkBoolExpBuilder prepare) (S.mkQual tn) boolExp + where + boolExp = BoolAnd $ map (BoolCol . uncurry f) colInfoVals + f ci@(PGColInfo _ colTy _) colVal = + RB.AVCol ci [RB.OEVal $ RB.AEQ (colTy, colVal)] + +mkReturning + :: QualifiedTable + -> [(PGColInfo, PGColValue)] + -> RS.AnnSelFlds + -> Q.TxE QErr RespBody +mkReturning tn pkeyColVals annFlds = do + (whereExp, args) <- flip runStateT Seq.empty $ mkBoolExp tn pkeyColVals + let selData = RS.SelectData annFlds tn Nothing + (S.BELit True, Just whereExp) Nothing [] Nothing Nothing True + RS.selectP2 (selData, args) + +buildReturningResp + :: QualifiedTable + -> Seq.Seq [(PGColInfo, PGColValue)] + -> RS.AnnSelFlds + -> Q.TxE QErr RespBody +buildReturningResp tn pkeyColSeq annFlds = do + respList <- forM pkeyColSeq $ \pkeyCols -> + mkReturning tn pkeyCols annFlds + let bsVector = V.fromList $ toList respList + return $ BB.toLazyByteString $ RR.encodeJSONVector BB.lazyByteString bsVector + +convertInsert + :: RoleName + -> InsCtx -- the insert context + -> [PGCol] -- primary key columns + -> Field -- the mutation field + -> Convert RespTx +convertInsert role insCtx@(InsCtx (tn, _) tableColInfos _ _) pCols fld = do + annVals <- withArg arguments "objects" asArray + annObjs <- forM annVals asObject + mutFlds <- convertMutResp tn (_fType fld) $ _fSelSet fld + return $ buildInsertTx annObjs mutFlds + where + arguments = _fArguments fld + onConflictM = Map.lookup "on_conflict" arguments + pColsWithType = mergeListsWith pCols tableColInfos + (\c ti -> c == pgiName ti) + (\c ti -> (c, pgiType ti)) + + buildInsertTx annObjs mutFlds = do + insResps <- forM annObjs $ \obj -> do + (affRows, pColValsM) <- processInsObj role obj insCtx pColsWithType onConflictM + let retCols = flip fmap pColValsM $ \pColVals -> + mergeListsWith tableColInfos pColVals + (\pgci (c, _) -> pgiName pgci == c) + (\pgci (_, v) -> (pgci, v)) + return (affRows, retCols) + let affRows = sum $ map fst insResps + pkeyColVals = map snd insResps + pkeyColValSeqM = Seq.fromList <$> sequence pkeyColVals + respTups <- forM (Map.toList mutFlds) $ \(t, mutFld) -> do + jsonVal <- case mutFld of + RR.MCount -> return $ J.toJSON affRows + RR.MExp txt -> return $ J.toJSON txt + RR.MRet selData -> do + let annFlds = RS.sdFlds selData + bs <- maybe (return "[]") + (\pkeyColValSeq -> buildReturningResp tn pkeyColValSeq annFlds) + pkeyColValSeqM + decodeFromBS bs + return (t, jsonVal) + return $ J.encode $ Map.fromList respTups + +-- helper functions +mergeListsWith + :: [a] -> [b] -> (a -> b -> Bool) -> (a -> b -> c) -> [c] +mergeListsWith _ [] _ _ = [] +mergeListsWith [] _ _ _ = [] +mergeListsWith (x:xs) l b f = case find (b x) l of + Nothing -> mergeListsWith xs l b f + Just y -> f x y : mergeListsWith xs l b f + +_1 :: (a, b, c) -> a +_1 (x, _, _) = x diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index 511bdeb58327e..d517efda6bff2 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -6,14 +6,14 @@ module Hasura.GraphQL.Resolve.Mutation ( convertUpdate - , convertInsert , convertDelete + , convertMutResp + , parseOnConflict ) where import Hasura.Prelude import qualified Data.HashMap.Strict as Map -import qualified Data.HashSet as Set import qualified Language.GraphQL.Draft.Syntax as G import qualified Hasura.RQL.DML.Delete as RD @@ -115,48 +115,19 @@ parseUpdCols obj = parseOnConflict :: (MonadError QErr m) - => [PGCol] -> AnnGValue -> m RI.ConflictCtx + => [PGCol] -> AnnGValue -> m RI.ConflictClauseP1 parseOnConflict inpCols val = flip withObject val $ \_ obj -> do actionM <- parseAction obj constraint <- parseConstraint obj updColsM <- parseUpdCols obj -- consider "action" if "update_columns" is not mentioned - return $ case (updColsM, actionM) of + return $ mkConflictClause $ case (updColsM, actionM) of (Just [], _) -> RI.CCDoNothing $ Just constraint (Just cols, _) -> RI.CCUpdate constraint cols (Nothing, Just CAIgnore) -> RI.CCDoNothing $ Just constraint (Nothing, _) -> RI.CCUpdate constraint inpCols -convertInsert - :: RoleName - -> (QualifiedTable, QualifiedTable) -- table, view - -> [PGCol] -- all the columns in this table - -> Field -- the mutation field - -> Convert RespTx -convertInsert role (tn, vn) tableCols fld = do - insTuples <- withArg arguments "objects" asRowExps - let inpCols = Set.toList $ Set.fromList $ concatMap fst insTuples - conflictCtxM <- withArgM arguments "on_conflict" $ parseOnConflict inpCols - let onConflictM = fmap mkConflictClause conflictCtxM - mutFlds <- convertMutResp tn (_fType fld) $ _fSelSet fld - args <- get - let rows = map snd insTuples - p1Query = RI.InsertQueryP1 tn vn tableCols rows onConflictM mutFlds - p1 = (p1Query, args) - return $ - bool (RI.nonAdminInsert p1) (RI.insertP2 p1) $ isAdmin role - where - arguments = _fArguments fld - asRowExps = withArray (const $ mapM rowExpWithDefaults) - rowExpWithDefaults val = do - givenCols <- convertRowObj val - let inpCols = map fst givenCols - sqlExps = Map.elems $ Map.union (Map.fromList givenCols) defVals - return (inpCols, sqlExps) - - defVals = Map.fromList $ zip tableCols (repeat $ S.SEUnsafe "DEFAULT") - type ApplySQLOp = (PGCol, S.SQLExp) -> S.SQLExp rhsExpOp :: S.SQLOp -> S.AnnType -> ApplySQLOp diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 6eedafeb69074..f734bc28afac3 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -18,6 +18,9 @@ module Hasura.GraphQL.Schema , OrdByResolveCtxElem , NullsOrder(..) , OrdTy(..) + , RelInsert(..) + , InsCtx(..) + , RelationInfoMap ) where import Data.Has @@ -32,6 +35,7 @@ import Hasura.GraphQL.Resolve.Context import Hasura.GraphQL.Validate.Types import Hasura.Prelude +import Hasura.RQL.DML.Internal (mkAdminRolePermInfo) import Hasura.RQL.Types import Hasura.SQL.Types @@ -40,18 +44,86 @@ import qualified Hasura.SQL.DML as S defaultTypes :: [TypeInfo] defaultTypes = $(fromSchemaDocQ defaultSchema) +data RelInsert + = RIInsertable !(InsCtx, RelInfo) + | RINotInsertable !T.Text + deriving (Show, Eq) + +type RelationInfoMap = Map.HashMap RelName RelInsert + +data InsCtx + = InsCtx + { icTableAndView :: !(QualifiedTable, QualifiedTable) + , icColumns :: ![PGColInfo] + , icUpsertAllowed :: !Bool + , icRelations :: !RelationInfoMap + } deriving (Show, Eq) + +getInsPerm :: TableInfo -> RoleName -> Maybe InsPermInfo +getInsPerm tabInfo role + | role == adminRole = _permIns $ mkAdminRolePermInfo tabInfo + | otherwise = Map.lookup role rolePermInfoMap >>= _permIns + where + rolePermInfoMap = tiRolePermInfoMap tabInfo + +getTabInfo + :: MonadError QErr m + => TableCache -> QualifiedTable -> m TableInfo +getTabInfo tc t = + onNothing (Map.lookup t tc) $ + throw500 $ "table not found: " <>> t + +buildInsCtx + :: (MonadError QErr m) + => Set.HashSet QualifiedTable + -> RoleName + -> QualifiedTable + -> TableCache + -> FieldInfoMap + -> InsPermInfo + -> m InsCtx +buildInsCtx procTabs role tn tc fim insPerm = do + relFlds <- forM rels f + let relsMap = Map.fromList relFlds + return $ InsCtx (tn, vn) cols upsertAllowed relsMap + where + vn = ipiView insPerm + cols = getCols fim + rels = getRels fim + upsertAllowed = ipiAllowUpsert insPerm + + f relInfo = do + let remoteTab = riRTable relInfo + relName = riName relInfo + insertable = not $ Set.member remoteTab procTabs + if not insertable then + return ( relName + , RINotInsertable $ "table " <> remoteTab <<> " is already being inserted" + ) + else do + ti <- getTabInfo tc remoteTab + let fld = tiFieldInfoMap ti + mInsPerm = getInsPerm ti role + addTabl = Set.insert remoteTab procTabs + insCtxM <- forM mInsPerm $ buildInsCtx addTabl role remoteTab tc fld + return $ maybe ( relName + , RINotInsertable $ "insert permission not found for table " + <> remoteTab <<> " for role " <>> role + ) + (\insCtx -> (relName, RIInsertable (insCtx, relInfo))) + insCtxM + type OpCtxMap = Map.HashMap G.Name OpCtx data OpCtx - -- tn, vn, cols, req hdrs - = OCInsert QualifiedTable QualifiedTable [PGCol] [T.Text] + -- insert context, primary key cols, req hdrs + = OCInsert InsCtx [PGCol] [T.Text] -- tn, filter exp, limit, req hdrs | OCSelect QualifiedTable S.BoolExp (Maybe Int) [T.Text] -- tn, filter exp, reqt hdrs | OCSelectPkey QualifiedTable S.BoolExp [T.Text] -- tn, filter exp, req hdrs | OCUpdate QualifiedTable S.BoolExp [T.Text] - -- tn, filter exp, req hdrs | OCDelete QualifiedTable S.BoolExp [T.Text] deriving (Show, Eq) @@ -636,6 +708,19 @@ mkInsInpTy :: QualifiedTable -> G.NamedType mkInsInpTy tn = G.NamedType $ qualTableToName tn <> "_insert_input" +-- table_relname_obj_insert_input +mkObjInsInpTy :: QualifiedTable -> RelName -> G.NamedType +mkObjInsInpTy tn rn = + G.NamedType $ qualTableToName tn <> "_" + <> G.Name (getRelTxt rn) <> "_obj_insert_input" + +-- table_relname_arr_insert_input +mkArrInsInpTy :: QualifiedTable -> RelName -> G.NamedType +mkArrInsInpTy tn rn = + G.NamedType $ qualTableToName tn <> "_" + <> G.Name (getRelTxt rn) <> "_arr_insert_input" + + -- table_on_conflict mkOnConflictInpTy :: QualifiedTable -> G.NamedType mkOnConflictInpTy tn = @@ -650,6 +735,48 @@ mkConstraintInpTy tn = mkColumnInpTy :: QualifiedTable -> G.NamedType mkColumnInpTy tn = G.NamedType $ qualTableToName tn <> "_column" +{- + +input table_relname_obj_insert_input { + data: table_insert_input! #remote table + on_conflict: table_on_conflict #remote table +} + +-} + +{- + +input table_relname_arr_insert_input { + data: [table_insert_input!]! #remote table + on_conflict: table_on_conflict #remote table +} + +-} + +mkRelInsInp + :: QualifiedTable -> (RelInfo, Bool) -> InpObjTyInfo +mkRelInsInp tn (ri, isUpsertAllowed) = + InpObjTyInfo (Just desc) ty $ fromInpValL $ + dataInpVal : bool [] [onConflictInpVal] isUpsertAllowed + where + relName = riName ri + remoteQT = riRTable ri + + desc = G.Description $ + "input type for relational insert for table " <>> tn + + onConflictInpVal = + InpValInfo Nothing "on_conflict" $ G.toGT $ mkOnConflictInpTy remoteQT + + (ty, dataInpVal) = case riType ri of + ObjRel -> ( mkObjInsInpTy tn relName + , InpValInfo Nothing "data" $ G.toGT $ + G.toNT $ mkInsInpTy remoteQT + ) + ArrRel -> ( mkArrInsInpTy tn relName + , InpValInfo Nothing "data" $ G.toGT $ + G.toNT $ G.toLT $ G.toNT $ mkInsInpTy remoteQT + ) {- @@ -663,13 +790,27 @@ input table_insert_input { -} mkInsInp - :: QualifiedTable -> [PGColInfo] -> InpObjTyInfo -mkInsInp tn cols = + :: QualifiedTable -> InsCtx -> InpObjTyInfo +mkInsInp tn insCtx = InpObjTyInfo (Just desc) (mkInsInpTy tn) $ fromInpValL $ - map mkPGColInp cols + map mkPGColInp cols <> catMaybes relInps where desc = G.Description $ "input type for inserting data into table " <>> tn + cols = icColumns insCtx + relInfoMap = icRelations insCtx + + relInps = flip map (Map.toList relInfoMap) $ + \(rn, relIns) -> + case relIns of + RINotInsertable _ -> Nothing + RIInsertable (_, ri) -> + let rty = riType ri + in Just $ case rty of + ObjRel -> InpValInfo Nothing (G.Name $ getRelTxt rn) $ + G.toGT $ mkObjInsInpTy tn rn + ArrRel -> InpValInfo Nothing (G.Name $ getRelTxt rn) $ + G.toGT $ mkArrInsInpTy tn rn {- @@ -845,8 +986,8 @@ mkOnConflictTypes tn c cols isUpsertAllowed = mkGCtxRole' :: QualifiedTable - -- insert cols, is upsert allowed - -> Maybe ([PGColInfo], Bool) + -- insert flds, is upsert allowed + -> Maybe (InsCtx, Bool) -- select permission -> Maybe [SelField] -- update cols @@ -869,8 +1010,9 @@ mkGCtxRole' tn insPermM selFldsM updColsM delPermM pkeyCols constraints allCols onConflictTypes = mkOnConflictTypes tn constraints allCols $ or $ fmap snd insPermM jsonOpTys = fromMaybe [] updJSONOpInpObjTysM + relInsInpObjTys = map TIInpObj $ catMaybes relInsInpObjs - allTypes = onConflictTypes <> jsonOpTys <> catMaybes + allTypes = relInsInpObjTys <> onConflictTypes <> jsonOpTys <> catMaybes [ TIInpObj <$> insInpObjM , TIInpObj <$> updSetInpObjM , TIInpObj <$> updIncInpObjM @@ -892,11 +1034,21 @@ mkGCtxRole' tn insPermM selFldsM updColsM delPermM pkeyCols constraints allCols -- helper mkColFldMap ty = mapFromL ((ty,) . nameFromSelFld) . map Left - insColsM = fst <$> insPermM + insCtxM = fst <$> insPermM + insColsM = icColumns <$> insCtxM + insRelsM = (icRelations . fst) <$> insPermM -- insert input type - insInpObjM = mkInsInp tn <$> insColsM - -- fields used in insert input object + insInpObjM = mkInsInp tn <$> insCtxM + -- column fields used in insert input object insInpObjFldsM = mkColFldMap (mkInsInpTy tn) <$> insColsM + -- relationship input objects + relInsInpObjs = maybe [] (map (mkRelInsInp tn <$>) ) $ + fmap toRelInfosM insRelsM + + toRelInfosM relMap = flip map (Map.toList relMap) $ + \(_, relIns) -> case relIns of + RINotInsertable _ -> Nothing + RIInsertable (n, ri) -> Just (ri, icUpsertAllowed n) -- update set input type updSetInpObjM = mkUpdSetInp tn <$> updColsM @@ -925,7 +1077,7 @@ mkGCtxRole' tn insPermM selFldsM updColsM delPermM pkeyCols constraints allCols -- mut resp obj mutRespObjM = - if isJust insColsM || isJust updColsM || isJust delPermM + if isJust insPermM || isJust updColsM || isJust delPermM then Just $ mkMutRespObj tn $ isJust selFldsM else Nothing @@ -948,7 +1100,7 @@ getRootFldsRole' -> [PGCol] -> [TableConstraint] -> FieldInfoMap - -> Maybe (QualifiedTable, [T.Text], Bool) -- insert perm + -> Maybe (InsCtx, [PGCol], [T.Text], Bool) -- insert perm -> Maybe (S.BoolExp, Maybe Int, [T.Text]) -- select filter -> Maybe ([PGCol], S.BoolExp, [T.Text]) -- update filter -> Maybe (S.BoolExp, [T.Text]) -- delete filter @@ -962,8 +1114,8 @@ getRootFldsRole' tn primCols constraints fields insM selM updM delM = , getPKeySelDet selM $ getColInfos primCols colInfos ] colInfos = fst $ validPartitionFieldInfoMap fields - getInsDet (vn, hdrs, isUpsertAllowed) = - ( OCInsert tn vn (map pgiName colInfos) hdrs + getInsDet (insCtx, pCols, hdrs, isUpsertAllowed) = + ( OCInsert insCtx pCols hdrs , Right $ mkInsMutFld tn constraints isUpsertAllowed ) getUpdDet (updCols, updFltr, hdrs) = @@ -1004,7 +1156,7 @@ getSelFlds tableCache fields role selPermInfo = return $ fmap Left $ bool Nothing (Just pgColInfo) $ Set.member (pgiName pgColInfo) allowedCols FIRelationship relInfo -> do - remTableInfo <- getTabInfo $ riRTable relInfo + remTableInfo <- getTabInfo tableCache $ riRTable relInfo let remTableSelPermM = Map.lookup role (tiRolePermInfoMap remTableInfo) >>= _permSel return $ flip fmap remTableSelPermM $ @@ -1015,9 +1167,6 @@ getSelFlds tableCache fields role selPermInfo = ) where allowedCols = spiCols selPermInfo - getTabInfo tn = - onNothing (Map.lookup tn tableCache) $ - throw500 $ "remote table not found: " <>> tn mkGCtxRole :: (MonadError QErr m) @@ -1031,11 +1180,14 @@ mkGCtxRole -> m (TyAgg, RootFlds) mkGCtxRole tableCache tn fields pCols constraints role permInfo = do selFldsM <- mapM (getSelFlds tableCache fields role) $ _permSel permInfo - let insColsM = ((colInfos,) . ipiAllowUpsert) <$> _permIns permInfo - updColsM = filterColInfos . upiCols <$> _permUpd permInfo - tyAgg = mkGCtxRole' tn insColsM selFldsM updColsM + insCtxM <- forM (_permIns permInfo) $ \insPerm -> do + let tabSet = Set.singleton tn + insCtx <- buildInsCtx tabSet role tn tableCache fields insPerm + return (insCtx, pCols, ipiRequiredHeaders insPerm, ipiAllowUpsert insPerm) + let updColsM = filterColInfos . upiCols <$> _permUpd permInfo + tyAgg = mkGCtxRole' tn (mkInsFlds <$> insCtxM) selFldsM updColsM (void $ _permDel permInfo) pColInfos constraints allCols - rootFlds = getRootFldsRole tn pCols constraints fields permInfo + rootFlds = getRootFldsRole tn pCols constraints fields insCtxM permInfo return (tyAgg, rootFlds) where colInfos = fst $ validPartitionFieldInfoMap fields @@ -1043,20 +1195,21 @@ mkGCtxRole tableCache tn fields pCols constraints role permInfo = do pColInfos = getColInfos pCols colInfos filterColInfos allowedSet = filter ((`Set.member` allowedSet) . pgiName) colInfos + mkInsFlds (insCtx, _, _, isUpsertAllowed) = (insCtx, isUpsertAllowed) getRootFldsRole :: QualifiedTable -> [PGCol] -> [TableConstraint] -> FieldInfoMap + -> Maybe (InsCtx, [PGCol], [T.Text], Bool) -- insert perm -> RolePermInfo -> RootFlds -getRootFldsRole tn pCols constraints fields (RolePermInfo insM selM updM delM) = +getRootFldsRole tn pCols constraints fields insM (RolePermInfo _ selM updM delM) = getRootFldsRole' tn pCols constraints fields - (mkIns <$> insM) (mkSel <$> selM) + insM (mkSel <$> selM) (mkUpd <$> updM) (mkDel <$> delM) where - mkIns i = (ipiView i, ipiRequiredHeaders i, ipiAllowUpsert i) mkSel s = (spiFilter s, spiLimit s, spiRequiredHeaders s) mkUpd u = ( Set.toList $ upiCols u , upiFilter u @@ -1071,10 +1224,12 @@ mkGCtxMapTable -> m (Map.HashMap RoleName (TyAgg, RootFlds)) mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols _) = do m <- Map.traverseWithKey (mkGCtxRole tableCache tn fields pkeyCols validConstraints) rolePerms - let adminCtx = mkGCtxRole' tn (Just (colInfos, True)) + insCtxAdmin <- buildInsCtx (Set.singleton tn) adminRole + tn tableCache fields $ InsPermInfo tn (S.BELit True) True [] [] + let adminCtx = mkGCtxRole' tn (Just (insCtxAdmin, True)) (Just selFlds) (Just colInfos) (Just ()) pkeyColInfos validConstraints allCols - return $ Map.insert adminRole (adminCtx, adminRootFlds) m + return $ Map.insert adminRole (adminCtx, adminRootFlds insCtxAdmin) m where validConstraints = mkValidConstraints constraints colInfos = fst $ validPartitionFieldInfoMap fields @@ -1084,9 +1239,9 @@ mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols FIColumn pgColInfo -> Left pgColInfo FIRelationship relInfo -> Right (relInfo, noFilter, Nothing, isRelNullable fields relInfo) noFilter = S.BELit True - adminRootFlds = + adminRootFlds ain = getRootFldsRole' tn pkeyCols constraints fields - (Just (tn, [], True)) (Just (noFilter, Nothing, [])) + (Just (ain, pkeyCols, [], True)) (Just (noFilter, Nothing, [])) (Just (allCols, noFilter, [])) (Just (noFilter, [])) mkScalarTyInfo :: PGColType -> ScalarTyInfo diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index 8c67fed9ac3e0..2f216bf5196a4 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -29,6 +29,7 @@ module Hasura.GraphQL.Validate.Types , getObjTyM , mkScalarTy , pgColTyToScalar + , pgColValToAnnGVal , getNamedTy , mkTyInfoMap , fromTyDef @@ -285,6 +286,9 @@ instance J.ToJSON AnnGValue where -- J. -- J.toJSON [J.toJSON ty, J.toJSON valM] +pgColValToAnnGVal :: PGColType -> PGColValue -> AnnGValue +pgColValToAnnGVal colTy colVal = AGScalar colTy $ Just colVal + hasNullVal :: AnnGValue -> Bool hasNullVal = \case AGScalar _ Nothing -> True diff --git a/server/src-lib/Hasura/RQL/DML/Select.hs b/server/src-lib/Hasura/RQL/DML/Select.hs index 9836e17ca98b1..fa25eaa5e4ab4 100644 --- a/server/src-lib/Hasura/RQL/DML/Select.hs +++ b/server/src-lib/Hasura/RQL/DML/Select.hs @@ -65,9 +65,11 @@ data AnnRel = AnnRel , arSelData :: !SelectData -- Current table. Almost ~ to SQL Select } deriving (Show, Eq) +type AnnSelFlds = HM.HashMap FieldName AnnFld + data SelectData = SelectData -- Nested annotated columns - { sdFlds :: !(HM.HashMap FieldName AnnFld) + { sdFlds :: !AnnSelFlds , sdTable :: !QualifiedTable -- from postgres table , sdFromExp :: !(Maybe S.FromExp) -- optional from expression , sdWhere :: !(S.BoolExp, Maybe (GBoolExp AnnSQLBoolExp)) diff --git a/server/src-lib/Hasura/RQL/Types/Error.hs b/server/src-lib/Hasura/RQL/Types/Error.hs index 2974359f24ffe..98c83e97e7000 100644 --- a/server/src-lib/Hasura/RQL/Types/Error.hs +++ b/server/src-lib/Hasura/RQL/Types/Error.hs @@ -21,6 +21,7 @@ module Hasura.RQL.Types.Error -- Aeson helpers , runAesonParser , decodeValue + , decodeFromBS -- Modify error messages , modifyErr @@ -38,12 +39,13 @@ module Hasura.RQL.Types.Error import Data.Aeson import Data.Aeson.Internal import Data.Aeson.Types -import qualified Database.PG.Query as Q +import qualified Database.PG.Query as Q import Hasura.Prelude -import Text.Show (Show (..)) +import Text.Show (Show (..)) -import qualified Data.Text as T -import qualified Network.HTTP.Types as N +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Network.HTTP.Types as N data Code = PermissionDenied @@ -274,3 +276,6 @@ runAesonParser p = decodeValue :: (FromJSON a, QErrM m) => Value -> m a decodeValue = liftIResult . ifromJSON + +decodeFromBS :: (FromJSON a, QErrM m) => BL.ByteString -> m a +decodeFromBS = either (throw500 . T.pack) decodeValue . eitherDecode diff --git a/server/test/Spec.hs b/server/test/Spec.hs index 840ae35ab1ed7..af4e45b904748 100644 --- a/server/test/Spec.hs +++ b/server/test/Spec.hs @@ -55,9 +55,13 @@ gqlSpecFiles = [ "introspection.yaml" , "introspection_user_role.yaml" , "insert_mutation/author.yaml" + , "insert_mutation/author_articles_nested.yaml" + , "insert_mutation/author_articles_nested_error.yaml" , "simple_select_query_author.yaml" , "select_query_author_by_pkey.yaml" , "insert_mutation/article.yaml" + , "insert_mutation/article_author_nested.yaml" + , "insert_mutation/article_author_nested_error.yaml" , "insert_mutation/article_on_conflict.yaml" , "insert_mutation/article_on_conflict_user_role.yaml" , "insert_mutation/article_on_conflict_update_columns.yaml" diff --git a/server/test/testcases/insert_mutation/article_author_nested.yaml b/server/test/testcases/insert_mutation/article_author_nested.yaml new file mode 100644 index 0000000000000..1a20bc37a7456 --- /dev/null +++ b/server/test/testcases/insert_mutation/article_author_nested.yaml @@ -0,0 +1,42 @@ +description: Insert article and it's author via nested mutation +url: /v1alpha1/graphql +status: 200 +query: + query: | + mutation article_author{ + insert_article( + objects: [ + { + title: "Article by author 4", + content: "Article content for article by author 4", + is_published: true + author: { + data: { + name: "Article 4" + } + } + }, + { + title: "Article by author 5", + content: "Article content for article by author 5", + is_published: true + author: { + data: { + name: "Article 5" + } + } + } + ] + ){ + affected_rows + returning{ + id + title + content + author{ + id + name + } + } + } + } diff --git a/server/test/testcases/insert_mutation/article_author_nested_error.yaml b/server/test/testcases/insert_mutation/article_author_nested_error.yaml new file mode 100644 index 0000000000000..98e47133a7a0f --- /dev/null +++ b/server/test/testcases/insert_mutation/article_author_nested_error.yaml @@ -0,0 +1,44 @@ +description: Insert article and it's author via nested mutation (Error) +url: /v1alpha1/graphql +status: 400 +query: + query: | + mutation article_author{ + insert_article( + objects: [ + { + title: "Article by author 4", + content: "Article content for article by author 4", + is_published: true, + author_id: 4 + author: { + data: { + name: "Article 4" + } + } + }, + { + title: "Article by author 5", + content: "Article content for article by author 5", + is_published: true, + author_id: 5 + author: { + data: { + name: "Article 5" + } + } + } + ] + ){ + affected_rows + returning{ + id + title + content + author{ + id + name + } + } + } + } diff --git a/server/test/testcases/insert_mutation/author_articles_nested.yaml b/server/test/testcases/insert_mutation/author_articles_nested.yaml new file mode 100644 index 0000000000000..084214af4ac75 --- /dev/null +++ b/server/test/testcases/insert_mutation/author_articles_nested.yaml @@ -0,0 +1,32 @@ +description: Insert author and it's articles via nested mutation +url: /v1alpha1/graphql +status: 200 +query: + query: | + mutation nested_author_insert { + insert_author( + objects: [ + { + name: "Author 3", + articles: { + data: [ + { + title: "An article by author 3", + content: "Content for article by author 4", + is_published: false + } + ] + } + } + ] + ) { + affected_rows + returning { + id + name + articles { + id + } + } + } + } diff --git a/server/test/testcases/insert_mutation/author_articles_nested_error.yaml b/server/test/testcases/insert_mutation/author_articles_nested_error.yaml new file mode 100644 index 0000000000000..a3e3aec62064c --- /dev/null +++ b/server/test/testcases/insert_mutation/author_articles_nested_error.yaml @@ -0,0 +1,33 @@ +description: Insert author and it's articles via nested mutation (Error) +url: /v1alpha1/graphql +status: 400 +query: + query: | + mutation nested_author_insert { + insert_author( + objects: [ + { + name: "Author 3", + articles: { + data: [ + { + title: "An article by author 3", + content: "Content for article by author 4", + is_published: false, + author_id: 3 + } + ] + } + } + ] + ) { + affected_rows + returning { + id + name + articles { + id + } + } + } + } From cd77ad0254e55734b0e0599e98e98528556112b9 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Wed, 12 Sep 2018 20:54:08 +0530 Subject: [PATCH 02/12] consider all table columns if table has no pkey columns --- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index db79c21231024..f647699ccabd5 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -356,17 +356,19 @@ convertInsert role insCtx@(InsCtx (tn, _) tableColInfos _ _) pCols fld = do where arguments = _fArguments fld onConflictM = Map.lookup "on_conflict" arguments - pColsWithType = mergeListsWith pCols tableColInfos - (\c ti -> c == pgiName ti) - (\c ti -> (c, pgiType ti)) + -- consider all table columns if no primary key columns present + pCols' = bool pCols (map pgiName tableColInfos) $ null pCols + reqRetCols = mergeListsWith pCols' tableColInfos + (\c ti -> c == pgiName ti) + (\c ti -> (c, pgiType ti)) buildInsertTx annObjs mutFlds = do insResps <- forM annObjs $ \obj -> do - (affRows, pColValsM) <- processInsObj role obj insCtx pColsWithType onConflictM - let retCols = flip fmap pColValsM $ \pColVals -> - mergeListsWith tableColInfos pColVals - (\pgci (c, _) -> pgiName pgci == c) - (\pgci (_, v) -> (pgci, v)) + (affRows, retColValsM) <- processInsObj role obj insCtx reqRetCols onConflictM + let retCols = flip fmap retColValsM $ \retColsVals -> + mergeListsWith tableColInfos retColsVals + (\ci (c, _) -> pgiName ci == c) + (\ci (_, v) -> (ci, v)) return (affRows, retCols) let affRows = sum $ map fst insResps pkeyColVals = map snd insResps From a3699ebc3dfc818e5e49133183e7e6e504bf5bdc Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Fri, 14 Sep 2018 14:08:29 +0530 Subject: [PATCH 03/12] update docs --- .../graphql/manual/api-reference/mutation.rst | 14 +++++ docs/graphql/manual/mutations/insert.rst | 56 ++++++++++++++++++- docs/graphql/manual/mutations/upsert.rst | 49 ++++++++++++++++ 3 files changed, 118 insertions(+), 1 deletion(-) diff --git a/docs/graphql/manual/api-reference/mutation.rst b/docs/graphql/manual/api-reference/mutation.rst index f56ed1c649481..0e4ef70ec4f8a 100644 --- a/docs/graphql/manual/api-reference/mutation.rst +++ b/docs/graphql/manual/api-reference/mutation.rst @@ -235,6 +235,14 @@ Input Object { field1: value, field2: value, + : { + data: !, + on_conflict: + }, + : { + data: [!]!, + on_conflict: + } .. }, .. @@ -249,6 +257,12 @@ E.g.: { title: "Software is eating the world", content: "This week, Hewlett-Packard...", + author: { + data: { + id: 1, + name: "Sydney" + } + } } ] diff --git a/docs/graphql/manual/mutations/insert.rst b/docs/graphql/manual/mutations/insert.rst index a08ee00e4fa2d..83f0e30546b26 100644 --- a/docs/graphql/manual/mutations/insert.rst +++ b/docs/graphql/manual/mutations/insert.rst @@ -132,6 +132,60 @@ Insert multiple objects of the same type in the same mutation } } +Insert nested object and get nested object in response +----------------------------------------------------- +**Example:** Insert a new ``article`` object with its ``author`` and return the inserted article object with its author in the response + + +.. graphiql:: + :view_only: + :query: + mutation insert_article { + insert_article( + objects: [ + { + id: 21, + title: "Article 1", + content: "Sample article content", + author: { + data: { + id: 3, + name: "Sidney" + } + } + } + ] + ) { + returning { + id + title + author { + id + name + } + } + } + } + :response: + { + "data": { + "insert_article": { + "affected_rows": 2, + "returning": [ + { + "id": 21, + "title": "Article 1", + "author": { + "id": 3, + "name": "Sidney" + } + } + ] + } + } + } + + Insert object and get nested object in response ----------------------------------------------- **Example:** Insert a new ``article`` object and return the inserted article object with its author in the response @@ -297,4 +351,4 @@ OR ] } } - } \ No newline at end of file + } diff --git a/docs/graphql/manual/mutations/upsert.rst b/docs/graphql/manual/mutations/upsert.rst index de94dff6df0e9..bbbf0aef6255c 100644 --- a/docs/graphql/manual/mutations/upsert.rst +++ b/docs/graphql/manual/mutations/upsert.rst @@ -255,3 +255,52 @@ ignore the request: } In this case, the insert mutation is ignored because there is a conflict. + +Upsert in nested mutations +-------------------------- +You can specify ``on_conflict`` clause while inserting nested objects + + +.. graphiql:: + :view_only: + :query: + mutation upsert_author_article { + insert_author( + objects: [ + { name: "John", + id: 10, + articles: { + data: [ + { + id: 1, + title: "Article 1 title", + content: "Article 1 content" + } + ], + on_conflict: { + constraint: article_pkey, + update_columns: [title, content] + } + } + } + ] + ) { + affected_rows + } + } + :response: + { + "data": { + "insert_author": { + "affected_rows": 2 + } + } + } + + +.. warning:: + Inserting nested objects fails when + + 1. Any of upsert in object relationships does not affect any rows (``update_columns: []`` or ``action: ignore``) + + 2. Array relationships are queued for insert and parent insert does not affect any rows (``update_columns: []`` or ``action: ignore``) From 93c2b039de839ceee7ff9ad142547717d09bf4a7 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Fri, 14 Sep 2018 19:50:03 +0530 Subject: [PATCH 04/12] table_relname__insert_inp -> table__rel_insert_inp --- server/src-lib/Hasura/GraphQL/Schema.hs | 147 ++++++++++++------------ 1 file changed, 71 insertions(+), 76 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 764f9d65acfb7..e1e2270b00f93 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -197,6 +197,12 @@ isRelNullable fim ri = isNullable lColInfos = getColInfos lCols allCols isNullable = any pgiIsNullable lColInfos +isUpsertAllowed :: [TableConstraint] -> Bool -> Bool +isUpsertAllowed constraints upsertPerm = + not (null uniqueOrPrimaryCons) && upsertPerm + where + uniqueOrPrimaryCons = filter isUniqueOrPrimary constraints + mkColName :: PGCol -> G.Name mkColName (PGCol n) = G.Name n @@ -738,17 +744,15 @@ mkInsInpTy :: QualifiedTable -> G.NamedType mkInsInpTy tn = G.NamedType $ qualTableToName tn <> "_insert_input" --- table_relname_obj_insert_input -mkObjInsInpTy :: QualifiedTable -> RelName -> G.NamedType -mkObjInsInpTy tn rn = - G.NamedType $ qualTableToName tn <> "_" - <> G.Name (getRelTxt rn) <> "_obj_insert_input" +-- table_obj_rel_insert_input +mkObjInsInpTy :: QualifiedTable -> G.NamedType +mkObjInsInpTy tn = + G.NamedType $ qualTableToName tn <> "_obj_rel_insert_input" --- table_relname_arr_insert_input -mkArrInsInpTy :: QualifiedTable -> RelName -> G.NamedType -mkArrInsInpTy tn rn = - G.NamedType $ qualTableToName tn <> "_" - <> G.Name (getRelTxt rn) <> "_arr_insert_input" +-- table_arr_rel_insert_input +mkArrInsInpTy :: QualifiedTable -> G.NamedType +mkArrInsInpTy tn = + G.NamedType $ qualTableToName tn <> "_arr_rel_insert_input" -- table_on_conflict @@ -766,47 +770,45 @@ mkColumnInpTy :: QualifiedTable -> G.NamedType mkColumnInpTy tn = G.NamedType $ qualTableToName tn <> "_column" {- - -input table_relname_obj_insert_input { - data: table_insert_input! #remote table - on_conflict: table_on_conflict #remote table +input table_obj_rel_insert_input { + data: table_insert_input! + on_conflict: table_on_conflict } -} {- - -input table_relname_arr_insert_input { - data: [table_insert_input!]! #remote table - on_conflict: table_on_conflict #remote table +input table_arr_rel_insert_input { + data: [table_insert_input!]! + on_conflict: table_on_conflict } -} -mkRelInsInp - :: QualifiedTable -> (RelInfo, Bool) -> InpObjTyInfo -mkRelInsInp tn (ri, isUpsertAllowed) = - InpObjTyInfo (Just desc) ty $ fromInpValL $ - dataInpVal : bool [] [onConflictInpVal] isUpsertAllowed +mkRelInsInps + :: QualifiedTable -> Bool -> [InpObjTyInfo] +mkRelInsInps tn upsertAllowed = [objRelInsInp, arrRelInsInp] where - relName = riName ri - remoteQT = riRTable ri + onConflictInpVal = + InpValInfo Nothing "on_conflict" $ G.toGT $ mkOnConflictInpTy tn - desc = G.Description $ - "input type for relational insert for table " <>> tn + onConflictInp = bool [] [onConflictInpVal] upsertAllowed - onConflictInpVal = - InpValInfo Nothing "on_conflict" $ G.toGT $ mkOnConflictInpTy remoteQT - - (ty, dataInpVal) = case riType ri of - ObjRel -> ( mkObjInsInpTy tn relName - , InpValInfo Nothing "data" $ G.toGT $ - G.toNT $ mkInsInpTy remoteQT - ) - ArrRel -> ( mkArrInsInpTy tn relName - , InpValInfo Nothing "data" $ G.toGT $ - G.toNT $ G.toLT $ G.toNT $ mkInsInpTy remoteQT - ) + objRelDesc = G.Description $ + "input type for inserting object relation for remote table " <>> tn + + objRelDataInp = InpValInfo Nothing "data" $ G.toGT $ + G.toNT $ mkInsInpTy tn + objRelInsInp = InpObjTyInfo (Just objRelDesc) (mkObjInsInpTy tn) + $ fromInpValL $ objRelDataInp : onConflictInp + + arrRelDesc = G.Description $ + "input type for inserting array relation for remote table " <>> tn + + arrRelDataInp = InpValInfo Nothing "data" $ G.toGT $ + G.toNT $ G.toLT $ G.toNT $ mkInsInpTy tn + arrRelInsInp = InpObjTyInfo (Just arrRelDesc) (mkArrInsInpTy tn) + $ fromInpValL $ arrRelDataInp : onConflictInp {- @@ -836,11 +838,12 @@ mkInsInp tn insCtx = RINotInsertable _ -> Nothing RIInsertable (_, ri) -> let rty = riType ri + remoteQT = riRTable ri in Just $ case rty of ObjRel -> InpValInfo Nothing (G.Name $ getRelTxt rn) $ - G.toGT $ mkObjInsInpTy tn rn + G.toGT $ mkObjInsInpTy remoteQT ArrRel -> InpValInfo Nothing (G.Name $ getRelTxt rn) $ - G.toGT $ mkArrInsInpTy tn rn + G.toGT $ mkArrInsInpTy remoteQT {- @@ -879,8 +882,8 @@ insert_table( -} mkInsMutFld - :: QualifiedTable -> [TableConstraint] -> Bool -> ObjFldInfo -mkInsMutFld tn constraints isUpsertAllowed = + :: QualifiedTable -> Bool -> ObjFldInfo +mkInsMutFld tn upsertAllowed = ObjFldInfo (Just desc) fldName (fromInpValL inputVals) $ G.toGT $ mkMutRespTy tn where @@ -895,9 +898,8 @@ mkInsMutFld tn constraints isUpsertAllowed = InpValInfo (Just objsArgDesc) "objects" $ G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkInsInpTy tn - uniqueOrPrimaryCons = filter isUniqueOrPrimary constraints - onConflictInpVal = bool (Just onConflictArg) Nothing - (null uniqueOrPrimaryCons || not isUpsertAllowed) + onConflictInpVal = bool Nothing (Just onConflictArg) + upsertAllowed onConflictDesc = "on conflict condition" onConflictArg = @@ -1004,8 +1006,7 @@ instance Monoid RootFlds where mkOnConflictTypes :: QualifiedTable -> [TableConstraint] -> [PGCol] -> Bool -> [TypeInfo] -mkOnConflictTypes tn c cols isUpsertAllowed = - bool tyInfos [] (null constraints || not isUpsertAllowed) +mkOnConflictTypes tn c cols = bool [] tyInfos where tyInfos = [ TIEnum mkConflictActionTy , TIEnum $ mkConstriantTy tn constraints @@ -1016,8 +1017,8 @@ mkOnConflictTypes tn c cols isUpsertAllowed = mkGCtxRole' :: QualifiedTable - -- insert flds, is upsert allowed - -> Maybe (InsCtx, Bool) + -- insert context + -> Maybe InsCtx -- select permission -> Maybe [SelField] -- update cols @@ -1031,16 +1032,17 @@ mkGCtxRole' -- all columns -> [PGCol] -> TyAgg -mkGCtxRole' tn insPermM selFldsM updColsM delPermM pkeyCols constraints allCols = +mkGCtxRole' tn insCtxM selFldsM updColsM delPermM pkeyCols constraints allCols = TyAgg (mkTyInfoMap allTypes) fieldMap ordByEnums where + upsertPerm = or $ fmap icUpsertAllowed insCtxM + upsertAllowed = isUpsertAllowed constraints upsertPerm ordByEnums = fromMaybe Map.empty ordByResCtxM - onConflictTypes = mkOnConflictTypes tn constraints allCols $ - or $ fmap snd insPermM + onConflictTypes = mkOnConflictTypes tn constraints allCols upsertAllowed jsonOpTys = fromMaybe [] updJSONOpInpObjTysM - relInsInpObjTys = map TIInpObj $ catMaybes relInsInpObjs + relInsInpObjTys = map TIInpObj relInsInpObjs allTypes = relInsInpObjTys <> onConflictTypes <> jsonOpTys <> catMaybes [ TIInpObj <$> insInpObjM @@ -1064,22 +1066,13 @@ mkGCtxRole' tn insPermM selFldsM updColsM delPermM pkeyCols constraints allCols -- helper mkColFldMap ty = mapFromL ((ty,) . nameFromSelFld) . map Left - insCtxM = fst <$> insPermM insColsM = icColumns <$> insCtxM - insRelsM = (icRelations . fst) <$> insPermM -- insert input type insInpObjM = mkInsInp tn <$> insCtxM -- column fields used in insert input object insInpObjFldsM = mkColFldMap (mkInsInpTy tn) <$> insColsM -- relationship input objects - relInsInpObjs = maybe [] (map (mkRelInsInp tn <$>) ) $ - fmap toRelInfosM insRelsM - - toRelInfosM relMap = flip map (Map.toList relMap) $ - \(_, relIns) -> case relIns of - RINotInsertable _ -> Nothing - RIInsertable (n, ri) -> Just (ri, icUpsertAllowed n) - + relInsInpObjs = mkRelInsInps tn upsertAllowed -- update set input type updSetInpObjM = mkUpdSetInp tn <$> updColsM -- update increment input type @@ -1107,7 +1100,7 @@ mkGCtxRole' tn insPermM selFldsM updColsM delPermM pkeyCols constraints allCols -- mut resp obj mutRespObjM = - if isJust insPermM || isJust updColsM || isJust delPermM + if isJust insCtxM || isJust updColsM || isJust delPermM then Just $ mkMutRespObj tn $ isJust selFldsM else Nothing @@ -1130,7 +1123,7 @@ getRootFldsRole' -> [PGCol] -> [TableConstraint] -> FieldInfoMap - -> Maybe (InsCtx, [PGCol], [T.Text], Bool) -- insert perm + -> Maybe (InsCtx, [PGCol], [T.Text]) -- insert perm -> Maybe (S.BoolExp, Maybe Int, [T.Text]) -- select filter -> Maybe ([PGCol], S.BoolExp, [T.Text]) -- update filter -> Maybe (S.BoolExp, [T.Text]) -- delete filter @@ -1144,10 +1137,12 @@ getRootFldsRole' tn primCols constraints fields insM selM updM delM = , getPKeySelDet selM $ getColInfos primCols colInfos ] colInfos = fst $ validPartitionFieldInfoMap fields - getInsDet (insCtx, pCols, hdrs, isUpsertAllowed) = - ( OCInsert insCtx pCols hdrs - , Right $ mkInsMutFld tn constraints isUpsertAllowed - ) + getInsDet (insCtx, pCols, hdrs) = + let upsertAllowed = isUpsertAllowed constraints $ + icUpsertAllowed insCtx + in ( OCInsert insCtx pCols hdrs + , Right $ mkInsMutFld tn upsertAllowed + ) getUpdDet (updCols, updFltr, hdrs) = ( OCUpdate tn updFltr hdrs , Right $ mkUpdMutFld tn $ getColInfos updCols colInfos @@ -1213,7 +1208,7 @@ mkGCtxRole tableCache tn fields pCols constraints role permInfo = do insCtxM <- forM (_permIns permInfo) $ \insPerm -> do let tabSet = Set.singleton tn insCtx <- buildInsCtx tabSet role tn tableCache fields insPerm - return (insCtx, pCols, ipiRequiredHeaders insPerm, ipiAllowUpsert insPerm) + return (insCtx, pCols, ipiRequiredHeaders insPerm) let updColsM = filterColInfos . upiCols <$> _permUpd permInfo tyAgg = mkGCtxRole' tn (mkInsFlds <$> insCtxM) selFldsM updColsM (void $ _permDel permInfo) pColInfos constraints allCols @@ -1225,14 +1220,14 @@ mkGCtxRole tableCache tn fields pCols constraints role permInfo = do pColInfos = getColInfos pCols colInfos filterColInfos allowedSet = filter ((`Set.member` allowedSet) . pgiName) colInfos - mkInsFlds (insCtx, _, _, isUpsertAllowed) = (insCtx, isUpsertAllowed) + mkInsFlds (insCtx, _, _) = insCtx getRootFldsRole :: QualifiedTable -> [PGCol] -> [TableConstraint] -> FieldInfoMap - -> Maybe (InsCtx, [PGCol], [T.Text], Bool) -- insert perm + -> Maybe (InsCtx, [PGCol], [T.Text]) -- insert perm -> RolePermInfo -> RootFlds getRootFldsRole tn pCols constraints fields insM (RolePermInfo _ selM updM delM) = @@ -1256,7 +1251,7 @@ mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols m <- Map.traverseWithKey (mkGCtxRole tableCache tn fields pkeyCols validConstraints) rolePerms insCtxAdmin <- buildInsCtx (Set.singleton tn) adminRole tn tableCache fields $ InsPermInfo tn (S.BELit True) True [] [] - let adminCtx = mkGCtxRole' tn (Just (insCtxAdmin, True)) + let adminCtx = mkGCtxRole' tn (Just insCtxAdmin) (Just selFlds) (Just colInfos) (Just ()) pkeyColInfos validConstraints allCols return $ Map.insert adminRole (adminCtx, adminRootFlds insCtxAdmin) m @@ -1269,9 +1264,9 @@ mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols FIColumn pgColInfo -> Left pgColInfo FIRelationship relInfo -> Right (relInfo, noFilter, Nothing, isRelNullable fields relInfo) noFilter = S.BELit True - adminRootFlds ain = + adminRootFlds insCtx = getRootFldsRole' tn pkeyCols constraints fields - (Just (ain, pkeyCols, [], True)) (Just (noFilter, Nothing, [])) + (Just (insCtx, pkeyCols, [])) (Just (noFilter, Nothing, [])) (Just (allCols, noFilter, [])) (Just (noFilter, [])) mkScalarTyInfo :: PGColType -> ScalarTyInfo From 12544b2314499fd99de359f70e5670801657f52e Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Fri, 14 Sep 2018 20:03:39 +0530 Subject: [PATCH 05/12] generate relation insert input type only when insert permission is defined --- server/src-lib/Hasura/GraphQL/Schema.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index e1e2270b00f93..f6d26a888d5a9 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -1072,7 +1072,7 @@ mkGCtxRole' tn insCtxM selFldsM updColsM delPermM pkeyCols constraints allCols = -- column fields used in insert input object insInpObjFldsM = mkColFldMap (mkInsInpTy tn) <$> insColsM -- relationship input objects - relInsInpObjs = mkRelInsInps tn upsertAllowed + relInsInpObjs = maybe [] (const $ mkRelInsInps tn upsertAllowed) insCtxM -- update set input type updSetInpObjM = mkUpdSetInp tn <$> updColsM -- update increment input type From 96967b260e6f2023dbb785408396851e90770f0d Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Mon, 17 Sep 2018 20:59:20 +0530 Subject: [PATCH 06/12] use global and per role insert context, all insert validation at one place --- server/src-lib/Hasura/GraphQL/Resolve.hs | 7 +- .../src-lib/Hasura/GraphQL/Resolve/Context.hs | 19 +- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 243 ++++++++++-------- server/src-lib/Hasura/GraphQL/Schema.hs | 179 ++++++------- 4 files changed, 233 insertions(+), 215 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 1a99e26573a90..c535f85a63081 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -31,7 +31,7 @@ import qualified Hasura.GraphQL.Resolve.Select as RS buildTx :: UserInfo -> GCtx -> Field -> Q.TxE QErr BL.ByteString buildTx userInfo gCtx fld = do opCxt <- getOpCtx $ _fName fld - join $ fmap fst $ runConvert (fldMap, orderByCtx) $ case opCxt of + join $ fmap fst $ runConvert (fldMap, orderByCtx, insCtxMap) $ case opCxt of OCSelect tn permFilter permLimit hdrs -> validateHdrs hdrs >> RS.convertSelect tn permFilter permLimit fld @@ -39,8 +39,8 @@ buildTx userInfo gCtx fld = do OCSelectPkey tn permFilter hdrs -> validateHdrs hdrs >> RS.convertSelectByPKey tn permFilter fld -- RS.convertSelect tn permFilter fld - OCInsert insCtx pCols hdrs -> - validateHdrs hdrs >> RI.convertInsert roleName insCtx pCols fld + OCInsert tn pCols hdrs -> + validateHdrs hdrs >> RI.convertInsert roleName tn pCols fld -- RM.convertInsert (tn, vn) cols fld OCUpdate tn permFilter hdrs -> validateHdrs hdrs >> RM.convertUpdate tn permFilter fld @@ -53,6 +53,7 @@ buildTx userInfo gCtx fld = do opCtxMap = _gOpCtxMap gCtx fldMap = _gFields gCtx orderByCtx = _gOrdByEnums gCtx + insCtxMap = _gInsCtxMap gCtx getOpCtx f = onNothing (Map.lookup f opCtxMap) $ throw500 $ diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs index b39fbbd3f9fa4..75cba5b145fc1 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs @@ -12,6 +12,9 @@ module Hasura.GraphQL.Resolve.Context , OrdByResolveCtxElem , NullsOrder(..) , OrdTy(..) + , RelationInfoMap + , InsCtx(..) + , InsCtxMap , RespTx , InsertTxConflictCtx(..) , getFldInfo @@ -76,6 +79,18 @@ type OrdByResolveCtxElem = (PGColInfo, OrdTy, NullsOrder) type OrdByResolveCtx = Map.HashMap (G.NamedType, G.EnumValue) OrdByResolveCtxElem +-- insert context +type RelationInfoMap = Map.HashMap RelName RelInfo + +data InsCtx + = InsCtx + { icView :: !QualifiedTable + , icColumns :: ![PGColInfo] + , icRelations :: !RelationInfoMap + } deriving (Show, Eq) + +type InsCtxMap = Map.HashMap QualifiedTable InsCtx + getFldInfo :: (MonadError QErr m, MonadReader r m, Has FieldMap r) => G.NamedType -> G.Name -> m (Either PGColInfo (RelInfo, S.BoolExp, Maybe Int, Bool)) @@ -136,7 +151,7 @@ withArgM args arg f = prependArgsInPath $ nameAsPath arg $ type PrepArgs = Seq.Seq Q.PrepArg type Convert = - StateT PrepArgs (ReaderT (FieldMap, OrdByResolveCtx) (Except QErr)) + StateT PrepArgs (ReaderT (FieldMap, OrdByResolveCtx, InsCtxMap) (Except QErr)) prepare :: (MonadState PrepArgs m) @@ -148,7 +163,7 @@ prepare (colTy, colVal) = do runConvert :: (MonadError QErr m) - => (FieldMap, OrdByResolveCtx) -> Convert a -> m (a, PrepArgs) + => (FieldMap, OrdByResolveCtx, InsCtxMap) -> Convert a -> m (a, PrepArgs) runConvert ctx m = either throwError return $ runExcept $ runReaderT (runStateT m Seq.empty) ctx diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index f647699ccabd5..8e8da909d9739 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} module Hasura.GraphQL.Resolve.Insert @@ -6,13 +7,15 @@ module Hasura.GraphQL.Resolve.Insert where import Data.Foldable (foldrM) +import Data.Has +import Data.List (intersect) import Hasura.Prelude import qualified Data.Aeson as J -import qualified Data.Text as T import qualified Data.ByteString.Builder as BB import qualified Data.HashMap.Strict as Map import qualified Data.Sequence as Seq +import qualified Data.Text as T import qualified Data.Vector as V import qualified Language.GraphQL.Draft.Syntax as G @@ -27,9 +30,8 @@ import qualified Hasura.SQL.DML as S import Hasura.GraphQL.Resolve.BoolExp import Hasura.GraphQL.Resolve.Context -import Hasura.GraphQL.Resolve.Mutation import Hasura.GraphQL.Resolve.InputValue -import Hasura.GraphQL.Schema +import Hasura.GraphQL.Resolve.Mutation import Hasura.GraphQL.Validate.Field import Hasura.GraphQL.Validate.Types import Hasura.RQL.Types @@ -137,148 +139,147 @@ fetchColsAndRels annObj = foldrM go ([], [], []) $ Map.toList annObj relObj _ -> throw500 "unexpected Array or Enum for input cols" -parentColValidation - :: MonadError QErr m - => QualifiedTable -- ^ parent table - -> RelName -- ^ object relation name - -> [PGCol] -- ^ parent insert columns - -> [(PGCol, PGCol)] -- ^ child object relation column mapping - -> m () -parentColValidation tn rn parentCols colMapping = - unless (null conflictingCols) $ throwVE $ - "inserting columns: " <> T.pack (show $ map getPGColTxt conflictingCols) - <> " into table " <> tn <<> " not allowed due to inserting " - <> "object relationship " <>> rn - where - conflictingCols = - flip filter parentCols $ \col -> col `elem` map fst colMapping - -arrayRelObjValidation - :: MonadError QErr m - => RelName -- ^ array relation name - -> AnnGObject -- ^ array relation inserting object - -> [(PGCol, PGCol)] -- ^ relation column mapping - -> m () -arrayRelObjValidation rn insObj colMapping = do - (insCols, _, _) <- fetchColsAndRels insObj - let cols = map _1 insCols - conflictingCols = - flip filter cols $ \col -> col `elem` map snd colMapping - unless (null conflictingCols) $ throwVE $ - "inserting columns " <> T.pack (show $ map getPGColTxt conflictingCols) - <> " into relationship " <> rn <<> " not allowed" - insertObjRel - :: QualifiedTable -- ^ parent table - -> [PGCol] -- ^ parent insert columns - -> RoleName - -> RelName - -> RelationInfoMap + :: RoleName + -> InsCtxMap + -> InsCtx + -> RelInfo -> ObjRelData -> Q.TxE QErr (Int, [(PGCol, PGColValue)]) -insertObjRel parentTab parentCols role relName relInfoMap relData = do - relIns <- onNothing (Map.lookup relName relInfoMap) $ throw500 $ - "relations " <> relName <<> " not found" - case relIns of - RINotInsertable reason -> throw400 NotSupported $ - "cannot insert with relation " <> relName <<> " due to " <> reason - RIInsertable (insCtx, relInfo) -> do - let mapCols = riMapping relInfo - tn = riRTable relInfo - -- validate parent inserting columns - parentColValidation parentTab relName parentCols mapCols - - let rCols = map snd mapCols - cs = icColumns insCtx - insCols = map (\(PGColInfo cn ty _) -> (cn, ty)) $ - getColInfos rCols cs - res <- processInsObj role insObj insCtx insCols onConflictM - let aRows = fst res - respColsM = snd res - respCols <- maybe (cannotInsObjRelErr tn) return respColsM - let c = mergeListsWith mapCols respCols - (\(_, rCol) (col, _) -> rCol == col) - (\(lCol, _) (_, colVal) -> (lCol, colVal)) - return (aRows, c) +insertObjRel role insCtxMap insCtx relInfo relData = do + let mapCols = riMapping relInfo + tn = riRTable relInfo + rCols = map snd mapCols + cs = icColumns insCtx + insCols = map (\(PGColInfo cn ty _) -> (cn, ty)) $ + getColInfos rCols cs + res <- processInsObj role insCtxMap tn insObj insCtx [] insCols onConflictM + let aRows = fst res + respColsM = snd res + respCols <- maybe (cannotInsObjRelErr tn) return respColsM + let c = mergeListsWith mapCols respCols + (\(_, rCol) (col, _) -> rCol == col) + (\(lCol, _) (_, colVal) -> (lCol, colVal)) + return (aRows, c) where + relName = riName relInfo RelData insObj onConflictM = relData cannotInsObjRelErr tn = throwVE $ "cannot insert object relation " <> relName <<> " since inserting into remote table " <> tn <<> " returns nothing" +processObjRel + :: (MonadError QErr m) + => InsCtxMap + -> [(RelName, ObjRelData)] + -> RelationInfoMap + -> m [(ObjRelData, InsCtx, RelInfo)] +processObjRel insCtxMap objRels relInfoMap = + forM objRels $ \(relName, rd) -> do + relInfo <- onNothing (Map.lookup relName relInfoMap) $ throw500 $ + "object relationship with name " <> relName <<> " not found" + let remoteTable = riRTable relInfo + insCtx <- getInsCtx insCtxMap remoteTable + return (rd, insCtx, relInfo) + -- | process array relation and return dependent columns, -- | relation data, insert context of remote table and relation info processArrRel :: (MonadError QErr m) - => [(RelName, ArrRelData)] + => InsCtxMap + -> [(RelName, ArrRelData)] -> RelationInfoMap -> m [([PGCol], ArrRelData, InsCtx, RelInfo)] -processArrRel arrRels relInfoMap = +processArrRel insCtxMap arrRels relInfoMap = forM arrRels $ \(relName, rd) -> do - relIns <- onNothing (Map.lookup relName relInfoMap) $ throw500 $ + relInfo <- onNothing (Map.lookup relName relInfoMap) $ throw500 $ "relation with name " <> relName <<> " not found" - case relIns of - RINotInsertable reason -> throw400 NotSupported $ - "cannot insert array relation " <> relName <<> " due to " <> reason - RIInsertable (insCtx, ri) -> do - let depCols = map fst $ riMapping ri - return (depCols, rd, insCtx, ri) + let depCols = map fst $ riMapping relInfo + remoteTable = riRTable relInfo + insCtx <- getInsCtx insCtxMap remoteTable + return (depCols, rd, insCtx, relInfo) insertArrRel :: RoleName + -> InsCtxMap -> InsCtx -> RelInfo -> [PGColWithValue] - -> RelData [AnnGObject] + -> ArrRelData -> Q.TxE QErr Int -insertArrRel role insCtx relInfo resCols relData = do - let iObjCols = mergeListsWith resCols colMapping +insertArrRel role insCtxMap insCtx relInfo resCols relData = do + let addCols = mergeListsWith resCols colMapping (\(col, _) (lCol, _) -> col == lCol) (\(_, colVal) (_, rCol) -> (rCol, colVal)) - rTableInfos = icColumns insCtx - iObj = Map.fromList $ mergeListsWith iObjCols rTableInfos - (\(c, _) ci -> c == pgiName ci) - (\(c, v) ci -> ( G.Name $ getPGColTxt c - , pgColValToAnnGVal (pgiType ci) v - ) - ) - res <- forM insObjs $ \annGObj -> do - -- validate array rel inserting columns - arrayRelObjValidation relName annGObj colMapping - let withParentObj = annGObj `Map.union` iObj - processInsObj role withParentObj insCtx [] onConflictM + res <- forM insObjs $ \annGObj -> + processInsObj role insCtxMap tn annGObj insCtx addCols [] onConflictM return $ sum $ map fst res where colMapping = riMapping relInfo - relName = riName relInfo + tn = riRTable relInfo RelData insObjs onConflictM = relData +validateInsert + :: (MonadError QErr m) + => [PGCol] -- ^ inserting columns + -> [RelInfo] -- ^ object relation inserts + -> [PGCol] -- ^ additional fields from parent + -> m () +validateInsert insCols objRels addCols = do + -- validate insertCols + unless (null insConflictCols) $ throwVE $ + "cannot insert " <> pgColsToText insConflictCols + <> " columns as their values are already being determined by parent insert" + + forM_ objRels $ \relInfo -> do + let lCols = map fst $ riMapping relInfo + relName = riName relInfo + lColConflicts = lCols `intersect` (addCols <> insCols) + unless (null lColConflicts) $ throwVE $ + "cannot insert object relation ship " <> relName + <<> " as " <> pgColsToText lColConflicts + <> " column values are already determined" + where + insConflictCols = insCols `intersect` addCols + pgColsToText cols = T.intercalate ", " $ map getPGColTxt cols + +mkPGColWithTypeAndVal :: [PGColInfo] -> [PGColWithValue] -> [(PGCol, PGColType, PGColValue)] +mkPGColWithTypeAndVal pgColInfos pgColWithVal = + mergeListsWith pgColInfos pgColWithVal + (\ci (c, _) -> pgiName ci == c) + (\ci (c, v) -> (c, pgiType ci, v)) + -- | insert a object with object and array relationships processInsObj :: RoleName + -> InsCtxMap + -> QualifiedTable -> AnnGObject -- ^ object to be inserted -> InsCtx -- ^ required insert context + -> [PGColWithValue] -- ^ additional fields -> [PGColWithType] -- ^ expected returning columns -> Maybe AnnGValue -- ^ on conflict context -> Q.TxE QErr (Int, Maybe [PGColWithValue]) -processInsObj role annObj ctx retCols onConflictM = do +processInsObj role insCtxMap tn annObj ctx addCols retCols onConflictM = do (cols, objRels, arrRels) <- fetchColsAndRels annObj - objInsRes <- forM objRels $ \(relName, relData) -> - insertObjRel tn (map _1 cols) role relName relInfoMap relData + processedObjRels <- processObjRel insCtxMap objRels relInfoMap + + validateInsert (map _1 cols) (map _3 processedObjRels) $ map fst addCols + + objInsRes <- forM processedObjRels $ \(relData, insCtx, relInfo) -> + insertObjRel role insCtxMap insCtx relInfo relData -- prepare final insert columns let objInsAffRows = sum $ map fst objInsRes - addInsCols = concatMap snd objInsRes - addColInfos = getColInfos (map fst addInsCols) tableColInfos - objInsCols = mergeListsWith addInsCols addColInfos - (\(col, _) colInfo -> col == pgiName colInfo) - (\(col, colVal) colInfo -> (col, pgiType colInfo, colVal)) - finalInsCols = map pgColToAnnGVal (cols <> objInsCols) + objRelDeterminedCols = concatMap snd objInsRes + objRelInsCols = mkPGColWithTypeAndVal tableColInfos objRelDeterminedCols + addInsCols = mkPGColWithTypeAndVal tableColInfos addCols + finalInsCols = map pgColToAnnGVal (cols <> objRelInsCols <> addInsCols) -- fetch array rel deps Cols - processedArrRels <- processArrRel arrRels relInfoMap + processedArrRels <- processArrRel insCtxMap arrRels relInfoMap -- prepare final returning columns let arrDepCols = concatMap (\(a, _, _, _) -> a) processedArrRels @@ -293,7 +294,7 @@ processInsObj role annObj ctx retCols onConflictM = do arrInsRes <- forM processedArrRels $ \(_, rd, insCtx, relInfo) -> do resCols <- maybe cannotInsArrRelErr return resColsM - insertArrRel role insCtx relInfo resCols rd + insertArrRel role insCtxMap insCtx relInfo resCols rd let retColsWithValM = flip fmap resColsM $ \resCols -> mergeListsWith retCols resCols @@ -303,7 +304,7 @@ processInsObj role annObj ctx retCols onConflictM = do return (insAffRows + objInsAffRows + arrInsAffRows, retColsWithValM) where - InsCtx (tn, vn) tableColInfos _ relInfoMap = ctx + InsCtx vn tableColInfos relInfoMap = ctx cannotInsArrRelErr = throwVE $ "cannot proceed to insert array relations since insert to " <> tn <<> " returns nothing" @@ -342,18 +343,32 @@ buildReturningResp tn pkeyColSeq annFlds = do let bsVector = V.fromList $ toList respList return $ BB.toLazyByteString $ RR.encodeJSONVector BB.lazyByteString bsVector -convertInsert +getInsCtxMap + :: (Has InsCtxMap r, MonadReader r m) + => m InsCtxMap +getInsCtxMap = asks getter + +getInsCtx + :: MonadError QErr m + => InsCtxMap -> QualifiedTable -> m InsCtx +getInsCtx ctxMap tn = + onNothing (Map.lookup tn ctxMap) $ throw500 $ "table " <> tn <<> " not found" + +convertInsert' :: RoleName - -> InsCtx -- the insert context - -> [PGCol] -- primary key columns - -> Field -- the mutation field + -> QualifiedTable + -> InsCtxMap + -> InsCtx + -> [PGCol] + -> Field -> Convert RespTx -convertInsert role insCtx@(InsCtx (tn, _) tableColInfos _ _) pCols fld = do +convertInsert' role tn insCtxMap insCtx pCols fld = do annVals <- withArg arguments "objects" asArray annObjs <- forM annVals asObject mutFlds <- convertMutResp tn (_fType fld) $ _fSelSet fld return $ buildInsertTx annObjs mutFlds where + InsCtx _ tableColInfos _ = insCtx arguments = _fArguments fld onConflictM = Map.lookup "on_conflict" arguments -- consider all table columns if no primary key columns present @@ -364,7 +379,8 @@ convertInsert role insCtx@(InsCtx (tn, _) tableColInfos _ _) pCols fld = do buildInsertTx annObjs mutFlds = do insResps <- forM annObjs $ \obj -> do - (affRows, retColValsM) <- processInsObj role obj insCtx reqRetCols onConflictM + (affRows, retColValsM) <- + processInsObj role insCtxMap tn obj insCtx [] reqRetCols onConflictM let retCols = flip fmap retColValsM $ \retColsVals -> mergeListsWith tableColInfos retColsVals (\ci (c, _) -> pgiName ci == c) @@ -386,6 +402,18 @@ convertInsert role insCtx@(InsCtx (tn, _) tableColInfos _ _) pCols fld = do return (t, jsonVal) return $ J.encode $ Map.fromList respTups + +convertInsert + :: RoleName + -> QualifiedTable -- table + -> [PGCol] -- primary key columns + -> Field -- the mutation field + -> Convert RespTx +convertInsert role tn pCols fld = do + insCtxMap <- getInsCtxMap + insCtx <- getInsCtx insCtxMap tn + convertInsert' role tn insCtxMap insCtx pCols fld + -- helper functions mergeListsWith :: [a] -> [b] -> (a -> b -> Bool) -> (a -> b -> c) -> [c] @@ -397,3 +425,6 @@ mergeListsWith (x:xs) l b f = case find (b x) l of _1 :: (a, b, c) -> a _1 (x, _, _) = x + +_3 :: (a, b, c) -> c +_3 (_, _, z) = z diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index f6d26a888d5a9..47569a12f7640 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -18,8 +18,8 @@ module Hasura.GraphQL.Schema , OrdByResolveCtxElem , NullsOrder(..) , OrdTy(..) - , RelInsert(..) , InsCtx(..) + , InsCtxMap , RelationInfoMap ) where @@ -44,21 +44,6 @@ import qualified Hasura.SQL.DML as S defaultTypes :: [TypeInfo] defaultTypes = $(fromSchemaDocQ defaultSchema) -data RelInsert - = RIInsertable !(InsCtx, RelInfo) - | RINotInsertable !T.Text - deriving (Show, Eq) - -type RelationInfoMap = Map.HashMap RelName RelInsert - -data InsCtx - = InsCtx - { icTableAndView :: !(QualifiedTable, QualifiedTable) - , icColumns :: ![PGColInfo] - , icUpsertAllowed :: !Bool - , icRelations :: !RelationInfoMap - } deriving (Show, Eq) - getInsPerm :: TableInfo -> RoleName -> Maybe InsPermInfo getInsPerm tabInfo role | role == adminRole = _permIns $ mkAdminRolePermInfo tabInfo @@ -73,51 +58,11 @@ getTabInfo tc t = onNothing (Map.lookup t tc) $ throw500 $ "table not found: " <>> t -buildInsCtx - :: (MonadError QErr m) - => Set.HashSet QualifiedTable - -> RoleName - -> QualifiedTable - -> TableCache - -> FieldInfoMap - -> InsPermInfo - -> m InsCtx -buildInsCtx procTabs role tn tc fim insPerm = do - relFlds <- forM rels f - let relsMap = Map.fromList relFlds - return $ InsCtx (tn, vn) cols upsertAllowed relsMap - where - vn = ipiView insPerm - cols = getCols fim - rels = getRels fim - upsertAllowed = ipiAllowUpsert insPerm - - f relInfo = do - let remoteTab = riRTable relInfo - relName = riName relInfo - insertable = not $ Set.member remoteTab procTabs - if not insertable then - return ( relName - , RINotInsertable $ "table " <> remoteTab <<> " is already being inserted" - ) - else do - ti <- getTabInfo tc remoteTab - let fld = tiFieldInfoMap ti - mInsPerm = getInsPerm ti role - addTabl = Set.insert remoteTab procTabs - insCtxM <- forM mInsPerm $ buildInsCtx addTabl role remoteTab tc fld - return $ maybe ( relName - , RINotInsertable $ "insert permission not found for table " - <> remoteTab <<> " for role " <>> role - ) - (\insCtx -> (relName, RIInsertable (insCtx, relInfo))) - insCtxM - type OpCtxMap = Map.HashMap G.Name OpCtx data OpCtx - -- insert context, primary key cols, req hdrs - = OCInsert InsCtx [PGCol] [T.Text] + -- table, primary key cols, req hdrs + = OCInsert QualifiedTable [PGCol] [T.Text] -- tn, filter exp, limit, req hdrs | OCSelect QualifiedTable S.BoolExp (Maybe Int) [T.Text] -- tn, filter exp, reqt hdrs @@ -137,6 +82,7 @@ data GCtx , _gMutRoot :: !(Maybe ObjTyInfo) , _gSubRoot :: !(Maybe ObjTyInfo) , _gOpCtxMap :: !OpCtxMap + , _gInsCtxMap :: !InsCtxMap } deriving (Show, Eq) instance Has TypeMap GCtx where @@ -825,7 +771,7 @@ mkInsInp :: QualifiedTable -> InsCtx -> InpObjTyInfo mkInsInp tn insCtx = InpObjTyInfo (Just desc) (mkInsInpTy tn) $ fromInpValL $ - map mkPGColInp cols <> catMaybes relInps + map mkPGColInp cols <> relInps where desc = G.Description $ "input type for inserting data into table " <>> tn @@ -833,17 +779,14 @@ mkInsInp tn insCtx = relInfoMap = icRelations insCtx relInps = flip map (Map.toList relInfoMap) $ - \(rn, relIns) -> - case relIns of - RINotInsertable _ -> Nothing - RIInsertable (_, ri) -> - let rty = riType ri - remoteQT = riRTable ri - in Just $ case rty of - ObjRel -> InpValInfo Nothing (G.Name $ getRelTxt rn) $ - G.toGT $ mkObjInsInpTy remoteQT - ArrRel -> InpValInfo Nothing (G.Name $ getRelTxt rn) $ - G.toGT $ mkArrInsInpTy remoteQT + \(relName, relInfo) -> + let rty = riType relInfo + remoteQT = riRTable relInfo + in case rty of + ObjRel -> InpValInfo Nothing (G.Name $ getRelTxt relName) $ + G.toGT $ mkObjInsInpTy remoteQT + ArrRel -> InpValInfo Nothing (G.Name $ getRelTxt relName) $ + G.toGT $ mkArrInsInpTy remoteQT {- @@ -1017,8 +960,8 @@ mkOnConflictTypes tn c cols = bool [] tyInfos mkGCtxRole' :: QualifiedTable - -- insert context - -> Maybe InsCtx + -- insert perm + -> Maybe (InsCtx, Bool) -- select permission -> Maybe [SelField] -- update cols @@ -1032,12 +975,12 @@ mkGCtxRole' -- all columns -> [PGCol] -> TyAgg -mkGCtxRole' tn insCtxM selFldsM updColsM delPermM pkeyCols constraints allCols = +mkGCtxRole' tn insPermM selFldsM updColsM delPermM pkeyCols constraints allCols = TyAgg (mkTyInfoMap allTypes) fieldMap ordByEnums where - upsertPerm = or $ fmap icUpsertAllowed insCtxM + upsertPerm = or $ fmap snd insPermM upsertAllowed = isUpsertAllowed constraints upsertPerm ordByEnums = fromMaybe Map.empty ordByResCtxM onConflictTypes = mkOnConflictTypes tn constraints allCols upsertAllowed @@ -1066,6 +1009,7 @@ mkGCtxRole' tn insCtxM selFldsM updColsM delPermM pkeyCols constraints allCols = -- helper mkColFldMap ty = mapFromL ((ty,) . nameFromSelFld) . map Left + insCtxM = fst <$> insPermM insColsM = icColumns <$> insCtxM -- insert input type insInpObjM = mkInsInp tn <$> insCtxM @@ -1123,7 +1067,7 @@ getRootFldsRole' -> [PGCol] -> [TableConstraint] -> FieldInfoMap - -> Maybe (InsCtx, [PGCol], [T.Text]) -- insert perm + -> Maybe ([T.Text], Bool) -- insert perm -> Maybe (S.BoolExp, Maybe Int, [T.Text]) -- select filter -> Maybe ([PGCol], S.BoolExp, [T.Text]) -- update filter -> Maybe (S.BoolExp, [T.Text]) -- delete filter @@ -1137,10 +1081,9 @@ getRootFldsRole' tn primCols constraints fields insM selM updM delM = , getPKeySelDet selM $ getColInfos primCols colInfos ] colInfos = fst $ validPartitionFieldInfoMap fields - getInsDet (insCtx, pCols, hdrs) = - let upsertAllowed = isUpsertAllowed constraints $ - icUpsertAllowed insCtx - in ( OCInsert insCtx pCols hdrs + getInsDet (hdrs, upsertPerm) = + let upsertAllowed = isUpsertAllowed constraints upsertPerm + in ( OCInsert tn primCols hdrs , Right $ mkInsMutFld tn upsertAllowed ) getUpdDet (updCols, updFltr, hdrs) = @@ -1193,6 +1136,34 @@ getSelFlds tableCache fields role selPermInfo = where allowedCols = spiCols selPermInfo +mkInsCtx + :: MonadError QErr m + => RoleName + -> TableCache -> FieldInfoMap -> InsPermInfo -> m InsCtx +mkInsCtx role tableCache fields insPermInfo = do + relTupsM <- forM rels $ \relInfo -> do + let remoteTable = riRTable relInfo + relName = riName relInfo + remoteTableInfo <- getTabInfo tableCache remoteTable + case getInsPerm remoteTableInfo role of + Nothing -> return Nothing + Just _ -> return $ Just (relName, relInfo) + + let relInfoMap = Map.fromList $ catMaybes relTupsM + return $ InsCtx iView cols relInfoMap + where + cols = getCols fields + rels = getRels fields + iView = ipiView insPermInfo + +mkAdminInsCtx :: QualifiedTable -> FieldInfoMap -> InsCtx +mkAdminInsCtx tn fields = + InsCtx tn cols relInfoMap + where + relInfoMap = mapFromL riName rels + cols = getCols fields + rels = getRels fields + mkGCtxRole :: (MonadError QErr m) => TableCache @@ -1202,39 +1173,38 @@ mkGCtxRole -> [TableConstraint] -> RoleName -> RolePermInfo - -> m (TyAgg, RootFlds) + -> m (TyAgg, RootFlds, InsCtxMap) mkGCtxRole tableCache tn fields pCols constraints role permInfo = do selFldsM <- mapM (getSelFlds tableCache fields role) $ _permSel permInfo - insCtxM <- forM (_permIns permInfo) $ \insPerm -> do - let tabSet = Set.singleton tn - insCtx <- buildInsCtx tabSet role tn tableCache fields insPerm - return (insCtx, pCols, ipiRequiredHeaders insPerm) + tabInsCtxM <- forM (_permIns permInfo) $ \ipi -> do + tic <- mkInsCtx role tableCache fields ipi + return (tic, ipiAllowUpsert ipi) let updColsM = filterColInfos . upiCols <$> _permUpd permInfo - tyAgg = mkGCtxRole' tn (mkInsFlds <$> insCtxM) selFldsM updColsM + tyAgg = mkGCtxRole' tn tabInsCtxM selFldsM updColsM (void $ _permDel permInfo) pColInfos constraints allCols - rootFlds = getRootFldsRole tn pCols constraints fields insCtxM permInfo - return (tyAgg, rootFlds) + rootFlds = getRootFldsRole tn pCols constraints fields permInfo + insCtxMap = maybe Map.empty (Map.singleton tn) $ fmap fst tabInsCtxM + return (tyAgg, rootFlds, insCtxMap) where colInfos = fst $ validPartitionFieldInfoMap fields allCols = map pgiName colInfos pColInfos = getColInfos pCols colInfos filterColInfos allowedSet = filter ((`Set.member` allowedSet) . pgiName) colInfos - mkInsFlds (insCtx, _, _) = insCtx getRootFldsRole :: QualifiedTable -> [PGCol] -> [TableConstraint] -> FieldInfoMap - -> Maybe (InsCtx, [PGCol], [T.Text]) -- insert perm -> RolePermInfo -> RootFlds -getRootFldsRole tn pCols constraints fields insM (RolePermInfo _ selM updM delM) = +getRootFldsRole tn pCols constraints fields (RolePermInfo insM selM updM delM) = getRootFldsRole' tn pCols constraints fields - insM (mkSel <$> selM) + (mkIns <$> insM) (mkSel <$> selM) (mkUpd <$> updM) (mkDel <$> delM) where + mkIns i = (ipiRequiredHeaders i, ipiAllowUpsert i) mkSel s = (spiFilter s, spiLimit s, spiRequiredHeaders s) mkUpd u = ( Set.toList $ upiCols u , upiFilter u @@ -1246,15 +1216,15 @@ mkGCtxMapTable :: (MonadError QErr m) => TableCache -> TableInfo - -> m (Map.HashMap RoleName (TyAgg, RootFlds)) + -> m (Map.HashMap RoleName (TyAgg, RootFlds, InsCtxMap)) mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols _) = do m <- Map.traverseWithKey (mkGCtxRole tableCache tn fields pkeyCols validConstraints) rolePerms - insCtxAdmin <- buildInsCtx (Set.singleton tn) adminRole - tn tableCache fields $ InsPermInfo tn (S.BELit True) True [] [] - let adminCtx = mkGCtxRole' tn (Just insCtxAdmin) + let adminInsCtx = mkAdminInsCtx tn fields + adminCtx = mkGCtxRole' tn (Just (adminInsCtx, True)) (Just selFlds) (Just colInfos) (Just ()) pkeyColInfos validConstraints allCols - return $ Map.insert adminRole (adminCtx, adminRootFlds insCtxAdmin) m + adminInsCtxMap = Map.singleton tn adminInsCtx + return $ Map.insert adminRole (adminCtx, adminRootFlds, adminInsCtxMap) m where validConstraints = mkValidConstraints constraints colInfos = fst $ validPartitionFieldInfoMap fields @@ -1264,9 +1234,9 @@ mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols FIColumn pgColInfo -> Left pgColInfo FIRelationship relInfo -> Right (relInfo, noFilter, Nothing, isRelNullable fields relInfo) noFilter = S.BELit True - adminRootFlds insCtx = + adminRootFlds = getRootFldsRole' tn pkeyCols constraints fields - (Just (insCtx, pkeyCols, [])) (Just (noFilter, Nothing, [])) + (Just ([], True)) (Just (noFilter, Nothing, [])) (Just (allCols, noFilter, [])) (Just (noFilter, [])) mkScalarTyInfo :: PGColType -> ScalarTyInfo @@ -1281,13 +1251,14 @@ mkGCtxMap tableCache = do typesMapL <- mapM (mkGCtxMapTable tableCache) $ filter tableFltr $ Map.elems tableCache let typesMap = foldr (Map.unionWith mappend) Map.empty typesMapL - return $ Map.map (uncurry mkGCtx) typesMap + return $ flip Map.map typesMap $ \(ty, flds, insCtxMap) -> + mkGCtx ty flds insCtxMap where tableFltr ti = not (tiSystemDefined ti) && isValidTableName (tiName ti) -mkGCtx :: TyAgg -> RootFlds -> GCtx -mkGCtx (TyAgg tyInfos fldInfos ordByEnums) (RootFlds flds) = +mkGCtx :: TyAgg -> RootFlds -> InsCtxMap -> GCtx +mkGCtx (TyAgg tyInfos fldInfos ordByEnums) (RootFlds flds) insCtxMap = let queryRoot = mkObjTyInfo (Just "query root") (G.NamedType "query_root") $ mapFromL _fiName (schemaFld:typeFld:qFlds) colTys = Set.toList $ Set.fromList $ map pgiType $ @@ -1301,8 +1272,8 @@ mkGCtx (TyAgg tyInfos fldInfos ordByEnums) (RootFlds flds) = ] <> scalarTys <> compTys <> defaultTypes -- for now subscription root is query root - in GCtx allTys fldInfos ordByEnums queryRoot mutRootM (Just queryRoot) $ - Map.map fst flds + in GCtx allTys fldInfos ordByEnums queryRoot mutRootM (Just queryRoot) + (Map.map fst flds) insCtxMap where mkMutRoot = @@ -1332,4 +1303,4 @@ mkGCtx (TyAgg tyInfos fldInfos ordByEnums) (RootFlds flds) = getGCtx :: RoleName -> Map.HashMap RoleName GCtx -> GCtx getGCtx rn = - fromMaybe (mkGCtx mempty mempty) . Map.lookup rn + fromMaybe (mkGCtx mempty mempty mempty) . Map.lookup rn From 5ae940a504d64cd41cb71c5b8b532f23039cdc03 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Tue, 18 Sep 2018 14:17:58 +0530 Subject: [PATCH 07/12] add py tests for nested mutations --- .../insert/nested/articles_with_author.yaml | 42 ++++++++++++++++ .../articles_with_author_author_id_fail.yaml | 44 ++++++++++++++++ .../insert/nested/author_with_articles.yaml | 40 +++++++++++++++ .../author_with_articles_author_id_fail.yaml | 33 ++++++++++++ .../graphql_mutation/insert/nested/setup.yaml | 50 +++++++++++++++++++ .../insert/nested/teardown.yaml | 18 +++++++ server/tests-py/test_graphql_mutations.py | 22 ++++++++ 7 files changed, 249 insertions(+) create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author_author_id_fail.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_author_id_fail.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/setup.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/teardown.yaml diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml new file mode 100644 index 0000000000000..ca17b32ae7e34 --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml @@ -0,0 +1,42 @@ +description: Insert article and it's author via nested mutation +url: /v1alpha1/graphql +status: 200 +query: + query: | + mutation article_author{ + insert_article( + objects: [ + { + title: "Article 1 by Author 2", + content: "Article content for Article 1 by Author 2", + is_published: true + author: { + data: { + name: "Author 2" + } + } + }, + { + title: "Article 1 by Author 3", + content: "Article content for Article 1 by Author 3", + is_published: true + author: { + data: { + name: "Author 3" + } + } + } + ] + ){ + affected_rows + returning{ + id + title + content + author{ + id + name + } + } + } + } diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author_author_id_fail.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author_author_id_fail.yaml new file mode 100644 index 0000000000000..98e47133a7a0f --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author_author_id_fail.yaml @@ -0,0 +1,44 @@ +description: Insert article and it's author via nested mutation (Error) +url: /v1alpha1/graphql +status: 400 +query: + query: | + mutation article_author{ + insert_article( + objects: [ + { + title: "Article by author 4", + content: "Article content for article by author 4", + is_published: true, + author_id: 4 + author: { + data: { + name: "Article 4" + } + } + }, + { + title: "Article by author 5", + content: "Article content for article by author 5", + is_published: true, + author_id: 5 + author: { + data: { + name: "Article 5" + } + } + } + ] + ){ + affected_rows + returning{ + id + title + content + author{ + id + name + } + } + } + } diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml new file mode 100644 index 0000000000000..75d45be0c4890 --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml @@ -0,0 +1,40 @@ +description: Insert author and it's articles via nested mutation +url: /v1alpha1/graphql +status: 200 +query: + query: | + mutation nested_author_insert { + insert_author( + objects: [ + { + name: "Author 1", + articles: { + data: [ + { + title: "Article 1 by Author 1", + content: "Content for Article 1 by Author 1", + is_published: false + }, + { + title: "Article 2 by Author 1", + content: "Content for Article 2 by Author 1", + is_published: false + } + ] + } + } + ] + ) { + affected_rows + returning { + id + name + articles { + id + title + content + is_published + } + } + } + } diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_author_id_fail.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_author_id_fail.yaml new file mode 100644 index 0000000000000..a3e3aec62064c --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_author_id_fail.yaml @@ -0,0 +1,33 @@ +description: Insert author and it's articles via nested mutation (Error) +url: /v1alpha1/graphql +status: 400 +query: + query: | + mutation nested_author_insert { + insert_author( + objects: [ + { + name: "Author 3", + articles: { + data: [ + { + title: "An article by author 3", + content: "Content for article by author 4", + is_published: false, + author_id: 3 + } + ] + } + } + ] + ) { + affected_rows + returning { + id + name + articles { + id + } + } + } + } diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/setup.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/setup.yaml new file mode 100644 index 0000000000000..4e71965be55dc --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/setup.yaml @@ -0,0 +1,50 @@ +type: bulk +args: + +#Author table +- type: run_sql + args: + sql: | + create table author( + id serial primary key, + name text unique, + is_registered boolean not null default false + ); +- type: track_table + args: + schema: public + name: author + +#Article table +- type: run_sql + args: + sql: | + CREATE TABLE article ( + id SERIAL PRIMARY KEY, + title TEXT, + content TEXT, + author_id INTEGER REFERENCES author(id), + is_published BOOLEAN, + published_on TIMESTAMP + ) +- type: track_table + args: + schema: public + name: article + +#Create relationships +- type: create_object_relationship + args: + table: article + name: author + using: + foreign_key_constraint_on: author_id + +- type: create_array_relationship + args: + table: author + name: articles + using: + foreign_key_constraint_on: + table: article + column: author_id diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/teardown.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/teardown.yaml new file mode 100644 index 0000000000000..c4e61d8e138ec --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/teardown.yaml @@ -0,0 +1,18 @@ +type: bulk +args: +#Drop relationship first +- type: drop_relationship + args: + relationship: articles + table: + schema: public + name: author + +- type: run_sql + args: + sql: | + drop table article +- type: run_sql + args: + sql: | + drop table author diff --git a/server/tests-py/test_graphql_mutations.py b/server/tests-py/test_graphql_mutations.py index d06ee183b2cf9..d57649b2b440d 100644 --- a/server/tests-py/test_graphql_mutations.py +++ b/server/tests-py/test_graphql_mutations.py @@ -112,6 +112,28 @@ def transact(self, request, hge_ctx): st_code, resp = hge_ctx.v1q_f(self.dir + '/teardown.yaml') assert st_code == 200, resp +class TestGraphqlNestedInserts(object): + + def test_author_with_articles(self, hge_ctx): + check_query_f(hge_ctx, self.dir + "/author_with_articles.yaml") + + def test_author_with_articles_author_id_fail(self, hge_ctx): + check_query_f(hge_ctx, self.dir + "/author_with_articles_author_id_fail.yaml") + + def test_articles_with_author(self, hge_ctx): + check_query_f(hge_ctx, self.dir + "/articles_with_author.yaml") + + def test_articles_with_author_author_id_fail(self, hge_ctx): + check_query_f(hge_ctx, self.dir + "/articles_with_author_author_id_fail.yaml") + + @pytest.fixture(autouse=True) + def transact(self, request, hge_ctx): + self.dir = "queries/graphql_mutation/insert/nested" + st_code, resp = hge_ctx.v1q_f(self.dir + '/setup.yaml') + assert st_code == 200, resp + yield + st_code, resp = hge_ctx.v1q_f(self.dir + '/teardown.yaml') + assert st_code == 200, resp class TestGraphqlUpdateBasic: From 616d6c0f4e5d338bbe888e42f4b173f4360b55e4 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Tue, 25 Sep 2018 19:21:13 +0530 Subject: [PATCH 08/12] do not use primary key columns for selecting returning data -> if no relations given, insert all objects at one go -> if no array relations to insert, generate with expression as normal insert, else insert object and generate with expression as select from table using array relation left cols values in where expression --- server/src-lib/Hasura/GraphQL/Resolve.hs | 4 +- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 284 ++++++++++-------- server/src-lib/Hasura/GraphQL/Schema.hs | 6 +- server/src-lib/Hasura/RQL/DML/Insert.hs | 20 +- server/src-lib/Hasura/RQL/Types.hs | 5 +- server/src-lib/Hasura/SQL/DML.hs | 8 +- server/src-lib/Hasura/SQL/Types.hs | 4 + 7 files changed, 198 insertions(+), 133 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index c535f85a63081..12f69a6cd00f7 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -39,8 +39,8 @@ buildTx userInfo gCtx fld = do OCSelectPkey tn permFilter hdrs -> validateHdrs hdrs >> RS.convertSelectByPKey tn permFilter fld -- RS.convertSelect tn permFilter fld - OCInsert tn pCols hdrs -> - validateHdrs hdrs >> RI.convertInsert roleName tn pCols fld + OCInsert tn hdrs -> + validateHdrs hdrs >> RI.convertInsert roleName tn fld -- RM.convertInsert (tn, vn) cols fld OCUpdate tn permFilter hdrs -> validateHdrs hdrs >> RM.convertUpdate tn permFilter fld diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index 8e8da909d9739..d4bed2b93cdfb 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -8,12 +8,13 @@ where import Data.Foldable (foldrM) import Data.Has -import Data.List (intersect) +import Data.List (intersect, union) import Hasura.Prelude import qualified Data.Aeson as J import qualified Data.ByteString.Builder as BB import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set import qualified Data.Sequence as Seq import qualified Data.Text as T import qualified Data.Vector as V @@ -34,6 +35,7 @@ import Hasura.GraphQL.Resolve.InputValue import Hasura.GraphQL.Resolve.Mutation import Hasura.GraphQL.Validate.Field import Hasura.GraphQL.Validate.Types +import Hasura.RQL.DML.Internal (dmlTxErrorHandler) import Hasura.RQL.Types import Hasura.SQL.Types import Hasura.SQL.Value @@ -50,6 +52,8 @@ type ArrRelData = RelData [AnnGObject] type PGColWithValue = (PGCol, PGColValue) type PGColWithType = (PGCol, PGColType) +type WithExp = (S.CTE, Seq.Seq Q.PrepArg) + parseRelObj :: MonadError QErr m => AnnGObject @@ -77,42 +81,26 @@ toSQLExps cols = let prepExp = fromMaybe (S.SEUnsafe "NULL") prepExpM return (c, prepExp) --- | insert a single row with returning expected columns -insertRow - :: (QualifiedTable, QualifiedTable) -- (table, view) - -> Maybe AnnGValue -- ^ conflict clause - -> [(PGCol, AnnGValue)] -- ^ inserting row columns with graphQL value - -> [PGCol] -- ^ all table columns - -> [PGColWithType] -- ^ expected returning columns - -> RoleName -- ^ role - -> Q.TxE QErr (Int, Maybe [PGColWithValue]) -- ^ -insertRow (tn, vn) onConflictValM insCols tableCols expectedCols role = do - (givenCols, args) <- flip runStateT Seq.Empty $ toSQLExps insCols - onConflictM <- forM onConflictValM $ parseOnConflict (map fst insCols) - let sqlExps = Map.elems $ Map.union (Map.fromList givenCols) defVals - p1Query = RI.InsertQueryP1 tn vn tableCols [sqlExps] onConflictM mutFlds - p1 = (p1Query, args) - res <- bool (RI.nonAdminInsert p1) (RI.insertP2 p1) $ isAdmin role - InsResp affRows respObjM <- decodeFromBS res - retColValuesM <- mapM mkRetColValues respObjM - return (affRows, retColValuesM) +mkSQLRow :: [PGCol] -> [(PGCol, S.SQLExp)] -> [S.SQLExp] +mkSQLRow tableCols withPGCol = + Map.elems $ Map.union (Map.fromList withPGCol) defVals where defVals = Map.fromList $ zip tableCols (repeat $ S.SEUnsafe "DEFAULT") - mutFlds = Map.fromList [ ("affected_rows", RR.MCount) - , ("response", RR.MRet selData) - ] - selData = RS.SelectData flds tn frmExpM (S.BELit True, Nothing) - Nothing [] Nothing Nothing True - frmExpM = Just $ S.FromExp $ pure $ - S.FIIden $ qualTableToAliasIden tn - flds = Map.fromList $ flip map expectedCols $ \(c, ty) -> - (fromPGCol c, RS.FCol (c, ty)) - mkRetColValues obj = forM expectedCols $ \(col, colty) -> do - val <- onNothing (Map.lookup (getPGColTxt col) obj) $ - throw500 $ "column " <> col <<> "not found in postgres returning" - pgColValue <- RB.pgValParser colty val - return (col, pgColValue) +mkInsertQ :: QualifiedTable + -> Maybe RI.ConflictClauseP1 -> [(PGCol, AnnGValue)] + -> [PGCol] -> RoleName + -> Q.TxE QErr WithExp +mkInsertQ vn onConflictM insCols tableCols role = do + (givenCols, args) <- flip runStateT Seq.Empty $ toSQLExps insCols + let sqlConflict = RI.toSQLConflict <$> onConflictM + sqlExps = mkSQLRow tableCols givenCols + sqlInsert = S.SQLInsert vn tableCols [sqlExps] sqlConflict $ Just S.returningStar + if isAdmin role then return (S.CTEInsert sqlInsert, args) + else do + ccM <- mapM RI.extractConflictCtx onConflictM + RI.setConflictCtx ccM + return (S.CTEInsert (sqlInsert{S.siConflict=Nothing}), args) -- | resolve a graphQL object to columns, object and array relations fetchColsAndRels @@ -147,27 +135,23 @@ insertObjRel -> ObjRelData -> Q.TxE QErr (Int, [(PGCol, PGColValue)]) insertObjRel role insCtxMap insCtx relInfo relData = do - let mapCols = riMapping relInfo - tn = riRTable relInfo - rCols = map snd mapCols - cs = icColumns insCtx - insCols = map (\(PGColInfo cn ty _) -> (cn, ty)) $ - getColInfos rCols cs - res <- processInsObj role insCtxMap tn insObj insCtx [] insCols onConflictM - let aRows = fst res - respColsM = snd res - respCols <- maybe (cannotInsObjRelErr tn) return respColsM - let c = mergeListsWith mapCols respCols + (aRows, withExp) <- processInsObj role insCtxMap tn insObj insCtx [] onConflictM + when (aRows == 0) $ throwVE $ "cannot proceed to insert object relation " + <> relName <<> " since insert to table " <> tn <<> " affects zero rows" + retColsWithVals <- insertAndRetCols tn withExp retCols + let c = mergeListsWith mapCols retColsWithVals (\(_, rCol) (col, _) -> rCol == col) (\(lCol, _) (_, colVal) -> (lCol, colVal)) return (aRows, c) where - relName = riName relInfo RelData insObj onConflictM = relData - cannotInsObjRelErr tn = throwVE $ - "cannot insert object relation " - <> relName <<> " since inserting into remote table " - <> tn <<> " returns nothing" + relName = riName relInfo + mapCols = riMapping relInfo + tn = riRTable relInfo + rCols = map snd mapCols + allCols = icColumns insCtx + retCols = map (\(PGColInfo cn ty _) -> (cn, ty)) $ + getColInfos rCols allCols processObjRel :: (MonadError QErr m) @@ -212,13 +196,16 @@ insertArrRel role insCtxMap insCtx relInfo resCols relData = do let addCols = mergeListsWith resCols colMapping (\(col, _) (lCol, _) -> col == lCol) (\(_, colVal) (_, rCol) -> (rCol, colVal)) - res <- forM insObjs $ \annGObj -> - processInsObj role insCtxMap tn annGObj insCtx addCols [] onConflictM - return $ sum $ map fst res + + resBS <- insertMultipleRows role insCtxMap tn insCtx insObjs addCols mutFlds onConflictM + resObj <- decodeFromBS resBS + onNothing (Map.lookup ("affected_rows" :: T.Text) resObj) $ + throw500 "affected_rows not returned in array rel insert" where colMapping = riMapping relInfo tn = riRTable relInfo RelData insObjs onConflictM = relData + mutFlds = Map.singleton "affected_rows" RR.MCount validateInsert :: (MonadError QErr m) @@ -258,10 +245,9 @@ processInsObj -> AnnGObject -- ^ object to be inserted -> InsCtx -- ^ required insert context -> [PGColWithValue] -- ^ additional fields - -> [PGColWithType] -- ^ expected returning columns -> Maybe AnnGValue -- ^ on conflict context - -> Q.TxE QErr (Int, Maybe [PGColWithValue]) -processInsObj role insCtxMap tn annObj ctx addCols retCols onConflictM = do + -> Q.TxE QErr (Int, WithExp) +processInsObj role insCtxMap tn annObj ctx addCols onConflictValM = do (cols, objRels, arrRels) <- fetchColsAndRels annObj processedObjRels <- processObjRel insCtxMap objRels relInfoMap @@ -286,28 +272,40 @@ processInsObj role insCtxMap tn annObj ctx addCols retCols onConflictM = do arrDepColsWithType = mergeListsWith arrDepCols tableColInfos (\c ci -> c == pgiName ci) (\c ci -> (c, pgiType ci)) - finalRetCols = retCols <> arrDepColsWithType - (insAffRows, resColsM) <- insertRow (tn, vn) onConflictM finalInsCols - (map pgiName tableColInfos) finalRetCols role + onConflictM <- forM onConflictValM $ parseOnConflict (map fst finalInsCols) + let anyRowsAffected = not $ or $ fmap RI.isDoNothing onConflictM + thisInsAffRows = bool 0 1 anyRowsAffected + preArrRelInsAffRows = objInsAffRows + thisInsAffRows + insQ <- mkInsertQ vn onConflictM finalInsCols (map pgiName tableColInfos) role - arrInsRes <- forM processedArrRels $ \(_, rd, insCtx, relInfo) -> do - resCols <- maybe cannotInsArrRelErr return resColsM - insertArrRel role insCtxMap insCtx relInfo resCols rd + let insertWithArrRels = cannotInsArrRelErr thisInsAffRows >> + withArrRels preArrRelInsAffRows insQ + arrDepColsWithType processedArrRels + insertWithoutArrRels = withNoArrRels preArrRelInsAffRows insQ - let retColsWithValM = flip fmap resColsM $ \resCols -> - mergeListsWith retCols resCols - (\(colA, _) (colB, _) -> colA == colB) - (\(col, _) (_, colVal) -> (col, colVal)) - arrInsAffRows = sum arrInsRes - return (insAffRows + objInsAffRows + arrInsAffRows, retColsWithValM) + bool insertWithArrRels insertWithoutArrRels $ null arrDepColsWithType where InsCtx vn tableColInfos relInfoMap = ctx - cannotInsArrRelErr = throwVE $ - "cannot proceed to insert array relations since insert to " - <> tn <<> " returns nothing" + + withNoArrRels affRows insQ = return (affRows, insQ) + + withArrRels affRows insQ arrDepColsWithType processedArrRels = do + arrDepColsWithVal <- insertAndRetCols tn insQ arrDepColsWithType + + arrInsARows <- forM processedArrRels $ \(_, rd, insCtx, relInfo) -> + insertArrRel role insCtxMap insCtx relInfo arrDepColsWithVal rd + + let totalAffRows = affRows + sum arrInsARows + + selQ <- mkSelQ tn tableColInfos arrDepColsWithVal + return (totalAffRows, selQ) + + cannotInsArrRelErr affRows = when (affRows == 0) $ throwVE $ + "cannot proceed to insert array relations since insert to table " + <> tn <<> " affects zero rows" mkBoolExp @@ -321,25 +319,63 @@ mkBoolExp tn colInfoVals = f ci@(PGColInfo _ colTy _) colVal = RB.AVCol ci [RB.OEVal $ RB.AEQ (colTy, colVal)] +mkSelQ :: QualifiedTable + -> [PGColInfo] -> [PGColWithValue] -> Q.TxE QErr WithExp +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 + } + + return (S.CTESelect sqlSel, args) + where + colWithInfos = mergeListsWith pgColsWithVal allColInfos + (\(c, _) ci -> c == pgiName ci) + (\(_, v) ci -> (ci, v)) + mkReturning :: QualifiedTable - -> [(PGColInfo, PGColValue)] + -> WithExp -> RS.AnnSelFlds -> Q.TxE QErr RespBody -mkReturning tn pkeyColVals annFlds = do - (whereExp, args) <- flip runStateT Seq.empty $ mkBoolExp tn pkeyColVals - let selData = RS.SelectData annFlds tn Nothing - (S.BELit True, Just whereExp) Nothing [] Nothing Nothing True - RS.selectP2 (selData, args) +mkReturning tn (withExp, args) annFlds = do + let selData = RS.SelectData annFlds tn frmExpM + (S.BELit True, Nothing) Nothing [] Nothing Nothing True + sqlSel = RS.mkSQLSelect selData + selWith = S.SelectWith [(alias, withExp)] sqlSel + sqlBuilder = toSQL selWith + runIdentity . Q.getRow + <$> Q.rawQE dmlTxErrorHandler (Q.fromBuilder sqlBuilder) (toList args) True + where + alias = S.Alias $ Iden $ snakeCaseTable tn <> "__rel_insert_result" + frmExpM = Just $ S.FromExp [S.FIIden $ toIden alias] + +insertAndRetCols + :: QualifiedTable + -> WithExp + -> [PGColWithType] + -> Q.TxE QErr [PGColWithValue] +insertAndRetCols tn withExp retCols = do + resBS <- mkReturning tn withExp annSelFlds + resObj <- decodeFromBS resBS + forM retCols $ \(col, colty) -> do + val <- onNothing (Map.lookup (getPGColTxt col) resObj) $ + throw500 $ "column " <> col <<> "not returned by postgres" + pgColVal <- RB.pgValParser colty val + return (col, pgColVal) + where + annSelFlds = Map.fromList $ flip map retCols $ \(c, ty) -> + (fromPGCol c, RS.FCol (c, ty)) buildReturningResp :: QualifiedTable - -> Seq.Seq [(PGColInfo, PGColValue)] + -> [WithExp] -> RS.AnnSelFlds -> Q.TxE QErr RespBody -buildReturningResp tn pkeyColSeq annFlds = do - respList <- forM pkeyColSeq $ \pkeyCols -> - mkReturning tn pkeyCols annFlds +buildReturningResp tn withExps annFlds = do + respList <- forM withExps $ \withExp -> + mkReturning tn withExp annFlds let bsVector = V.fromList $ toList respList return $ BB.toLazyByteString $ RR.encodeJSONVector BB.lazyByteString bsVector @@ -354,50 +390,56 @@ getInsCtx getInsCtx ctxMap tn = onNothing (Map.lookup tn ctxMap) $ throw500 $ "table " <> tn <<> " not found" -convertInsert' +insertMultipleRows :: RoleName - -> QualifiedTable -> InsCtxMap + -> QualifiedTable -> InsCtx - -> [PGCol] - -> Field - -> Convert RespTx -convertInsert' role tn insCtxMap insCtx pCols fld = do - annVals <- withArg arguments "objects" asArray - annObjs <- forM annVals asObject - mutFlds <- convertMutResp tn (_fType fld) $ _fSelSet fld - return $ buildInsertTx annObjs mutFlds + -> [AnnGObject] + -> [PGColWithValue] + -> RR.MutFlds + -> Maybe AnnGValue + -> Q.TxE QErr RespBody +insertMultipleRows role insCtxMap tn ctx insObjs addFlds mutFlds onConflictValM = do + + colsObjArrRels <- mapM fetchColsAndRels insObjs + let insCols = map _1 colsObjArrRels + insColNames = Set.toList $ Set.fromList $ + concatMap (map _1) insCols + allInsObjRels = concatMap _2 colsObjArrRels + allInsArrRels = concatMap _3 colsObjArrRels + + onConflictM <- forM onConflictValM $ parseOnConflict insColNames + bool withRelsInsert (withoutRelsInsert insCols onConflictM) + (null allInsArrRels && null allInsObjRels) + where - InsCtx _ tableColInfos _ = insCtx - arguments = _fArguments fld - onConflictM = Map.lookup "on_conflict" arguments - -- consider all table columns if no primary key columns present - pCols' = bool pCols (map pgiName tableColInfos) $ null pCols - reqRetCols = mergeListsWith pCols' tableColInfos - (\c ti -> c == pgiName ti) - (\c ti -> (c, pgiType ti)) - - buildInsertTx annObjs mutFlds = do - insResps <- forM annObjs $ \obj -> do - (affRows, retColValsM) <- - processInsObj role insCtxMap tn obj insCtx [] reqRetCols onConflictM - let retCols = flip fmap retColValsM $ \retColsVals -> - mergeListsWith tableColInfos retColsVals - (\ci (c, _) -> pgiName ci == c) - (\ci (_, v) -> (ci, v)) - return (affRows, retCols) + InsCtx vn tableColInfos _ = ctx + tableCols = map pgiName tableColInfos + + withoutRelsInsert insCols onConflictM = do + let withAddCols = flip map insCols $ union (mkPGColWithTypeAndVal tableColInfos addFlds) + (sqlRows, prepArgs) <- flip runStateT Seq.Empty $ do + rowsWithCol <- mapM (toSQLExps . map pgColToAnnGVal) withAddCols + return $ map (mkSQLRow tableCols) rowsWithCol + + let insQP1 = RI.InsertQueryP1 tn vn tableCols sqlRows onConflictM mutFlds + p1 = (insQP1, prepArgs) + bool (RI.nonAdminInsert p1) (RI.insertP2 p1) $ isAdmin role + + withRelsInsert = do + insResps <- forM insObjs $ \obj -> + processInsObj role insCtxMap tn obj ctx addFlds onConflictValM + let affRows = sum $ map fst insResps - pkeyColVals = map snd insResps - pkeyColValSeqM = Seq.fromList <$> sequence pkeyColVals + withExps = map snd insResps respTups <- forM (Map.toList mutFlds) $ \(t, mutFld) -> do jsonVal <- case mutFld of RR.MCount -> return $ J.toJSON affRows RR.MExp txt -> return $ J.toJSON txt RR.MRet selData -> do let annFlds = RS.sdFlds selData - bs <- maybe (return "[]") - (\pkeyColValSeq -> buildReturningResp tn pkeyColValSeq annFlds) - pkeyColValSeqM + bs <- buildReturningResp tn withExps annFlds decodeFromBS bs return (t, jsonVal) return $ J.encode $ Map.fromList respTups @@ -406,13 +448,18 @@ convertInsert' role tn insCtxMap insCtx pCols fld = do convertInsert :: RoleName -> QualifiedTable -- table - -> [PGCol] -- primary key columns -> Field -- the mutation field -> Convert RespTx -convertInsert role tn pCols fld = do +convertInsert role tn fld = do insCtxMap <- getInsCtxMap insCtx <- getInsCtx insCtxMap tn - convertInsert' role tn insCtxMap insCtx pCols fld + annVals <- withArg arguments "objects" asArray + annObjs <- forM annVals asObject + mutFlds <- convertMutResp tn (_fType fld) $ _fSelSet fld + return $ insertMultipleRows role insCtxMap tn insCtx annObjs [] mutFlds onConflictM + where + arguments = _fArguments fld + onConflictM = Map.lookup "on_conflict" arguments -- helper functions mergeListsWith @@ -426,5 +473,8 @@ mergeListsWith (x:xs) l b f = case find (b x) l of _1 :: (a, b, c) -> a _1 (x, _, _) = x +_2 :: (a, b, c) -> b +_2 (_, y, _) = y + _3 :: (a, b, c) -> c _3 (_, _, z) = z diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 47569a12f7640..de7734048696c 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -61,8 +61,8 @@ getTabInfo tc t = type OpCtxMap = Map.HashMap G.Name OpCtx data OpCtx - -- table, primary key cols, req hdrs - = OCInsert QualifiedTable [PGCol] [T.Text] + -- table, req hdrs + = OCInsert QualifiedTable [T.Text] -- tn, filter exp, limit, req hdrs | OCSelect QualifiedTable S.BoolExp (Maybe Int) [T.Text] -- tn, filter exp, reqt hdrs @@ -1083,7 +1083,7 @@ getRootFldsRole' tn primCols constraints fields insM selM updM delM = colInfos = fst $ validPartitionFieldInfoMap fields getInsDet (hdrs, upsertPerm) = let upsertAllowed = isUpsertAllowed constraints upsertPerm - in ( OCInsert tn primCols hdrs + in ( OCInsert tn hdrs , Right $ mkInsMutFld tn upsertAllowed ) getUpdDet (updCols, updFltr, hdrs) = diff --git a/server/src-lib/Hasura/RQL/DML/Insert.hs b/server/src-lib/Hasura/RQL/DML/Insert.hs index eeccba1be7fa9..4fbcef94c979c 100644 --- a/server/src-lib/Hasura/RQL/DML/Insert.hs +++ b/server/src-lib/Hasura/RQL/DML/Insert.hs @@ -36,6 +36,10 @@ data ConflictClauseP1 | CP1Update !ConflictTarget ![PGCol] deriving (Show, Eq) +isDoNothing :: ConflictClauseP1 -> Bool +isDoNothing (CP1DoNothing _) = True +isDoNothing _ = False + data InsertQueryP1 = InsertQueryP1 { iqp1Table :: !QualifiedTable @@ -51,14 +55,16 @@ mkSQLInsert (InsertQueryP1 tn vn cols vals c mutFlds) = mkSelWith tn (S.CTEInsert insert) mutFlds where insert = - S.SQLInsert vn cols vals (toSQLConflict c) $ Just S.returningStar - toSQLConflict conflict = case conflict of - Nothing -> Nothing - Just (CP1DoNothing Nothing) -> Just $ S.DoNothing Nothing - Just (CP1DoNothing (Just ct)) -> Just $ S.DoNothing $ Just $ toSQLCT ct - Just (CP1Update ct inpCols) -> Just $ S.Update (toSQLCT ct) - (S.buildSEWithExcluded inpCols) + S.SQLInsert vn cols vals (toSQLConflict <$> c) $ Just S.returningStar + +toSQLConflict :: ConflictClauseP1 -> S.SQLConflict +toSQLConflict conflict = case conflict of + (CP1DoNothing Nothing) -> S.DoNothing Nothing + (CP1DoNothing (Just ct)) -> S.DoNothing $ Just $ toSQLCT ct + (CP1Update ct inpCols) -> S.Update (toSQLCT ct) + (S.buildSEWithExcluded inpCols) + where toSQLCT ct = case ct of Column pgCols -> S.SQLColumn pgCols Constraint cn -> S.SQLConstraint cn diff --git a/server/src-lib/Hasura/RQL/Types.hs b/server/src-lib/Hasura/RQL/Types.hs index f6ea3d755016a..e6e819985e6bf 100644 --- a/server/src-lib/Hasura/RQL/Types.hs +++ b/server/src-lib/Hasura/RQL/Types.hs @@ -286,6 +286,5 @@ successMsg = "{\"message\":\"success\"}" type HeaderObj = M.HashMap T.Text T.Text qualTableToAliasIden :: QualifiedTable -> Iden -qualTableToAliasIden (QualifiedTable sn tn) = - Iden $ getSchemaTxt sn <> "_" <> getTableTxt tn - <> "__mutation_result_alias" +qualTableToAliasIden qt = + Iden $ snakeCaseTable qt <> "__mutation_result_alias" diff --git a/server/src-lib/Hasura/SQL/DML.hs b/server/src-lib/Hasura/SQL/DML.hs index aef43d2c2e795..d935f1a2871a8 100644 --- a/server/src-lib/Hasura/SQL/DML.hs +++ b/server/src-lib/Hasura/SQL/DML.hs @@ -269,6 +269,9 @@ newtype Alias instance ToSQL Alias where toSQL (Alias iden) = "AS" <-> toSQL iden +instance IsIden Alias where + toIden (Alias i) = i + instance ToSQL SQLExp where toSQL (SEPrep argNumber) = BB.char7 '$' <> BB.intDec argNumber @@ -541,8 +544,11 @@ instance ToSQL UsingExp where newtype RetExp = RetExp [Extractor] deriving (Show, Eq) +selectStar :: Extractor +selectStar = Extractor SEStar Nothing + returningStar :: RetExp -returningStar = RetExp [Extractor SEStar Nothing] +returningStar = RetExp [selectStar] instance ToSQL RetExp where toSQL (RetExp []) diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index 653b04184f5af..f0226095442b8 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -169,6 +169,10 @@ qualTableToTxt (QualifiedTable (SchemaName "public") tn) = qualTableToTxt (QualifiedTable sn tn) = getSchemaTxt sn <> "." <> getTableTxt tn +snakeCaseTable :: QualifiedTable -> T.Text +snakeCaseTable (QualifiedTable sn tn) = + getSchemaTxt sn <> "_" <> getTableTxt tn + newtype PGCol = PGCol { getPGColTxt :: T.Text } deriving (Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, ToJSONKey, FromJSONKey, Lift) From 238e73627fb270ddb4610e9bb1a21cb97b531b2a Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Wed, 26 Sep 2018 15:55:42 +0530 Subject: [PATCH 09/12] error path for insert mutations and few code refactors --- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 284 ++++++++++++------ .../Hasura/GraphQL/Resolve/Mutation.hs | 61 ---- .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 1 + .../address_check_constraint_error.yaml | 2 +- .../address_not_null_constraint_error.yaml | 2 +- .../author_unique_constraint_error.yaml | 2 +- .../basic/author_unique_constraint_error.yaml | 2 +- .../address_not_null_constraint_error.yaml | 2 +- 8 files changed, 200 insertions(+), 156 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index d4bed2b93cdfb..7acd234f7f7fb 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -33,6 +33,7 @@ import Hasura.GraphQL.Resolve.BoolExp import Hasura.GraphQL.Resolve.Context import Hasura.GraphQL.Resolve.InputValue import Hasura.GraphQL.Resolve.Mutation +import Hasura.GraphQL.Resolve.Select import Hasura.GraphQL.Validate.Field import Hasura.GraphQL.Validate.Types import Hasura.RQL.DML.Internal (dmlTxErrorHandler) @@ -54,24 +55,78 @@ type PGColWithType = (PGCol, PGColType) type WithExp = (S.CTE, Seq.Seq Q.PrepArg) +mkConflictClause :: RI.ConflictCtx -> RI.ConflictClauseP1 +mkConflictClause (RI.CCDoNothing constrM) = + RI.CP1DoNothing $ fmap RI.Constraint constrM +mkConflictClause (RI.CCUpdate constr updCols) = + RI.CP1Update (RI.Constraint constr) updCols + +parseAction + :: (MonadError QErr m) + => AnnGObject -> m (Maybe ConflictAction) +parseAction obj = withPathK "action" $ + mapM parseVal $ Map.lookup "action" obj + where + parseVal val = do + (enumTy, enumVal) <- asEnumVal val + case G.unName $ G.unEnumValue enumVal of + "ignore" -> return CAIgnore + "update" -> return CAUpdate + _ -> throw500 $ + "only \"ignore\" and \"updated\" allowed for enum type " + <> showNamedTy enumTy + +parseConstraint + :: (MonadError QErr m) + => AnnGObject -> m ConstraintName +parseConstraint obj = withPathK "constraint" $ do + v <- onNothing (Map.lookup "constraint" obj) $ throw500 + "\"constraint\" is expected, but not found" + parseVal v + where + parseVal v = do + (_, enumVal) <- asEnumVal v + return $ ConstraintName $ G.unName $ G.unEnumValue enumVal + +parseUpdCols + :: (MonadError QErr m) + => AnnGObject -> m (Maybe [PGCol]) +parseUpdCols obj = withPathK "update_columns" $ + mapM parseVal $ Map.lookup "update_columns" obj + where + parseVal val = flip withArray val $ \_ enumVals -> + forM enumVals $ \eVal -> do + (_, v) <- asEnumVal eVal + return $ PGCol $ G.unName $ G.unEnumValue v + +parseOnConflict + :: (MonadError QErr m) + => [PGCol] -> AnnGValue -> m RI.ConflictClauseP1 +parseOnConflict inpCols val = withPathK "on_conflict" $ + flip withObject val $ \_ obj -> do + actionM <- parseAction obj + constraint <- parseConstraint obj + updColsM <- parseUpdCols obj + -- consider "action" if "update_columns" is not mentioned + return $ mkConflictClause $ case (updColsM, actionM) of + (Just [], _) -> RI.CCDoNothing $ Just constraint + (Just cols, _) -> RI.CCUpdate constraint cols + (Nothing, Just CAIgnore) -> RI.CCDoNothing $ Just constraint + (Nothing, _) -> RI.CCUpdate constraint inpCols + parseRelObj :: MonadError QErr m => AnnGObject -> m (Either ObjRelData ArrRelData) parseRelObj annObj = do let conflictClauseM = Map.lookup "on_conflict" annObj - dataVal <- onNothing (Map.lookup "data" annObj) $ throw500 "data object not found" + dataVal <- onNothing (Map.lookup "data" annObj) $ throw500 "\"data\" object not found" case dataVal of AGObject _ (Just obj) -> return $ Left $ RelData obj conflictClauseM AGArray _ (Just vals) -> do objs <- forM vals asObject return $ Right $ RelData objs conflictClauseM - _ -> throw500 "unexpected type for data " - -pgColToAnnGVal - :: (PGCol, PGColType, PGColValue) - -> (PGCol, AnnGValue) -pgColToAnnGVal (col, colTy, colVal) = (col, pgColValToAnnGVal colTy colVal) + _ -> throw500 "unexpected type for \"data\"" toSQLExps :: (MonadError QErr m, MonadState PrepArgs m) => [(PGCol, AnnGValue)] -> m [(PGCol, S.SQLExp)] @@ -127,32 +182,8 @@ fetchColsAndRels annObj = foldrM go ([], [], []) $ Map.toList annObj relObj _ -> throw500 "unexpected Array or Enum for input cols" -insertObjRel - :: RoleName - -> InsCtxMap - -> InsCtx - -> RelInfo - -> ObjRelData - -> Q.TxE QErr (Int, [(PGCol, PGColValue)]) -insertObjRel role insCtxMap insCtx relInfo relData = do - (aRows, withExp) <- processInsObj role insCtxMap tn insObj insCtx [] onConflictM - when (aRows == 0) $ throwVE $ "cannot proceed to insert object relation " - <> relName <<> " since insert to table " <> tn <<> " affects zero rows" - retColsWithVals <- insertAndRetCols tn withExp retCols - let c = mergeListsWith mapCols retColsWithVals - (\(_, rCol) (col, _) -> rCol == col) - (\(lCol, _) (_, colVal) -> (lCol, colVal)) - return (aRows, c) - where - RelData insObj onConflictM = relData - relName = riName relInfo - mapCols = riMapping relInfo - tn = riRTable relInfo - rCols = map snd mapCols - allCols = icColumns insCtx - retCols = map (\(PGColInfo cn ty _) -> (cn, ty)) $ - getColInfos rCols allCols - +-- | process array relation and return relation data, insert context +-- | of remote table and relation info processObjRel :: (MonadError QErr m) => InsCtxMap @@ -160,7 +191,7 @@ processObjRel -> RelationInfoMap -> m [(ObjRelData, InsCtx, RelInfo)] processObjRel insCtxMap objRels relInfoMap = - forM objRels $ \(relName, rd) -> do + forM objRels $ \(relName, rd) -> withPathK (getRelTxt relName) $ do relInfo <- onNothing (Map.lookup relName relInfoMap) $ throw500 $ "object relationship with name " <> relName <<> " not found" let remoteTable = riRTable relInfo @@ -176,7 +207,7 @@ processArrRel -> RelationInfoMap -> m [([PGCol], ArrRelData, InsCtx, RelInfo)] processArrRel insCtxMap arrRels relInfoMap = - forM arrRels $ \(relName, rd) -> do + forM arrRels $ \(relName, rd) -> withPathK (getRelTxt relName) $ do relInfo <- onNothing (Map.lookup relName relInfoMap) $ throw500 $ "relation with name " <> relName <<> " not found" let depCols = map fst $ riMapping relInfo @@ -184,6 +215,38 @@ processArrRel insCtxMap arrRels relInfoMap = insCtx <- getInsCtx insCtxMap remoteTable return (depCols, rd, insCtx, relInfo) +-- | insert an object relationship and return affected rows +-- | and parent dependent columns +insertObjRel + :: RoleName + -> InsCtxMap + -> InsCtx + -> RelInfo + -> ObjRelData + -> Q.TxE QErr (Int, [(PGCol, PGColValue)]) +insertObjRel role insCtxMap insCtx relInfo relData = + withPathK relNameTxt $ do + (aRows, withExp) <- insertObj role insCtxMap tn insObj + insCtx [] onConflictM "data" + when (aRows == 0) $ throwVE $ "cannot proceed to insert object relation " + <> relName <<> " since insert to table " <> tn <<> " affects zero rows" + retColsWithVals <- insertAndRetCols tn withExp retCols + let c = mergeListsWith mapCols retColsWithVals + (\(_, rCol) (col, _) -> rCol == col) + (\(lCol, _) (_, colVal) -> (lCol, colVal)) + return (aRows, c) + where + RelData insObj onConflictM = relData + relName = riName relInfo + relNameTxt = getRelTxt relName + mapCols = riMapping relInfo + tn = riRTable relInfo + rCols = map snd mapCols + allCols = icColumns insCtx + retCols = map (\(PGColInfo cn ty _) -> (cn, ty)) $ + getColInfos rCols allCols + +-- | insert an array relationship and return affected rows insertArrRel :: RoleName -> InsCtxMap @@ -192,21 +255,26 @@ insertArrRel -> [PGColWithValue] -> ArrRelData -> Q.TxE QErr Int -insertArrRel role insCtxMap insCtx relInfo resCols relData = do - let addCols = mergeListsWith resCols colMapping - (\(col, _) (lCol, _) -> col == lCol) - (\(_, colVal) (_, rCol) -> (rCol, colVal)) - - resBS <- insertMultipleRows role insCtxMap tn insCtx insObjs addCols mutFlds onConflictM - resObj <- decodeFromBS resBS - onNothing (Map.lookup ("affected_rows" :: T.Text) resObj) $ - throw500 "affected_rows not returned in array rel insert" +insertArrRel role insCtxMap insCtx relInfo resCols relData = + withPathK relNameTxt $ do + let addCols = mergeListsWith resCols colMapping + (\(col, _) (lCol, _) -> col == lCol) + (\(_, colVal) (_, rCol) -> (rCol, colVal)) + + resBS <- insertMultipleObjects role insCtxMap tn insCtx + insObjs addCols mutFlds onConflictM "data" + resObj <- decodeFromBS resBS + onNothing (Map.lookup ("affected_rows" :: T.Text) resObj) $ + throw500 "affected_rows not returned in array rel insert" where colMapping = riMapping relInfo tn = riRTable relInfo + relNameTxt = getRelTxt $ riName relInfo RelData insObjs onConflictM = relData mutFlds = Map.singleton "affected_rows" RR.MCount +-- | validate an insert object based on insert columns, +-- | insert object relations and additional columns from parent validateInsert :: (MonadError QErr m) => [PGCol] -- ^ inserting columns @@ -222,8 +290,9 @@ validateInsert insCols objRels addCols = do forM_ objRels $ \relInfo -> do let lCols = map fst $ riMapping relInfo relName = riName relInfo + relNameTxt = getRelTxt relName lColConflicts = lCols `intersect` (addCols <> insCols) - unless (null lColConflicts) $ throwVE $ + withPathK relNameTxt $ unless (null lColConflicts) $ throwVE $ "cannot insert object relation ship " <> relName <<> " as " <> pgColsToText lColConflicts <> " column values are already determined" @@ -231,14 +300,8 @@ validateInsert insCols objRels addCols = do insConflictCols = insCols `intersect` addCols pgColsToText cols = T.intercalate ", " $ map getPGColTxt cols -mkPGColWithTypeAndVal :: [PGColInfo] -> [PGColWithValue] -> [(PGCol, PGColType, PGColValue)] -mkPGColWithTypeAndVal pgColInfos pgColWithVal = - mergeListsWith pgColInfos pgColWithVal - (\ci (c, _) -> pgiName ci == c) - (\ci (c, v) -> (c, pgiType ci, v)) - --- | insert a object with object and array relationships -processInsObj +-- | insert an object with object and array relationships +insertObj :: RoleName -> InsCtxMap -> QualifiedTable @@ -246,14 +309,18 @@ processInsObj -> InsCtx -- ^ required insert context -> [PGColWithValue] -- ^ additional fields -> Maybe AnnGValue -- ^ on conflict context + -> T.Text -- ^ error path -> Q.TxE QErr (Int, WithExp) -processInsObj role insCtxMap tn annObj ctx addCols onConflictValM = do - (cols, objRels, arrRels) <- fetchColsAndRels annObj +insertObj role insCtxMap tn annObj ctx addCols onConflictValM errP = do + -- get all insertable columns, object and array relations + (cols, objRels, arrRels) <- withErrPath $ fetchColsAndRels annObj processedObjRels <- processObjRel insCtxMap objRels relInfoMap + -- validate insert validateInsert (map _1 cols) (map _3 processedObjRels) $ map fst addCols + -- insert all object relations and fetch this insert dependent column values objInsRes <- forM processedObjRels $ \(relData, insCtx, relInfo) -> insertObjRel role insCtxMap insCtx relInfo relData @@ -274,10 +341,13 @@ processInsObj role insCtxMap tn annObj ctx addCols onConflictValM = do (\c ci -> (c, pgiType ci)) onConflictM <- forM onConflictValM $ parseOnConflict (map fst finalInsCols) + + -- calculate affected rows let anyRowsAffected = not $ or $ fmap RI.isDoNothing onConflictM thisInsAffRows = bool 0 1 anyRowsAffected preArrRelInsAffRows = objInsAffRows + thisInsAffRows + -- prepare insert query as with expression insQ <- mkInsertQ vn onConflictM finalInsCols (map pgiName tableColInfos) role let insertWithArrRels = cannotInsArrRelErr thisInsAffRows >> @@ -289,6 +359,7 @@ processInsObj role insCtxMap tn annObj ctx addCols onConflictValM = do where InsCtx vn tableColInfos relInfoMap = ctx + withErrPath = withPathK errP withNoArrRels affRows insQ = return (affRows, insQ) @@ -334,12 +405,12 @@ mkSelQ tn allColInfos pgColsWithVal = do (\(c, _) ci -> c == pgiName ci) (\(_, v) ci -> (ci, v)) -mkReturning +execWithExp :: QualifiedTable -> WithExp -> RS.AnnSelFlds -> Q.TxE QErr RespBody -mkReturning tn (withExp, args) annFlds = do +execWithExp tn (withExp, args) annFlds = do let selData = RS.SelectData annFlds tn frmExpM (S.BELit True, Nothing) Nothing [] Nothing Nothing True sqlSel = RS.mkSQLSelect selData @@ -357,7 +428,7 @@ insertAndRetCols -> [PGColWithType] -> Q.TxE QErr [PGColWithValue] insertAndRetCols tn withExp retCols = do - resBS <- mkReturning tn withExp annSelFlds + resBS <- execWithExp tn withExp annSelFlds resObj <- decodeFromBS resBS forM retCols $ \(col, colty) -> do val <- onNothing (Map.lookup (getPGColTxt col) resObj) $ @@ -375,50 +446,55 @@ buildReturningResp -> Q.TxE QErr RespBody buildReturningResp tn withExps annFlds = do respList <- forM withExps $ \withExp -> - mkReturning tn withExp annFlds + execWithExp tn withExp annFlds let bsVector = V.fromList $ toList respList return $ BB.toLazyByteString $ RR.encodeJSONVector BB.lazyByteString bsVector -getInsCtxMap - :: (Has InsCtxMap r, MonadReader r m) - => m InsCtxMap -getInsCtxMap = asks getter - -getInsCtx - :: MonadError QErr m - => InsCtxMap -> QualifiedTable -> m InsCtx -getInsCtx ctxMap tn = - onNothing (Map.lookup tn ctxMap) $ throw500 $ "table " <> tn <<> " not found" - -insertMultipleRows - :: RoleName - -> InsCtxMap - -> QualifiedTable - -> InsCtx - -> [AnnGObject] - -> [PGColWithValue] - -> RR.MutFlds - -> Maybe AnnGValue +-- | insert multiple Objects in postgres +insertMultipleObjects + :: RoleName -- ^ role name + -> InsCtxMap -- ^ insert context map + -> QualifiedTable -- ^ table + -> InsCtx -- ^ insert context + -> [AnnGObject] -- ^ objects to be inserted + -> [PGColWithValue] -- ^ additional fields + -> RR.MutFlds -- ^ returning fields + -> Maybe AnnGValue -- ^ On Conflict Clause + -> T.Text -- ^ error path -> Q.TxE QErr RespBody -insertMultipleRows role insCtxMap tn ctx insObjs addFlds mutFlds onConflictValM = do +insertMultipleObjects role insCtxMap tn ctx insObjs + addCols mutFlds onConflictValM errP + = do - colsObjArrRels <- mapM fetchColsAndRels insObjs + -- fetch insertable columns, object and array relationships + colsObjArrRels <- withErrPath $ indexedMapM fetchColsAndRels insObjs let insCols = map _1 colsObjArrRels insColNames = Set.toList $ Set.fromList $ concatMap (map _1) insCols allInsObjRels = concatMap _2 colsObjArrRels allInsArrRels = concatMap _3 colsObjArrRels + anyRelsToInsert = not $ null allInsArrRels && null allInsObjRels onConflictM <- forM onConflictValM $ parseOnConflict insColNames - bool withRelsInsert (withoutRelsInsert insCols onConflictM) - (null allInsArrRels && null allInsObjRels) + + let withoutRels = withoutRelsInsert insCols onConflictM + + bool withoutRels withRelsInsert anyRelsToInsert where InsCtx vn tableColInfos _ = ctx tableCols = map pgiName tableColInfos - withoutRelsInsert insCols onConflictM = do - let withAddCols = flip map insCols $ union (mkPGColWithTypeAndVal tableColInfos addFlds) + withErrPath = withPathK errP + + -- insert all column rows at one go + withoutRelsInsert insCols onConflictM = withErrPath $ do + indexedForM_ insCols $ \insCol -> + validateInsert (map _1 insCol) [] $ map fst addCols + + let addColsWithType = mkPGColWithTypeAndVal tableColInfos addCols + withAddCols = flip map insCols $ union addColsWithType + (sqlRows, prepArgs) <- flip runStateT Seq.Empty $ do rowsWithCol <- mapM (toSQLExps . map pgColToAnnGVal) withAddCols return $ map (mkSQLRow tableCols) rowsWithCol @@ -427,9 +503,10 @@ insertMultipleRows role insCtxMap tn ctx insObjs addFlds mutFlds onConflictValM p1 = (insQP1, prepArgs) bool (RI.nonAdminInsert p1) (RI.insertP2 p1) $ isAdmin role - withRelsInsert = do - insResps <- forM insObjs $ \obj -> - processInsObj role insCtxMap tn obj ctx addFlds onConflictValM + -- insert each object with relations + withRelsInsert = withErrPath $ do + insResps <- indexedForM insObjs $ \obj -> + insertObj role insCtxMap tn obj ctx addCols onConflictValM errP let affRows = sum $ map fst insResps withExps = map snd insResps @@ -444,24 +521,38 @@ insertMultipleRows role insCtxMap tn ctx insObjs addFlds mutFlds onConflictValM return (t, jsonVal) return $ J.encode $ Map.fromList respTups +prefixErrPath :: (MonadError QErr m) => Field -> m a -> m a +prefixErrPath fld = withPathK "selectionSet" . fieldAsPath fld convertInsert :: RoleName -> QualifiedTable -- table -> Field -- the mutation field -> Convert RespTx -convertInsert role tn fld = do +convertInsert role tn fld = prefixErrPath fld $ do insCtxMap <- getInsCtxMap insCtx <- getInsCtx insCtxMap tn annVals <- withArg arguments "objects" asArray annObjs <- forM annVals asObject mutFlds <- convertMutResp tn (_fType fld) $ _fSelSet fld - return $ insertMultipleRows role insCtxMap tn insCtx annObjs [] mutFlds onConflictM + return $ prefixErrPath fld $ insertMultipleObjects role insCtxMap tn + insCtx annObjs [] mutFlds onConflictM "objects" where arguments = _fArguments fld onConflictM = Map.lookup "on_conflict" arguments -- helper functions +getInsCtxMap + :: (Has InsCtxMap r, MonadReader r m) + => m InsCtxMap +getInsCtxMap = asks getter + +getInsCtx + :: MonadError QErr m + => InsCtxMap -> QualifiedTable -> m InsCtx +getInsCtx ctxMap tn = + onNothing (Map.lookup tn ctxMap) $ throw500 $ "table " <> tn <<> " not found" + mergeListsWith :: [a] -> [b] -> (a -> b -> Bool) -> (a -> b -> c) -> [c] mergeListsWith _ [] _ _ = [] @@ -470,6 +561,19 @@ mergeListsWith (x:xs) l b f = case find (b x) l of Nothing -> mergeListsWith xs l b f Just y -> f x y : mergeListsWith xs l b f +mkPGColWithTypeAndVal :: [PGColInfo] -> [PGColWithValue] + -> [(PGCol, PGColType, PGColValue)] +mkPGColWithTypeAndVal pgColInfos pgColWithVal = + mergeListsWith pgColInfos pgColWithVal + (\ci (c, _) -> pgiName ci == c) + (\ci (c, v) -> (c, pgiType ci, v)) + +pgColToAnnGVal + :: (PGCol, PGColType, PGColValue) + -> (PGCol, AnnGValue) +pgColToAnnGVal (col, colTy, colVal) = + (col, pgColValToAnnGVal colTy colVal) + _1 :: (a, b, c) -> a _1 (x, _, _) = x diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index d517efda6bff2..a8be42fc9b7e6 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -8,7 +8,6 @@ module Hasura.GraphQL.Resolve.Mutation ( convertUpdate , convertDelete , convertMutResp - , parseOnConflict ) where import Hasura.Prelude @@ -17,7 +16,6 @@ import qualified Data.HashMap.Strict as Map import qualified Language.GraphQL.Draft.Syntax as G import qualified Hasura.RQL.DML.Delete as RD -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.DML.Update as RU @@ -69,65 +67,6 @@ convertRowObj val = let prepExp = fromMaybe (S.SEUnsafe "NULL") prepExpM return (PGCol $ G.unName k, prepExp) -mkConflictClause :: RI.ConflictCtx -> RI.ConflictClauseP1 -mkConflictClause (RI.CCDoNothing constrM) = - RI.CP1DoNothing $ fmap RI.Constraint constrM -mkConflictClause (RI.CCUpdate constr updCols) = - RI.CP1Update (RI.Constraint constr) updCols - -parseAction - :: (MonadError QErr m) - => AnnGObject -> m (Maybe ConflictAction) -parseAction obj = - mapM parseVal $ Map.lookup "action" obj - where - parseVal val = do - (enumTy, enumVal) <- asEnumVal val - withPathK "action" $ case G.unName $ G.unEnumValue enumVal of - "ignore" -> return CAIgnore - "update" -> return CAUpdate - _ -> throw500 $ - "only \"ignore\" and \"updated\" allowed for enum type " - <> showNamedTy enumTy - -parseConstraint - :: (MonadError QErr m) - => AnnGObject -> m ConstraintName -parseConstraint obj = do - v <- onNothing (Map.lookup "constraint" obj) $ throw500 - "\"constraint\" is expected, but not found" - parseVal v - where - parseVal v = do - (_, enumVal) <- asEnumVal v - return $ ConstraintName $ G.unName $ G.unEnumValue enumVal - -parseUpdCols - :: (MonadError QErr m) - => AnnGObject -> m (Maybe [PGCol]) -parseUpdCols obj = - mapM parseVal $ Map.lookup "update_columns" obj - where - parseVal val = flip withArray val $ \_ enumVals -> - forM enumVals $ \eVal -> do - (_, v) <- asEnumVal eVal - return $ PGCol $ G.unName $ G.unEnumValue v - -parseOnConflict - :: (MonadError QErr m) - => [PGCol] -> AnnGValue -> m RI.ConflictClauseP1 -parseOnConflict inpCols val = - flip withObject val $ \_ obj -> do - actionM <- parseAction obj - constraint <- parseConstraint obj - updColsM <- parseUpdCols obj - -- consider "action" if "update_columns" is not mentioned - return $ mkConflictClause $ case (updColsM, actionM) of - (Just [], _) -> RI.CCDoNothing $ Just constraint - (Just cols, _) -> RI.CCUpdate constraint cols - (Nothing, Just CAIgnore) -> RI.CCDoNothing $ Just constraint - (Nothing, _) -> RI.CCUpdate constraint inpCols - type ApplySQLOp = (PGCol, S.SQLExp) -> S.SQLExp rhsExpOp :: S.SQLOp -> S.AnnType -> ApplySQLOp diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index fbb60a11005fa..bc59c00f89eac 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -9,6 +9,7 @@ module Hasura.GraphQL.Resolve.Select ( convertSelect , convertSelectByPKey , fromSelSet + , fieldAsPath ) where import Data.Has diff --git a/server/test/testcases/insert_mutation/address_check_constraint_error.yaml b/server/test/testcases/insert_mutation/address_check_constraint_error.yaml index 0c22915e3a5c2..6d1c1240ca191 100644 --- a/server/test/testcases/insert_mutation/address_check_constraint_error.yaml +++ b/server/test/testcases/insert_mutation/address_check_constraint_error.yaml @@ -12,6 +12,6 @@ query: } response: errors: - - path: $ + - path: $.selectionSet.insert_address.objects error: Check constraint violation. insert check constraint failed code: permission-error diff --git a/server/test/testcases/insert_mutation/address_not_null_constraint_error.yaml b/server/test/testcases/insert_mutation/address_not_null_constraint_error.yaml index 4f1e7dc3e9bbf..1a86bebe9e013 100644 --- a/server/test/testcases/insert_mutation/address_not_null_constraint_error.yaml +++ b/server/test/testcases/insert_mutation/address_not_null_constraint_error.yaml @@ -14,6 +14,6 @@ query: } response: errors: - - path: $ + - path: $.selectionSet.insert_address.objects error: "Not-NULL violation. null value in column \"door_no\" violates not-null constraint" code: constraint-violation diff --git a/server/test/testcases/insert_mutation/author_unique_constraint_error.yaml b/server/test/testcases/insert_mutation/author_unique_constraint_error.yaml index 2a6c59f7e1480..a0df23b2e03cc 100644 --- a/server/test/testcases/insert_mutation/author_unique_constraint_error.yaml +++ b/server/test/testcases/insert_mutation/author_unique_constraint_error.yaml @@ -14,6 +14,6 @@ query: } response: errors: - - path: $ + - path: $.selectionSet.insert_author.objects error: "Uniqueness violation. duplicate key value violates unique constraint \"author_name_key\"" code: constraint-violation diff --git a/server/tests-py/queries/graphql_mutation/insert/basic/author_unique_constraint_error.yaml b/server/tests-py/queries/graphql_mutation/insert/basic/author_unique_constraint_error.yaml index 189fa06091ebe..5d59b8081a45b 100644 --- a/server/tests-py/queries/graphql_mutation/insert/basic/author_unique_constraint_error.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/basic/author_unique_constraint_error.yaml @@ -22,6 +22,6 @@ query: } response: errors: - - path: $ + - path: $.selectionSet.insert_author.objects error: "Uniqueness violation. duplicate key value violates unique constraint \"author_name_key\"" code: constraint-violation diff --git a/server/tests-py/queries/graphql_mutation/insert/constraints/address_not_null_constraint_error.yaml b/server/tests-py/queries/graphql_mutation/insert/constraints/address_not_null_constraint_error.yaml index 4f1e7dc3e9bbf..1a86bebe9e013 100644 --- a/server/tests-py/queries/graphql_mutation/insert/constraints/address_not_null_constraint_error.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/constraints/address_not_null_constraint_error.yaml @@ -14,6 +14,6 @@ query: } response: errors: - - path: $ + - path: $.selectionSet.insert_address.objects error: "Not-NULL violation. null value in column \"door_no\" violates not-null constraint" code: constraint-violation From aa0c16e3acee5b724bc218d9d929451d22395f8a Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Wed, 26 Sep 2018 17:28:03 +0530 Subject: [PATCH 10/12] add 'args' in error path --- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 3 ++- .../address_check_constraint_error.yaml | 2 +- .../address_not_null_constraint_error.yaml | 2 +- .../author_unique_constraint_error.yaml | 2 +- .../basic/author_unique_constraint_error.yaml | 2 +- .../address_not_null_constraint_error.yaml | 2 +- .../insert/nested/articles_with_author.yaml | 18 ++++++++++++++++++ .../articles_with_author_author_id_fail.yaml | 6 ++++++ .../insert/nested/author_with_articles.yaml | 17 +++++++++++++++++ .../author_with_articles_author_id_fail.yaml | 5 +++++ 10 files changed, 53 insertions(+), 6 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index 7acd234f7f7fb..13ff8e8e00543 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -522,7 +522,8 @@ insertMultipleObjects role insCtxMap tn ctx insObjs return $ J.encode $ Map.fromList respTups prefixErrPath :: (MonadError QErr m) => Field -> m a -> m a -prefixErrPath fld = withPathK "selectionSet" . fieldAsPath fld +prefixErrPath fld = + withPathK "selectionSet" . fieldAsPath fld . withPathK "args" convertInsert :: RoleName diff --git a/server/test/testcases/insert_mutation/address_check_constraint_error.yaml b/server/test/testcases/insert_mutation/address_check_constraint_error.yaml index 6d1c1240ca191..28689d136cad3 100644 --- a/server/test/testcases/insert_mutation/address_check_constraint_error.yaml +++ b/server/test/testcases/insert_mutation/address_check_constraint_error.yaml @@ -12,6 +12,6 @@ query: } response: errors: - - path: $.selectionSet.insert_address.objects + - path: $.selectionSet.insert_address.args.objects error: Check constraint violation. insert check constraint failed code: permission-error diff --git a/server/test/testcases/insert_mutation/address_not_null_constraint_error.yaml b/server/test/testcases/insert_mutation/address_not_null_constraint_error.yaml index 1a86bebe9e013..c2e7cf5d35014 100644 --- a/server/test/testcases/insert_mutation/address_not_null_constraint_error.yaml +++ b/server/test/testcases/insert_mutation/address_not_null_constraint_error.yaml @@ -14,6 +14,6 @@ query: } response: errors: - - path: $.selectionSet.insert_address.objects + - path: $.selectionSet.insert_address.args.objects error: "Not-NULL violation. null value in column \"door_no\" violates not-null constraint" code: constraint-violation diff --git a/server/test/testcases/insert_mutation/author_unique_constraint_error.yaml b/server/test/testcases/insert_mutation/author_unique_constraint_error.yaml index a0df23b2e03cc..d420f7c658ea9 100644 --- a/server/test/testcases/insert_mutation/author_unique_constraint_error.yaml +++ b/server/test/testcases/insert_mutation/author_unique_constraint_error.yaml @@ -14,6 +14,6 @@ query: } response: errors: - - path: $.selectionSet.insert_author.objects + - path: $.selectionSet.insert_author.args.objects error: "Uniqueness violation. duplicate key value violates unique constraint \"author_name_key\"" code: constraint-violation diff --git a/server/tests-py/queries/graphql_mutation/insert/basic/author_unique_constraint_error.yaml b/server/tests-py/queries/graphql_mutation/insert/basic/author_unique_constraint_error.yaml index 5d59b8081a45b..2a7bf3d782e8f 100644 --- a/server/tests-py/queries/graphql_mutation/insert/basic/author_unique_constraint_error.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/basic/author_unique_constraint_error.yaml @@ -22,6 +22,6 @@ query: } response: errors: - - path: $.selectionSet.insert_author.objects + - path: $.selectionSet.insert_author.args.objects error: "Uniqueness violation. duplicate key value violates unique constraint \"author_name_key\"" code: constraint-violation diff --git a/server/tests-py/queries/graphql_mutation/insert/constraints/address_not_null_constraint_error.yaml b/server/tests-py/queries/graphql_mutation/insert/constraints/address_not_null_constraint_error.yaml index 1a86bebe9e013..c2e7cf5d35014 100644 --- a/server/tests-py/queries/graphql_mutation/insert/constraints/address_not_null_constraint_error.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/constraints/address_not_null_constraint_error.yaml @@ -14,6 +14,6 @@ query: } response: errors: - - path: $.selectionSet.insert_address.objects + - path: $.selectionSet.insert_address.args.objects error: "Not-NULL violation. null value in column \"door_no\" violates not-null constraint" code: constraint-violation diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml index ca17b32ae7e34..501945bfc9cac 100644 --- a/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml @@ -40,3 +40,21 @@ query: } } } + +response: + data: + insert_article: + affected_rows: 4 + returning: + - id: 1 + title: "Article 1 by Author 2" + content: "Article content for Article 1 by Author 2" + author: + id: 1 + name: Author 2 + - id: 2 + title: "Article 1 by Author 3" + content: "Article content for Article 1 by Author 3" + author: + id: 2 + name: Author 3 diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author_author_id_fail.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author_author_id_fail.yaml index 98e47133a7a0f..3c9c9e98050f1 100644 --- a/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author_author_id_fail.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author_author_id_fail.yaml @@ -42,3 +42,9 @@ query: } } } + +response: + errors: + - path: $.selectionSet.insert_article.args.objects[0].author + error: "cannot insert object relation ship \"author\" as author_id column values are already determined" + code: validation-failed diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml index 75d45be0c4890..32254116d9f3d 100644 --- a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml @@ -38,3 +38,20 @@ query: } } } + +response: + data: + insert_author: + affected_rows: 3 + returning: + - id: 1 + name: Author 1 + articles: + - id: 1 + title: "Article 1 by Author 1" + content: "Content for Article 1 by Author 1" + is_published: false + - id: 2 + title: "Article 2 by Author 1" + content: "Content for Article 2 by Author 1" + is_published: false diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_author_id_fail.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_author_id_fail.yaml index a3e3aec62064c..c5dd92a134e1c 100644 --- a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_author_id_fail.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_author_id_fail.yaml @@ -1,6 +1,11 @@ description: Insert author and it's articles via nested mutation (Error) url: /v1alpha1/graphql status: 400 +response: + errors: + - path: $.selectionSet.insert_author.args.objects[0].articles.data[0] + error: cannot insert author_id columns as their values are already being determined by parent insert + code: validation-failed query: query: | mutation nested_author_insert { From 8c3e3da13dd54016241ab5321e32d64362cf6fa8 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Wed, 26 Sep 2018 19:22:57 +0530 Subject: [PATCH 11/12] use `row_to_json` instead of `->0` operator for selecting as single obj --- server/src-lib/Hasura/RQL/DML/Select.hs | 19 ++++++++++--------- server/src-lib/Hasura/SQL/DML.hs | 13 ++----------- 2 files changed, 12 insertions(+), 20 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DML/Select.hs b/server/src-lib/Hasura/RQL/DML/Select.hs index fa25eaa5e4ab4..190e393b8e646 100644 --- a/server/src-lib/Hasura/RQL/DML/Select.hs +++ b/server/src-lib/Hasura/RQL/DML/Select.hs @@ -630,16 +630,19 @@ annRelColToSQL ar leftSel = -- in S.mkAliasedExtrFromExp (S.mkQIdenExp (TableName "r") rName) $ -- Just rName -wrapFinalSel :: S.Select -> [(FieldName, AnnFld)] -> S.Select -wrapFinalSel initSel extCols = +wrapFinalSel :: Bool -> S.Select -> [(FieldName, AnnFld)] -> S.Select +wrapFinalSel asSingleObj initSel extCols = S.mkSelect { S.selExtr = [S.Extractor rowToJSONedCol Nothing] , S.selFrom = Just $ S.FromExp [S.mkSelFromExp False initSel (TableName "r")] } where rowExp = S.mkRowExp $ map mkInnerSelExtr extCols - rowToJSONedCol = S.toEmptyArrWhenNull $ - S.SEFnApp "json_agg" [rowExp] Nothing + rowToJSONedCol = bool multiObjs singleObj asSingleObj + multiObjs = S.handleIfNull (S.SELit "[]") $ + S.SEFnApp "json_agg" [rowExp] Nothing + singleObj = S.handleIfNull (S.SELit "null") $ + S.SEFnApp "row_to_json" [rowExp] Nothing getSelectDeps :: SelectData @@ -672,12 +675,10 @@ getSelectDeps (SelectData flds tn _ (_, annWc) _ _ _ _ _) = mkSQLSelect :: SelectData -> S.Select mkSQLSelect selData = - bool finalSelect singleObjSel $ asSingleObject selData + wrapFinalSel isSingleObj sqlSel $ HM.toList $ sdFlds selData where - singleObjSel = S.selectAsSingleObj finalSelect - finalSelect = - wrapFinalSel (selDataToSQL [] (S.BELit True) selData) $ - HM.toList $ sdFlds selData + isSingleObj = asSingleObject selData + sqlSel = selDataToSQL [] (S.BELit True) selData -- convSelectQuery -- :: (P1C m) diff --git a/server/src-lib/Hasura/SQL/DML.hs b/server/src-lib/Hasura/SQL/DML.hs index d935f1a2871a8..758c202454d21 100644 --- a/server/src-lib/Hasura/SQL/DML.hs +++ b/server/src-lib/Hasura/SQL/DML.hs @@ -172,15 +172,6 @@ mkSIdenExp = SEIden . toIden mkQIdenExp :: (IsIden a, IsIden b) => a -> b -> SQLExp mkQIdenExp q t = SEQIden $ mkQIden q t -selectAsSingleObj :: Select -> Select -selectAsSingleObj s = mkSelect{selExtr = [extr]} - where - annSelect = SETyAnn (SESelect s) jsonType - withOp = mkSQLOpExp (SQLOp "->") annSelect (SEUnsafe "0") - nullE = SETyAnn (SELit "null") jsonType - handleNull = SEFnApp "coalesce" [withOp, nullE] Nothing - extr = Extractor handleNull Nothing - data Qual = QualIden !Iden | QualTable !QualifiedTable @@ -321,8 +312,8 @@ mkSQLOpExp -> SQLExp -- result mkSQLOpExp op lhs rhs = SEOpApp op [lhs, rhs] -toEmptyArrWhenNull :: SQLExp -> SQLExp -toEmptyArrWhenNull e = SEFnApp "coalesce" [e, SELit "[]"] Nothing +handleIfNull :: SQLExp -> SQLExp -> SQLExp +handleIfNull l e = SEFnApp "coalesce" [e, l] Nothing getExtrAlias :: Extractor -> Maybe Alias getExtrAlias (Extractor _ ma) = ma From 07f10ad39ea95495d16b518f6d29e6be37e6ae10 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Fri, 5 Oct 2018 18:08:09 +0530 Subject: [PATCH 12/12] fix insert array relations, add few more tests for nested insert --- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 21 +++++---- .../nested/articles_author_upsert_fail.yaml | 36 +++++++++++++++ .../insert/nested/articles_with_author.yaml | 20 +++++---- .../nested/author_upsert_articles_fail.yaml | 44 +++++++++++++++++++ .../insert/nested/author_with_articles.yaml | 3 ++ server/tests-py/test_graphql_mutations.py | 6 +++ 6 files changed, 114 insertions(+), 16 deletions(-) create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/articles_author_upsert_fail.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_articles_fail.yaml diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index 6b1b87e85d12e..ef6aa36451379 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -261,7 +261,7 @@ insertArrRel role insCtxMap insCtx relInfo resCols relData = (\(_, colVal) (_, rCol) -> (rCol, colVal)) resBS <- insertMultipleObjects role insCtxMap tn insCtx - insObjs addCols mutFlds onConflictM "data" + insObjs addCols mutFlds onConflictM True resObj <- decodeFromBS resBS onNothing (Map.lookup ("affected_rows" :: T.Text) resObj) $ throw500 "affected_rows not returned in array rel insert" @@ -444,7 +444,7 @@ buildReturningResp buildReturningResp tn withExps annFlds = do respList <- forM withExps $ \withExp -> execWithExp tn withExp annFlds - let bsVector = V.fromList $ toList respList + let bsVector = V.fromList respList return $ BB.toLazyByteString $ RR.encodeJSONVector BB.lazyByteString bsVector -- | insert multiple Objects in postgres @@ -457,10 +457,10 @@ insertMultipleObjects -> [PGColWithValue] -- ^ additional fields -> RR.MutFlds -- ^ returning fields -> Maybe AnnGValue -- ^ On Conflict Clause - -> T.Text -- ^ error path + -> Bool -- ^ is an Array relation -> Q.TxE QErr RespBody insertMultipleObjects role insCtxMap tn ctx insObjs - addCols mutFlds onConflictValM errP + addCols mutFlds onConflictValM isArrRel = do -- fetch insertable columns, object and array relationships @@ -482,6 +482,7 @@ insertMultipleObjects role insCtxMap tn ctx insObjs InsCtx vn tableColInfos _ = ctx tableCols = map pgiName tableColInfos + errP = bool "objects" "data" isArrRel withErrPath = withPathK errP -- insert all column rows at one go @@ -509,10 +510,14 @@ insertMultipleObjects role insCtxMap tn ctx insObjs withExps = map snd insResps respTups <- forM mutFlds $ \(t, mutFld) -> do jsonVal <- case mutFld of - RR.MCount -> return $ J.toJSON affRows + RR.MCount -> do + -- when it is a array relation perform insert + -- and return calculated affected rows + when isArrRel $ void $ buildReturningResp tn withExps [] + return $ J.toJSON affRows RR.MExp txt -> return $ J.toJSON txt - RR.MRet selData -> do - let annFlds = RS._asFields selData + RR.MRet annSel -> do + let annFlds = RS._asFields annSel bs <- buildReturningResp tn withExps annFlds decodeFromBS bs return (t, jsonVal) @@ -534,7 +539,7 @@ convertInsert role tn fld = prefixErrPath fld $ do annObjs <- forM annVals asObject mutFlds <- convertMutResp tn (_fType fld) $ _fSelSet fld return $ prefixErrPath fld $ insertMultipleObjects role insCtxMap tn - insCtx annObjs [] mutFlds onConflictM "objects" + insCtx annObjs [] mutFlds onConflictM False where arguments = _fArguments fld onConflictM = Map.lookup "on_conflict" arguments diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/articles_author_upsert_fail.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/articles_author_upsert_fail.yaml new file mode 100644 index 0000000000000..eb105bf71236d --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/articles_author_upsert_fail.yaml @@ -0,0 +1,36 @@ +description: Insert article while upserting (do nothing) it's author (Error) +url: /v1alpha1/graphql +status: 400 +query: + query: | + mutation article_author{ + insert_article( + objects: [ + { + title: "Article 1 by Author 2", + content: "Article content for Article 1 by Author 2", + is_published: true + author: { + data: { + name: "Author 2" + } + on_conflict: { + constraint: author_pkey, + update_columns: [] + } + } + } + ] + ){ + affected_rows + returning{ + id + title + content + author{ + id + name + } + } + } + } diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml index 501945bfc9cac..0059842406e71 100644 --- a/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/nested/articles_with_author.yaml @@ -7,21 +7,25 @@ query: insert_article( objects: [ { - title: "Article 1 by Author 2", + id: 3, + title: "Article 3 by Author 2", content: "Article content for Article 1 by Author 2", is_published: true author: { data: { + id: 2, name: "Author 2" } } }, { - title: "Article 1 by Author 3", + id: 4, + title: "Article 4 by Author 3", content: "Article content for Article 1 by Author 3", is_published: true author: { data: { + id: 3, name: "Author 3" } } @@ -46,15 +50,15 @@ response: insert_article: affected_rows: 4 returning: - - id: 1 - title: "Article 1 by Author 2" + - id: 3 + title: "Article 3 by Author 2" content: "Article content for Article 1 by Author 2" author: - id: 1 + id: 2 name: Author 2 - - id: 2 - title: "Article 1 by Author 3" + - id: 4 + title: "Article 4 by Author 3" content: "Article content for Article 1 by Author 3" author: - id: 2 + id: 3 name: Author 3 diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_articles_fail.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_articles_fail.yaml new file mode 100644 index 0000000000000..769dfb8df8b90 --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_articles_fail.yaml @@ -0,0 +1,44 @@ +description: Upsert author (do nothing) and it's articles (Error) +url: /v1alpha1/graphql +status: 400 +query: + query: | + mutation nested_author_insert { + insert_author( + objects: [ + { + name: "Author 1", + articles: { + data: [ + { + title: "Article 1 by Author 1", + content: "Content for Article 1 by Author 1", + is_published: false + }, + { + title: "Article 2 by Author 1", + content: "Content for Article 2 by Author 1", + is_published: false + } + ] + } + } + ], + on_conflict: { + constraint: author_pkey, + update_columns: [] + } + ) { + affected_rows + returning { + id + name + articles { + id + title + content + is_published + } + } + } + } diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml index 32254116d9f3d..cbad4adfe5cee 100644 --- a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles.yaml @@ -7,15 +7,18 @@ query: insert_author( objects: [ { + id: 1, name: "Author 1", articles: { data: [ { + id: 1, title: "Article 1 by Author 1", content: "Content for Article 1 by Author 1", is_published: false }, { + id: 2, title: "Article 2 by Author 1", content: "Content for Article 2 by Author 1", is_published: false diff --git a/server/tests-py/test_graphql_mutations.py b/server/tests-py/test_graphql_mutations.py index 94e2eac0bdbb7..1dc57b97b594c 100644 --- a/server/tests-py/test_graphql_mutations.py +++ b/server/tests-py/test_graphql_mutations.py @@ -147,6 +147,12 @@ def test_articles_with_author(self, hge_ctx): def test_articles_with_author_author_id_fail(self, hge_ctx): check_query_f(hge_ctx, self.dir + "/articles_with_author_author_id_fail.yaml") + def test_author_upsert_articles_fail(self, hge_ctx): + check_query_f(hge_ctx, self.dir + "/author_upsert_articles_fail.yaml") + + def test_articles_author_upsert_fail(self, hge_ctx): + check_query_f(hge_ctx, self.dir + "/articles_author_upsert_fail.yaml") + @pytest.fixture(autouse=True) def transact(self, request, hge_ctx): self.dir = "queries/graphql_mutation/insert/nested"