diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index b9eed9fadbee9..511bdeb58327e 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -13,6 +13,7 @@ module Hasura.GraphQL.Resolve.Mutation 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 @@ -68,49 +69,64 @@ convertRowObj val = let prepExp = fromMaybe (S.SEUnsafe "NULL") prepExpM return (PGCol $ G.unName k, prepExp) -mkConflictClause - :: (MonadError QErr m) - => [PGCol] - -> RI.ConflictCtx - -> m RI.ConflictClauseP1 -mkConflictClause cols (act, conM) = case (act , conM) of - (CAIgnore, Nothing) -> return $ RI.CP1DoNothing Nothing - (CAIgnore, Just cons) -> return $ RI.CP1DoNothing $ Just $ RI.Constraint cons - (CAUpdate, Nothing) -> withPathK "on_conflict" $ throw400 Unexpected - "expecting \"constraint\" when \"action\" is \"update\" " - (CAUpdate, Just cons) -> return $ RI.CP1Update (RI.Constraint cons) cols +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 ConflictAction -parseAction obj = do - val <- onNothing (Map.lookup "action" obj) $ throw500 - "\"action\" field is expected but not found" - (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 + => 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 (Maybe ConstraintName) + => AnnGObject -> m ConstraintName parseConstraint obj = do - t <- mapM parseVal $ Map.lookup "constraint" obj - return $ fmap ConstraintName t + v <- onNothing (Map.lookup "constraint" obj) $ throw500 + "\"constraint\" is expected, but not found" + parseVal v where parseVal v = do (_, enumVal) <- asEnumVal v - return $ G.unName $ G.unEnumValue enumVal + 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) - => AnnGValue -> m RI.ConflictCtx -parseOnConflict val = + => [PGCol] -> AnnGValue -> m RI.ConflictCtx +parseOnConflict inpCols val = flip withObject val $ \_ obj -> do - action <- parseAction obj - constraintM <- parseConstraint obj - return (action, constraintM) + actionM <- parseAction obj + constraint <- parseConstraint obj + updColsM <- parseUpdCols obj + -- consider "action" if "update_columns" is not mentioned + return $ 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 @@ -119,13 +135,14 @@ convertInsert -> Field -- the mutation field -> Convert RespTx convertInsert role (tn, vn) tableCols fld = do - rows <- withArg arguments "objects" asRowExps - conflictCtxM <- withPathK "on_conflict" $ - withArgM arguments "on_conflict" parseOnConflict - onConflictM <- mapM (mkConflictClause tableCols) conflictCtxM + 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 p1Query = RI.InsertQueryP1 tn vn tableCols rows onConflictM mutFlds + 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 @@ -134,7 +151,9 @@ convertInsert role (tn, vn) tableCols fld = do asRowExps = withArray (const $ mapM rowExpWithDefaults) rowExpWithDefaults val = do givenCols <- convertRowObj val - return $ Map.elems $ Map.union (Map.fromList givenCols) defVals + 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") @@ -211,7 +230,7 @@ convertUpdate tn filterExp fld = do ] updExp = concat $ catMaybes updExpsM -- atleast one of update operators is expected - unless (any isJust updExpsM) $ throw400 Unexpected $ + unless (any isJust updExpsM) $ throwVE $ "atleast any one of _set, _inc, _append, _prepend, _delete_key, _delete_elem and " <> " _delete_at_path operator is expected" let p1 = RU.UpdateQueryP1 tn updExp (filterExp, whereExp) mutFlds diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index ca5bab3ed5c59..e0b0f6eb7bc84 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -646,6 +646,11 @@ mkConstraintInpTy :: QualifiedTable -> G.NamedType mkConstraintInpTy tn = G.NamedType $ qualTableToName tn <> "_constraint" +-- table_column +mkColumnInpTy :: QualifiedTable -> G.NamedType +mkColumnInpTy tn = + G.NamedType $ qualTableToName tn <> "_column" + {- input table_insert_input { @@ -669,8 +674,9 @@ mkInsInp tn cols = {- input table_on_conflict { - action: conflict_action! - constraint: table_constraint + action: conflict_action + constraint: table_constraint! + update_columns: [table_column!] } -} @@ -678,16 +684,21 @@ input table_on_conflict { mkOnConflictInp :: QualifiedTable -> InpObjTyInfo mkOnConflictInp tn = InpObjTyInfo (Just desc) (mkOnConflictInpTy tn) $ fromInpValL - [actionInpVal, constraintInpVal] + [actionInpVal, constraintInpVal, updateColumnsInpVal] where desc = G.Description $ "on conflict condition type for table " <>> tn - actionInpVal = InpValInfo Nothing (G.Name "action") $ - G.toGT $ G.toNT $ G.NamedType "conflict_action" + actionDesc = "action when conflict occurs (deprecated)" + + actionInpVal = InpValInfo (Just actionDesc) (G.Name "action") $ + G.toGT $ G.NamedType "conflict_action" constraintInpVal = InpValInfo Nothing (G.Name "constraint") $ - G.toGT $ mkConstraintInpTy tn + G.toGT $ G.toNT $ mkConstraintInpTy tn + + updateColumnsInpVal = InpValInfo Nothing (G.Name "update_columns") $ + G.toGT $ G.toLT $ G.toNT $ mkColumnInpTy tn {- insert_table( @@ -697,14 +708,12 @@ insert_table( -} mkInsMutFld - :: QualifiedTable -> [TableConstraint] -> ObjFldInfo -mkInsMutFld tn constraints = + :: QualifiedTable -> [TableConstraint] -> Bool -> ObjFldInfo +mkInsMutFld tn constraints isUpsertAllowed = ObjFldInfo (Just desc) fldName (fromInpValL inputVals) $ G.toGT $ mkMutRespTy tn where - inputVals = catMaybes [ Just objectsArg - , onConflictInpVal - ] + inputVals = catMaybes [Just objectsArg , onConflictInpVal] desc = G.Description $ "insert data into the table: " <>> tn @@ -716,7 +725,8 @@ mkInsMutFld tn constraints = G.toNT $ G.toLT $ G.toNT $ mkInsInpTy tn uniqueOrPrimaryCons = filter isUniqueOrPrimary constraints - onConflictInpVal = bool (Just onConflictArg) Nothing $ null uniqueOrPrimaryCons + onConflictInpVal = bool (Just onConflictArg) Nothing + (null uniqueOrPrimaryCons || not isUpsertAllowed) onConflictDesc = "on conflict condition" onConflictArg = @@ -735,6 +745,18 @@ mkConstriantTy tn cons = enumTyInfo EnumValInfo (Just "unique or primary key constraint") (G.EnumValue $ G.Name n) False +mkColumnTy :: QualifiedTable -> [PGCol] -> EnumTyInfo +mkColumnTy tn cols = enumTyInfo + where + enumTyInfo = EnumTyInfo (Just desc) (mkColumnInpTy tn) $ + mapFromL _eviVal $ map mkColumnEnumVal cols + + desc = G.Description $ + "columns of table " <>> tn + + mkColumnEnumVal (PGCol col) = + EnumValInfo (Just "column name") (G.EnumValue $ G.Name col) False + mkConflictActionTy :: EnumTyInfo mkConflictActionTy = EnumTyInfo (Just desc) ty $ mapFromL _eviVal [enumValIgnore, enumValUpdate] @@ -809,19 +831,22 @@ instance Monoid RootFlds where mempty = RootFlds Map.empty mappend = (<>) -mkOnConflictTypes :: QualifiedTable -> [TableConstraint] -> [TypeInfo] -mkOnConflictTypes tn c = bool tyInfos [] $ null constraints +mkOnConflictTypes + :: QualifiedTable -> [TableConstraint] -> [PGCol] -> Bool -> [TypeInfo] +mkOnConflictTypes tn c cols isUpsertAllowed = + bool tyInfos [] (null constraints || not isUpsertAllowed) where tyInfos = [ TIEnum mkConflictActionTy , TIEnum $ mkConstriantTy tn constraints + , TIEnum $ mkColumnTy tn cols , TIInpObj $ mkOnConflictInp tn ] constraints = filter isUniqueOrPrimary c mkGCtxRole' :: QualifiedTable - -- insert cols - -> Maybe [PGColInfo] + -- insert cols, is upsert allowed + -> Maybe ([PGColInfo], Bool) -- select permission -> Maybe [SelField] -- update cols @@ -832,14 +857,17 @@ mkGCtxRole' -> [PGColInfo] -- constraints -> [TableConstraint] + -- all columns + -> [PGCol] -> TyAgg -mkGCtxRole' tn insColsM selFldsM updColsM delPermM pkeyCols constraints = +mkGCtxRole' tn insPermM selFldsM updColsM delPermM pkeyCols constraints allCols = TyAgg (mkTyInfoMap allTypes) fieldMap ordByEnums where ordByEnums = fromMaybe Map.empty ordByResCtxM - onConflictTypes = mkOnConflictTypes tn constraints + onConflictTypes = mkOnConflictTypes tn constraints allCols $ + or $ fmap snd insPermM jsonOpTys = fromMaybe [] updJSONOpInpObjTysM allTypes = onConflictTypes <> jsonOpTys <> catMaybes @@ -864,6 +892,7 @@ mkGCtxRole' tn insColsM selFldsM updColsM delPermM pkeyCols constraints = -- helper mkColFldMap ty = mapFromL ((ty,) . nameFromSelFld) . map Left + insColsM = fst <$> insPermM -- insert input type insInpObjM = mkInsInp tn <$> insColsM -- fields used in insert input object @@ -919,7 +948,7 @@ getRootFldsRole' -> [PGCol] -> [TableConstraint] -> FieldInfoMap - -> Maybe (QualifiedTable, [T.Text]) -- insert view + -> Maybe (QualifiedTable, [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 @@ -933,8 +962,10 @@ getRootFldsRole' tn primCols constraints fields insM selM updM delM = , getPKeySelDet selM $ getColInfos primCols colInfos ] colInfos = fst $ validPartitionFieldInfoMap fields - getInsDet (vn, hdrs) = - (OCInsert tn vn (map pgiName colInfos) hdrs, Right $ mkInsMutFld tn constraints) + getInsDet (vn, hdrs, isUpsertAllowed) = + ( OCInsert tn vn (map pgiName colInfos) hdrs + , Right $ mkInsMutFld tn constraints isUpsertAllowed + ) getUpdDet (updCols, updFltr, hdrs) = ( OCUpdate tn updFltr hdrs , Right $ mkUpdMutFld tn $ getColInfos updCols colInfos @@ -1000,14 +1031,15 @@ mkGCtxRole -> m (TyAgg, RootFlds) mkGCtxRole tableCache tn fields pCols constraints role permInfo = do selFldsM <- mapM (getSelFlds tableCache fields role) $ _permSel permInfo - let insColsM = const colInfos <$> _permIns permInfo + let insColsM = ((colInfos,) . ipiAllowUpsert) <$> _permIns permInfo updColsM = filterColInfos . upiCols <$> _permUpd permInfo tyAgg = mkGCtxRole' tn insColsM selFldsM updColsM - (void $ _permDel permInfo) pColInfos constraints + (void $ _permDel permInfo) pColInfos constraints allCols rootFlds = getRootFldsRole tn pCols constraints fields permInfo return (tyAgg, rootFlds) where colInfos = fst $ validPartitionFieldInfoMap fields + allCols = map pgiName colInfos pColInfos = getColInfos pCols colInfos filterColInfos allowedSet = filter ((`Set.member` allowedSet) . pgiName) colInfos @@ -1024,7 +1056,7 @@ getRootFldsRole tn pCols constraints fields (RolePermInfo insM selM updM delM) = (mkIns <$> insM) (mkSel <$> selM) (mkUpd <$> updM) (mkDel <$> delM) where - mkIns i = (ipiView i, ipiRequiredHeaders i) + mkIns i = (ipiView i, ipiRequiredHeaders i, ipiAllowUpsert i) mkSel s = (spiFilter s, spiLimit s, spiRequiredHeaders s) mkUpd u = ( Set.toList $ upiCols u , upiFilter u @@ -1040,9 +1072,9 @@ mkGCtxMapTable 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) + let adminCtx = mkGCtxRole' tn (Just (colInfos, True)) (Just selFlds) (Just colInfos) (Just ()) - pkeyColInfos validConstraints + pkeyColInfos validConstraints allCols return $ Map.insert adminRole (adminCtx, adminRootFlds) m where validConstraints = mkValidConstraints constraints @@ -1055,7 +1087,7 @@ mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols) noFilter = S.BELit True adminRootFlds = getRootFldsRole' tn pkeyCols constraints fields - (Just (tn, [])) (Just (noFilter, Nothing, [])) + (Just (tn, [], True)) (Just (noFilter, Nothing, [])) (Just (allCols, noFilter, [])) (Just (noFilter, [])) mkScalarTyInfo :: PGColType -> ScalarTyInfo diff --git a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs index 22a03440baafe..13df3866ccc0f 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs @@ -17,7 +17,6 @@ import Data.Has import qualified Data.Aeson as J import qualified Data.HashMap.Strict as Map -import qualified Data.Text as T import qualified Data.Vector as V import qualified Language.GraphQL.Draft.Syntax as G @@ -169,22 +168,26 @@ validateObject -> InpObjTyInfo -> [(G.Name, a)] -> m AnnGObject validateObject valParser tyInfo flds = do - when (dupFlds /= []) $ + fldMap <- fmap (Map.map snd) $ onLeft (mkMapWith fst flds) $ \dups -> throwVE $ "when parsing a value of type: " <> showNamedTy (_iotiName tyInfo) <> ", the following fields are duplicated: " - <> T.intercalate ", " (map showName dupFlds) - - -- TODO: need to check for required arguments - - fmap Map.fromList $ forM flds $ \(fldName, fldVal) -> - withPathK (G.unName fldName) $ do - fldTy <- getInpFieldInfo tyInfo fldName - convFldVal <- validateInputValue valParser fldTy fldVal - return (fldName, convFldVal) - - where - dupFlds = mapMaybe listToMaybe $ filter ((>) 1 . length) $ - group $ map fst flds + <> showNames dups + + annFldsM <- forM (Map.toList $ _iotiFields tyInfo) $ + \(fldName, inpValInfo) -> do + let fldValM = Map.lookup fldName fldMap + ty = _iviType inpValInfo + isNotNull = G.isNotNull ty + when (isNothing fldValM && isNotNull) $ throwVE $ + "field " <> G.unName fldName <> " of type " <> G.showGT ty + <> " is required, but not found" + forM fldValM $ \fldVal -> + withPathK (G.unName fldName) $ do + fldTy <- getInpFieldInfo tyInfo fldName + convFldVal <- validateInputValue valParser fldTy fldVal + return (fldName, convFldVal) + + return $ Map.fromList $ catMaybes annFldsM validateNamedTypeVal :: ( MonadReader r m, Has TypeMap r @@ -199,14 +202,14 @@ validateNamedTypeVal inpValParser nt val = do throw500 $ "unexpected object type info for: " <> showNamedTy nt TIInpObj ioti -> - withParsed (getObject inpValParser) val $ \mObj -> - AGObject nt <$> (mapM $ validateObject inpValParser ioti) mObj + withParsed (getObject inpValParser) val $ + fmap (AGObject nt) . mapM (validateObject inpValParser ioti) TIEnum eti -> - withParsed (getEnum inpValParser) val $ \mEnumVal -> - AGEnum nt <$> (mapM $ validateEnum eti) mEnumVal + withParsed (getEnum inpValParser) val $ + fmap (AGEnum nt) . mapM (validateEnum eti) TIScalar (ScalarTyInfo _ pgColTy) -> - withParsed (getScalar inpValParser) val $ \mScalar -> - AGScalar pgColTy <$> (mapM $ validateScalar pgColTy) mScalar + withParsed (getScalar inpValParser) val $ + fmap (AGScalar pgColTy) . mapM (validateScalar pgColTy) where validateEnum enumTyInfo enumVal = if Map.member enumVal (_etiValues enumTyInfo) diff --git a/server/src-lib/Hasura/Prelude.hs b/server/src-lib/Hasura/Prelude.hs index 94b0782abb2eb..127cfba1258b3 100644 --- a/server/src-lib/Hasura/Prelude.hs +++ b/server/src-lib/Hasura/Prelude.hs @@ -14,7 +14,7 @@ import Data.Foldable as M (toList) import Data.Hashable as M (Hashable) import Data.List as M (find, foldl', group, sortBy) import Data.Maybe as M (catMaybes, fromMaybe, isJust, - listToMaybe, mapMaybe, + isNothing, listToMaybe, mapMaybe, maybeToList) import Data.Ord as M (comparing) import Data.Semigroup as M (Semigroup (..)) diff --git a/server/src-lib/Hasura/RQL/DDL/Permission.hs b/server/src-lib/Hasura/RQL/DDL/Permission.hs index 7bd4639141f2d..052384c67238f 100644 --- a/server/src-lib/Hasura/RQL/DDL/Permission.hs +++ b/server/src-lib/Hasura/RQL/DDL/Permission.hs @@ -117,19 +117,17 @@ buildInsPermInfo tabInfo (PermDef rn (InsPerm chk upsrt) _) = do tn = tiName tabInfo vn = buildViewName tn rn PTInsert -buildInsInfra :: QualifiedTable -> InsPermInfo -> [PGCol] -> Q.TxE QErr () -buildInsInfra tn (InsPermInfo vn be _ _ _) cols = +buildInsInfra :: QualifiedTable -> InsPermInfo -> Q.TxE QErr () +buildInsInfra tn (InsPermInfo vn be _ _ _) = Q.catchE defaultTxErrorHandler $ do -- Create the view Q.unitQ (buildView tn vn) () False -- Inject defaults on the view Q.discardQ (injectDefaults vn tn) () False -- Construct a trigger function - Q.unitQ (buildInsTrigFn vn tn be se) () False + Q.unitQ (buildInsTrigFn vn tn be) () False -- Add trigger for check expression Q.unitQ (buildInsTrig vn) () False - where - se = S.buildSEWithExcluded cols clearInsInfra :: QualifiedTable -> Q.TxE QErr () clearInsInfra vn = @@ -152,10 +150,7 @@ instance IsPerm InsPerm where buildPermInfo = buildInsPermInfo - addPermP2Setup qt _ permInfo = do - tabInfo <- askTabInfo qt - liftTx $ buildInsInfra qt permInfo $ - map pgiName $ getCols $ tiFieldInfoMap tabInfo + addPermP2Setup qt _ = liftTx . buildInsInfra qt buildDropPermP1Res dp = ipiView <$> dropPermP1 dp diff --git a/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs b/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs index 4e8d3f7a98e85..35b791f78f90e 100644 --- a/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs +++ b/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs @@ -272,7 +272,7 @@ class (ToJSON a) => IsPerm a where -> m (PermInfo a) addPermP2Setup - :: (CacheRWM m, MonadTx m, QErrM m) => QualifiedTable -> PermDef a -> PermInfo a -> m () + :: (MonadTx m, QErrM m) => QualifiedTable -> PermDef a -> PermInfo a -> m () buildDropPermP1Res :: (QErrM m, CacheRM m, UserInfoM m) diff --git a/server/src-lib/Hasura/RQL/DDL/Permission/Triggers.hs b/server/src-lib/Hasura/RQL/DDL/Permission/Triggers.hs index 88caa81342ea9..3d54cc3806c2e 100644 --- a/server/src-lib/Hasura/RQL/DDL/Permission/Triggers.hs +++ b/server/src-lib/Hasura/RQL/DDL/Permission/Triggers.hs @@ -23,14 +23,15 @@ dropInsTrigFn :: QualifiedTable -> Q.Query dropInsTrigFn fn = Q.fromBuilder $ BB.string7 "DROP FUNCTION " <> toSQL fn <> "()" -buildInsTrigFn :: QualifiedTable -> QualifiedTable -> S.BoolExp -> S.SetExp -> Q.Query -buildInsTrigFn fn tn be se = +buildInsTrigFn :: QualifiedTable -> QualifiedTable -> S.BoolExp -> Q.Query +buildInsTrigFn fn tn be = Q.fromBuilder $ mconcat [ BB.string7 "CREATE OR REPLACE FUNCTION " <> toSQL fn , BB.string7 "() RETURNS trigger LANGUAGE plpgsql AS $$ " , BB.string7 "DECLARE r " <> toSQL tn <> "%ROWTYPE; " , BB.string7 "DECLARE conflict_clause jsonb; DECLARE action text; " , BB.string7 "DECLARE constraint_name text; " + , BB.string7 "DECLARE set_expression text; " , BB.string7 "BEGIN " , BB.string7 "conflict_clause = current_setting('hasura.conflict_clause')::jsonb; " , BB.string7 "IF (" <> toSQL be <> BB.string7 ") THEN " @@ -40,6 +41,7 @@ buildInsTrigFn fn tn be se = , BB.string7 "ELSE " , BB.string7 "action = conflict_clause ->> 'action'; " , BB.string7 "constraint_name = conflict_clause ->> 'constraint'; " + , BB.string7 "set_expression = conflict_clause ->> 'set_expression'; " , BB.string7 "IF action is NOT NULL THEN " , BB.string7 "CASE " , BB.string7 "WHEN action = 'ignore'::text AND constraint_name IS NULL THEN " @@ -49,8 +51,8 @@ buildInsTrigFn fn tn be se = , BB.string7 "EXECUTE 'INSERT INTO " <> toSQL tn , BB.string7 " VALUES ($1.*) ON CONFLICT ON CONSTRAINT ' || constraint_name || ' DO NOTHING RETURNING *' INTO r USING NEW; RETURN r; " , BB.string7 "ELSE EXECUTE 'INSERT INTO " <> toSQL tn - , BB.string7 " VALUES ($1.*) ON CONFLICT ON CONSTRAINT ' || constraint_name || ' DO UPDATE " <> toSQL se - , BB.string7 " RETURNING *' INTO r USING NEW; RETURN r; " + , BB.string7 " VALUES ($1.*) ON CONFLICT ON CONSTRAINT ' || constraint_name || ' DO UPDATE ' || set_expression || " + , BB.string7 "' RETURNING *' INTO r USING NEW; RETURN r; " , BB.string7 "END CASE; " , BB.string7 "ELSE RAISE internal_error using message = 'action is not found'; RETURN NULL; " , BB.string7 "END IF; " diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index 2d68f979e789b..995a237cb134a 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -419,9 +419,8 @@ runSqlP2 (RunSQL t cascade) = do -- recreate the insert permission infra forM_ (M.elems $ scTables postSc) $ \ti -> do let tn = tiName ti - pgCols = map pgiName $ getCols $ tiFieldInfoMap ti forM_ (M.elems $ tiRolePermInfoMap ti) $ \rpi -> - maybe (return ()) (\ipi -> liftTx $ buildInsInfra tn ipi pgCols) $ _permIns rpi + maybe (return ()) (liftTx . buildInsInfra tn) $ _permIns rpi return $ encode (res :: RunSQLRes) diff --git a/server/src-lib/Hasura/RQL/DML/Insert.hs b/server/src-lib/Hasura/RQL/DML/Insert.hs index 20a4011147c8f..eeccba1be7fa9 100644 --- a/server/src-lib/Hasura/RQL/DML/Insert.hs +++ b/server/src-lib/Hasura/RQL/DML/Insert.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} module Hasura.RQL.DML.Insert where @@ -11,6 +12,7 @@ import Instances.TH.Lift () import qualified Data.Aeson.Text as AT import qualified Data.ByteString.Builder as BB import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS import qualified Data.Sequence as DS import qualified Data.Text.Lazy as LT @@ -54,8 +56,8 @@ mkSQLInsert (InsertQueryP1 tn vn cols vals c mutFlds) = Nothing -> Nothing Just (CP1DoNothing Nothing) -> Just $ S.DoNothing Nothing Just (CP1DoNothing (Just ct)) -> Just $ S.DoNothing $ Just $ toSQLCT ct - Just (CP1Update ct pgCols) -> Just $ S.Update (toSQLCT ct) - (S.buildSEWithExcluded pgCols) + Just (CP1Update ct inpCols) -> Just $ S.Update (toSQLCT ct) + (S.buildSEWithExcluded inpCols) toSQLCT ct = case ct of Column pgCols -> S.SQLColumn pgCols @@ -80,42 +82,45 @@ convObj -> HM.HashMap PGCol S.SQLExp -> FieldInfoMap -> InsObj - -> m [S.SQLExp] + -> m ([PGCol], [S.SQLExp]) convObj prepFn defInsVals fieldInfoMap insObj = do inpInsVals <- flip HM.traverseWithKey insObj $ \c val -> do let relWhenPGErr = "relationships can't be inserted" colType <- askPGType fieldInfoMap c relWhenPGErr -- Encode aeson's value into prepared value withPathK (getPGColTxt c) $ prepFn colType val + let sqlExps = HM.elems $ HM.union inpInsVals defInsVals + inpCols = HM.keys inpInsVals - return $ HM.elems $ HM.union inpInsVals defInsVals + return (inpCols, sqlExps) buildConflictClause :: (P1C m) => TableInfo + -> [PGCol] -> OnConflict -> m ConflictClauseP1 -buildConflictClause tableInfo (OnConflict mTCol mTCons act) = case (mTCol, mTCons, act) of - (Nothing, Nothing, CAIgnore) -> return $ CP1DoNothing Nothing - (Just col, Nothing, CAIgnore) -> do - validateCols col - return $ CP1DoNothing $ Just $ Column $ getPGCols col - (Nothing, Just cons, CAIgnore) -> do - validateConstraint cons - return $ CP1DoNothing $ Just $ Constraint cons - (Nothing, Nothing, CAUpdate) -> throw400 UnexpectedPayload - "Expecting 'constraint' or 'constraint_on' when the 'action' is 'update'" - (Just col, Nothing, CAUpdate) -> do - validateCols col - return $ CP1Update (Column $ getPGCols col) columns - (Nothing, Just cons, CAUpdate) -> do - validateConstraint cons - return $ CP1Update (Constraint cons) columns - (Just _, Just _, _) -> throw400 UnexpectedPayload - "'constraint' and 'constraint_on' cannot be set at a time" +buildConflictClause tableInfo inpCols (OnConflict mTCol mTCons act) = + case (mTCol, mTCons, act) of + (Nothing, Nothing, CAIgnore) -> return $ CP1DoNothing Nothing + (Just col, Nothing, CAIgnore) -> do + validateCols col + return $ CP1DoNothing $ Just $ Column $ getPGCols col + (Nothing, Just cons, CAIgnore) -> do + validateConstraint cons + return $ CP1DoNothing $ Just $ Constraint cons + (Nothing, Nothing, CAUpdate) -> throw400 UnexpectedPayload + "Expecting 'constraint' or 'constraint_on' when the 'action' is 'update'" + (Just col, Nothing, CAUpdate) -> do + validateCols col + return $ CP1Update (Column $ getPGCols col) inpCols + (Nothing, Just cons, CAUpdate) -> do + validateConstraint cons + return $ CP1Update (Constraint cons) inpCols + (Just _, Just _, _) -> throw400 UnexpectedPayload + "'constraint' and 'constraint_on' cannot be set at a time" where fieldInfoMap = tiFieldInfoMap tableInfo - columns = map pgiName $ getCols fieldInfoMap validateCols c = do let targetcols = getPGCols c @@ -169,14 +174,16 @@ convInsertQuery objsParser prepFn (InsertQuery tableName val oC mRetCols) = do insTuples <- withPathK "objects" $ indexedForM insObjs $ \obj -> convObj prepFn defInsVals fieldInfoMap obj + let sqlExps = map snd insTuples + inpCols = HS.toList $ HS.fromList $ concatMap fst insTuples conflictClause <- withPathK "on_conflict" $ forM oC $ \c -> do roleName <- askCurRole unless (ipiAllowUpsert insPerm) $ throw400 PermissionDenied $ "upsert is not allowed for role" <>> roleName - buildConflictClause tableInfo c + buildConflictClause tableInfo inpCols c - return $ InsertQueryP1 tableName insView insCols insTuples + return $ InsertQueryP1 tableName insView insCols sqlExps conflictClause mutFlds where @@ -202,7 +209,10 @@ insertP2 (u, p) = where insertSQL = toSQL $ mkSQLInsert u -type ConflictCtx = (ConflictAction, Maybe ConstraintName) +data ConflictCtx + = CCUpdate !ConstraintName ![PGCol] + | CCDoNothing !(Maybe ConstraintName) + deriving (Show, Eq) nonAdminInsert :: (InsertQueryP1, DS.Seq Q.PrepArg) -> Q.TxE QErr RespBody nonAdminInsert (insQueryP1, args) = do @@ -218,10 +228,10 @@ extractConflictCtx cp = case cp of (CP1DoNothing mConflictTar) -> do mConstraintName <- mapM extractConstraintName mConflictTar - return (CAIgnore, mConstraintName) - (CP1Update conflictTar _) -> do + return $ CCDoNothing mConstraintName + (CP1Update conflictTar inpCols) -> do constraintName <- extractConstraintName conflictTar - return (CAUpdate, Just constraintName) + return $ CCUpdate constraintName inpCols where extractConstraintName (Constraint cn) = return cn extractConstraintName _ = throw400 NotSupported @@ -235,8 +245,13 @@ setConflictCtx conflictCtxM = do q = Q.fromBuilder $ setVar <> setVal Q.unitQE defaultTxErrorHandler q () False where - conflictCtxToJSON (act, constrM) = - LT.toStrict $ AT.encodeToLazyText $ InsertTxConflictCtx act constrM + encToText = LT.toStrict . AT.encodeToLazyText + + conflictCtxToJSON (CCDoNothing constrM) = + encToText $ InsertTxConflictCtx CAIgnore constrM Nothing + conflictCtxToJSON (CCUpdate constr updCols) = + encToText $ InsertTxConflictCtx CAUpdate (Just constr) $ + Just $ sqlBuilderToTxt $ toSQL $ S.buildSEWithExcluded updCols instance HDBQuery InsertQuery where diff --git a/server/src-lib/Hasura/RQL/Types/DML.hs b/server/src-lib/Hasura/RQL/Types/DML.hs index d91faf3a0a28c..5588bad1b2771 100644 --- a/server/src-lib/Hasura/RQL/Types/DML.hs +++ b/server/src-lib/Hasura/RQL/Types/DML.hs @@ -271,8 +271,9 @@ $(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''InsertQuery) data InsertTxConflictCtx = InsertTxConflictCtx - { itcAction :: !ConflictAction - , itcConstraint :: !(Maybe ConstraintName) + { itcAction :: !ConflictAction + , itcConstraint :: !(Maybe ConstraintName) + , itcSetExpression :: !(Maybe T.Text) } deriving (Show, Eq) $(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''InsertTxConflictCtx) diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index 55483aa939866..653b04184f5af 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -9,6 +9,7 @@ import qualified Database.PG.Query as Q import qualified Database.PG.Query.PTI as PTI import Hasura.Prelude +import Hasura.Server.Utils (bsToTxt) import Data.Aeson import Data.Aeson.Encoding (text) @@ -16,10 +17,14 @@ import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift) import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy as BL import qualified Data.Text.Encoding as TE import qualified Data.Text.Extended as T import qualified Database.PostgreSQL.LibPQ as PQ +sqlBuilderToTxt :: BB.Builder -> T.Text +sqlBuilderToTxt = bsToTxt . BL.toStrict . BB.toLazyByteString + class ToSQL a where toSQL :: a -> BB.Builder diff --git a/server/src-lib/Hasura/Server/Logging.hs b/server/src-lib/Hasura/Server/Logging.hs index 949c58dc0960a..779a30c75972a 100644 --- a/server/src-lib/Hasura/Server/Logging.hs +++ b/server/src-lib/Hasura/Server/Logging.hs @@ -10,31 +10,31 @@ module Hasura.Server.Logging , WebHookLog(..) ) where -import Crypto.Hash (Digest, SHA1, hash) +import Control.Arrow (first) +import Crypto.Hash (Digest, SHA1, hash) import Data.Aeson -import Data.Bits (shift, (.&.)) -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Lazy as BL -import Data.Int (Int64) -import Data.List (find) -import qualified Data.TByteString as TBS -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import qualified Data.Text.Encoding.Error as TE +import Data.Bits (shift, (.&.)) +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Lazy as BL +import Data.Int (Int64) +import Data.List (find) +import qualified Data.TByteString as TBS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import Data.Time.Clock -import Data.Word (Word32) -import Network.Socket (SockAddr (..)) -import Network.Wai (Request (..)) -import System.ByteOrder (ByteOrder (..), byteOrder) -import Text.Printf (printf) - -import qualified Data.ByteString.Char8 as BS -import qualified Data.CaseInsensitive as CI -import qualified Data.HashMap.Strict as M -import qualified Network.HTTP.Client as H -import qualified Network.HTTP.Types as N - -import qualified Hasura.Logging as L +import Data.Word (Word32) +import Network.Socket (SockAddr (..)) +import Network.Wai (Request (..)) +import System.ByteOrder (ByteOrder (..), byteOrder) +import Text.Printf (printf) + +import qualified Data.ByteString.Char8 as BS +import qualified Data.CaseInsensitive as CI +import qualified Data.HashMap.Strict as M +import qualified Network.HTTP.Client as H +import qualified Network.HTTP.Types as N + +import qualified Hasura.Logging as L import Hasura.Prelude import Hasura.RQL.Types.Error import Hasura.Server.Utils @@ -162,13 +162,13 @@ mkAccessLog mkAccessLog req r mTimeT = AccessLog { alStatus = status - , alMethod = decodeBS $ requestMethod req - , alSource = decodeBS $ getSourceFromFallback req - , alPath = decodeBS $ rawPathInfo req + , alMethod = bsToTxt $ requestMethod req + , alSource = bsToTxt $ getSourceFromFallback req + , alPath = bsToTxt $ rawPathInfo req , alHttpVersion = httpVersion req , alDetail = mDetail - , alRequestId = decodeBS <$> getRequestId req - , alHasuraRole = decodeBS <$> getHasuraRole req + , alRequestId = bsToTxt <$> getRequestId req + , alHasuraRole = bsToTxt <$> getHasuraRole req , alHasuraMetadata = getHasuraMetadata req , alResponseSize = size , alResponseTime = T.pack . show <$> diffTime @@ -180,9 +180,6 @@ mkAccessLog req r mTimeT = Nothing -> Nothing Just (t1, t2) -> Just $ diffUTCTime t2 t1 -decodeBS :: BS.ByteString -> T.Text -decodeBS = TE.decodeUtf8With TE.lenientDecode - getSourceFromSocket :: Request -> ByteString getSourceFromSocket = BS.pack . showSockAddr . remoteHost @@ -215,7 +212,7 @@ newtype HasuraMetadata = HasuraMetadata { unHM :: M.HashMap T.Text T.Text } deriving (Show) instance ToJSON HasuraMetadata where - toJSON h = toJSON $ M.fromList $ map (\(k,v) -> (format k, v)) hdrs + toJSON h = toJSON $ M.fromList $ map (first format) hdrs where hdrs = M.toList $ unHM h format = T.map underscorify . T.drop 2 @@ -231,7 +228,7 @@ getHasuraMetadata req = case md of filterFixedHeaders (h,_) = h /= userRoleHeader && h /= accessKeyHeader rawMd = filter (\h -> "x-hasura-" `T.isInfixOf` fst h) hdrs hdrs = map hdrToTxt $ requestHeaders req - hdrToTxt (k, v) = (T.toLower $ decodeBS $ CI.original k, decodeBS v) + hdrToTxt (k, v) = (T.toLower $ bsToTxt $ CI.original k, bsToTxt v) -- | A type for IP address in numeric string representation. type NumericAddress = String diff --git a/server/test/Spec.hs b/server/test/Spec.hs index 8775e19f71730..23be6c7209ece 100644 --- a/server/test/Spec.hs +++ b/server/test/Spec.hs @@ -58,8 +58,12 @@ gqlSpecFiles = , "select_query_author_by_pkey.yaml" , "insert_mutation/article.yaml" , "insert_mutation/article_on_conflict.yaml" + , "insert_mutation/article_on_conflict_user_role.yaml" + , "insert_mutation/article_on_conflict_update_columns.yaml" , "insert_mutation/article_on_conflict_ignore.yaml" , "insert_mutation/article_on_conflict_ignore_constraint.yaml" + , "insert_mutation/article_on_conflict_empty_update_columns.yaml" + , "insert_mutation/article_on_conflict_only_constraint.yaml" , "insert_mutation/article_on_conflict_error_01.yaml" , "insert_mutation/article_on_conflict_error_02.yaml" , "insert_mutation/article_on_conflict_error_03.yaml" diff --git a/server/test/testcases/create_author_article_permissions.yaml b/server/test/testcases/create_author_article_permissions.yaml index bbc3ff3968e9e..55019d6bd5970 100644 --- a/server/test/testcases/create_author_article_permissions.yaml +++ b/server/test/testcases/create_author_article_permissions.yaml @@ -14,6 +14,13 @@ query: $or: - author_id: X-HASURA-USER-ID - is_published: true + - type: create_insert_permission + args: + table: article + role: user + permission: + check: + author_id: X-Hasura-User-Id - type: create_select_permission args: table: author @@ -29,3 +36,4 @@ query: permission: check: id: X-HASURA-USER-ID + allow_upsert: true diff --git a/server/test/testcases/insert_mutation/article_on_conflict_empty_update_columns.yaml b/server/test/testcases/insert_mutation/article_on_conflict_empty_update_columns.yaml new file mode 100644 index 0000000000000..adb68c96811f5 --- /dev/null +++ b/server/test/testcases/insert_mutation/article_on_conflict_empty_update_columns.yaml @@ -0,0 +1,28 @@ +description: Upserts article data via GraphQL mutation with empty update columns +url: /v1alpha1/graphql +status: 200 +query: + query: | + mutation insert_article { + insert_article ( + objects: [ + { + content: "Updated Article 1 content", + id: 1 + }, + { + content: "Updated Article 2 content", + id: 2 + } + ], + on_conflict: { + constraint: article_pkey, + update_columns: [] + } + ) { + returning { + title + content + } + } + } diff --git a/server/test/testcases/insert_mutation/article_on_conflict_error_01.yaml b/server/test/testcases/insert_mutation/article_on_conflict_error_01.yaml index 1ab86b1d2b178..af057ab6372c8 100644 --- a/server/test/testcases/insert_mutation/article_on_conflict_error_01.yaml +++ b/server/test/testcases/insert_mutation/article_on_conflict_error_01.yaml @@ -1,4 +1,4 @@ -description: Upserts article data via GraphQL mutation (Error) +description: Upserts article data via GraphQL mutation (Error 01) url: /v1alpha1/graphql status: 400 query: diff --git a/server/test/testcases/insert_mutation/article_on_conflict_error_02.yaml b/server/test/testcases/insert_mutation/article_on_conflict_error_02.yaml index 88f2e00f5d70b..316f23059dbd9 100644 --- a/server/test/testcases/insert_mutation/article_on_conflict_error_02.yaml +++ b/server/test/testcases/insert_mutation/article_on_conflict_error_02.yaml @@ -1,4 +1,4 @@ -description: Upserts article data via GraphQL mutation (Error) +description: Upserts article data via GraphQL mutation (Error 02) url: /v1alpha1/graphql status: 400 query: diff --git a/server/test/testcases/insert_mutation/article_on_conflict_error_03.yaml b/server/test/testcases/insert_mutation/article_on_conflict_error_03.yaml index d7f67f9d7278c..14bbc2fd598ee 100644 --- a/server/test/testcases/insert_mutation/article_on_conflict_error_03.yaml +++ b/server/test/testcases/insert_mutation/article_on_conflict_error_03.yaml @@ -1,4 +1,4 @@ -description: Upserts article data via GraphQL mutation (Error) +description: Upserts article data via GraphQL mutation (Error 03) url: /v1alpha1/graphql status: 400 query: diff --git a/server/test/testcases/insert_mutation/article_on_conflict_ignore.yaml b/server/test/testcases/insert_mutation/article_on_conflict_ignore.yaml index 752079f286fb3..8f824eacf7c95 100644 --- a/server/test/testcases/insert_mutation/article_on_conflict_ignore.yaml +++ b/server/test/testcases/insert_mutation/article_on_conflict_ignore.yaml @@ -16,6 +16,7 @@ query: } ], on_conflict: { + constraint: article_pkey, action: ignore } ) { diff --git a/server/test/testcases/insert_mutation/article_on_conflict_only_constraint.yaml b/server/test/testcases/insert_mutation/article_on_conflict_only_constraint.yaml new file mode 100644 index 0000000000000..e15d7e34e1ae9 --- /dev/null +++ b/server/test/testcases/insert_mutation/article_on_conflict_only_constraint.yaml @@ -0,0 +1,27 @@ +description: Upserts article data via GraphQL mutation with only constraint +url: /v1alpha1/graphql +status: 200 +query: + query: | + mutation insert_article { + insert_article ( + objects: [ + { + content: "Updated Article 1 content", + id: 1 + }, + { + content: "Updated Article 2 content", + id: 2 + } + ], + on_conflict: { + constraint: article_pkey + } + ) { + returning { + title + content + } + } + } diff --git a/server/test/testcases/insert_mutation/article_on_conflict_update_columns.yaml b/server/test/testcases/insert_mutation/article_on_conflict_update_columns.yaml new file mode 100644 index 0000000000000..c243e5038600e --- /dev/null +++ b/server/test/testcases/insert_mutation/article_on_conflict_update_columns.yaml @@ -0,0 +1,25 @@ +description: Upserts article data view GraphQL mutation using update columns +url: /v1alpha1/graphql +status: 200 +query: + query: | + mutation insert_article { + insert_article ( + objects: [ + { + title: "Update Article 2 title only", + content: "Update Article 2 content", + id: 2 + } + ], + on_conflict: { + constraint: article_pkey, + update_columns: [title] + } + ) { + returning { + title + content + } + } + } diff --git a/server/test/testcases/insert_mutation/article_on_conflict_user_role.yaml b/server/test/testcases/insert_mutation/article_on_conflict_user_role.yaml new file mode 100644 index 0000000000000..3fcd6cb77551d --- /dev/null +++ b/server/test/testcases/insert_mutation/article_on_conflict_user_role.yaml @@ -0,0 +1,26 @@ +description: Upserts article data via GraphQL mutation as User role +url: /v1alpha1/graphql +status: 200 +header: + X-Hasura-Role: user + X-Hasura-User-Id: 1 +query: + query: | + mutation insert_article { + insert_article ( + objects: [ + { + content: "Updated Article 1 content", + id: 1 + } + ], + on_conflict: { + constraint: article_pkey + } + ) { + returning { + title + content + } + } + }