hasura · 0x777 · Sep 4, 2018 · Sep 1, 2018 · Sep 3, 2018 · Sep 3, 2018
@@ -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

@@ -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,25 +674,31 @@ mkInsInp tn cols =
 {-
 
 input table_on_conflict {
-  action: conflict_action!
-  constraint: table_constraint
+  action: conflict_action
+  constraint: table_constraint!
+  update_columns: [table_column!]
 }
 
 -}
 
 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