fix insert fails for non-admin roles on v1/query (fix #327) (#328)

* fix insert fails for non-admin roles on v1/query, fix #327

* add test case for user role upsert usint constraint name

server/src-lib/Hasura/GraphQL/Resolve/Context.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE MultiWayIf            #-}
 {-# LANGUAGE NoImplicitPrelude     #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE TemplateHaskell       #-}
 
 module Hasura.GraphQL.Resolve.Context
   ( FieldMap
@@ -26,9 +25,6 @@ module Hasura.GraphQL.Resolve.Context
   , module Hasura.GraphQL.Utils
   ) where
 
-import           Data.Aeson
-import           Data.Aeson.Casing
-import           Data.Aeson.TH
 import           Data.Has
 import           Hasura.Prelude
 
@@ -68,13 +64,6 @@ type OrdByResolveCtxElem = (PGColInfo, OrdTy, NullsOrder)
 type OrdByResolveCtx
   = Map.HashMap (G.NamedType, G.EnumValue) OrdByResolveCtxElem
 
-data InsertTxConflictCtx
-  = InsertTxConflictCtx
-  { itcAction     :: !ConflictAction
-  , itcConstraint :: !(Maybe ConstraintName)
-  } deriving (Show, Eq)
-$(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''InsertTxConflictCtx)
-
 getFldInfo
   :: (MonadError QErr m, MonadReader r m, Has FieldMap r)
   => G.NamedType -> G.Name -> m (Either PGColInfo (RelInfo, S.BoolExp, Maybe Int, Bool))

server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs

@@ -13,11 +13,7 @@ module Hasura.GraphQL.Resolve.Mutation
 import           Data.Has
 import           Hasura.Prelude
 
-import qualified Data.Aeson.Text                   as AT
-import qualified Data.ByteString.Builder           as BB
 import qualified Data.HashMap.Strict               as Map
-import qualified Data.Text.Lazy                    as LT
-import qualified Database.PG.Query                 as Q
 import qualified Language.GraphQL.Draft.Syntax     as G
 
 import qualified Hasura.RQL.DML.Delete             as RD
@@ -73,12 +69,10 @@ convertRowObj val =
     let prepExp = fromMaybe (S.SEUnsafe "NULL") prepExpM
     return (PGCol $ G.unName k, prepExp)
 
-type ConflictCtx = (ConflictAction, Maybe ConstraintName)
-
 mkConflictClause
   :: (MonadError QErr m)
   => [PGCol]
-  -> ConflictCtx
+  -> RI.ConflictCtx
   -> m RI.ConflictClauseP1
 mkConflictClause cols (act, conM) = case (act , conM) of
   (CAIgnore, Nothing) -> return $ RI.CP1DoNothing Nothing
@@ -112,7 +106,7 @@ parseConstraint obj = do
 
 parseOnConflict
   :: (MonadError QErr m)
-  => AnnGValue -> m ConflictCtx
+  => AnnGValue -> m RI.ConflictCtx
 parseOnConflict val =
   flip withObject val $ \_ obj -> do
     action <- parseAction obj
@@ -129,12 +123,13 @@ 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
   mutFlds <- convertMutResp (_fType fld) $ _fSelSet fld
   args <- get
+  let p1Query = RI.InsertQueryP1 tn vn tableCols rows onConflictM mutFlds
+      p1 = (p1Query, args)
   return $
-    bool (nonAdminInsert args rows conflictCtxM mutFlds)
-         (adminInsert args rows conflictCtxM mutFlds)
-         $ isAdmin role
+      bool (RI.nonAdminInsert p1) (RI.insertP2 p1) $ isAdmin role
   where
     arguments = _fArguments fld
     asRowExps = withArray (const $ mapM rowExpWithDefaults)
@@ -144,27 +139,6 @@ convertInsert role (tn, vn) tableCols fld = do
 
     defVals = Map.fromList $ zip tableCols (repeat $ S.SEUnsafe "DEFAULT")
 
-    adminInsert args rows conflictCtxM mutFlds = do
-      onConflictM <- mapM (mkConflictClause tableCols) conflictCtxM
-      let p1 = RI.InsertQueryP1 tn vn tableCols rows onConflictM mutFlds
-      RI.insertP2 (p1, args)
-
-    nonAdminInsert args rows conflictCtxM mutFlds = do
-      mapM_ (mkConflictClause tableCols) conflictCtxM
-      setConflictCtxTx conflictCtxM
-      let p1 = RI.InsertQueryP1 tn vn tableCols rows Nothing mutFlds
-      RI.insertP2 (p1, args)
-
-    setConflictCtxTx conflictCtxM = do
-      let t = maybe "null" conflictCtxToJSON conflictCtxM
-          setVal = toSQL $ S.SELit t
-          setVar = BB.string7 "SET LOCAL hasura.conflict_clause = "
-          q = Q.fromBuilder $ setVar <> setVal
-      Q.unitQE defaultTxErrorHandler q () False
-
-    conflictCtxToJSON (act, constrM) =
-      LT.toStrict $ AT.encodeToLazyText $ InsertTxConflictCtx act constrM
-
 type ApplySQLOp =  (PGCol, S.SQLExp) -> S.SQLExp
 
 rhsExpOp :: S.SQLOp -> S.AnnType -> ApplySQLOp

server/src-lib/Hasura/RQL/DML/Insert.hs

@@ -8,8 +8,11 @@ module Hasura.RQL.DML.Insert where
 import           Data.Aeson.Types
 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.Sequence            as DS
+import qualified Data.Text.Lazy           as LT
 
 import           Hasura.Prelude
 import           Hasura.RQL.DML.Internal
@@ -172,6 +175,7 @@ convInsertQuery objsParser prepFn (InsertQuery tableName val oC mRetCols) = do
       unless (ipiAllowUpsert insPerm) $ throw400 PermissionDenied $
         "upsert is not allowed for role" <>> roleName
       buildConflictClause tableInfo c
+
   return $ InsertQueryP1 tableName insView insCols insTuples
            conflictClause mutFlds
 
@@ -198,11 +202,50 @@ insertP2 (u, p) =
   where
     insertSQL = toSQL $ mkSQLInsert u
 
+type ConflictCtx = (ConflictAction, Maybe ConstraintName)
+
+nonAdminInsert :: (InsertQueryP1, DS.Seq Q.PrepArg) -> Q.TxE QErr RespBody
+nonAdminInsert (insQueryP1, args) = do
+  conflictCtxM <- mapM extractConflictCtx conflictClauseP1
+  setConflictCtx conflictCtxM
+  insertP2 (withoutConflictClause, args)
+  where
+    withoutConflictClause = insQueryP1{iqp1Conflict=Nothing}
+    conflictClauseP1 = iqp1Conflict insQueryP1
+
+extractConflictCtx :: (MonadError QErr m) => ConflictClauseP1 -> m ConflictCtx
+extractConflictCtx cp =
+  case cp of
+    (CP1DoNothing mConflictTar) -> do
+      mConstraintName <- mapM extractConstraintName mConflictTar
+      return (CAIgnore, mConstraintName)
+    (CP1Update conflictTar _) -> do
+      constraintName <- extractConstraintName conflictTar
+      return (CAUpdate, Just constraintName)
+  where
+    extractConstraintName (Constraint cn) = return cn
+    extractConstraintName _ = throw400 NotSupported
+      "\"constraint_on\" not supported for non admin insert. use \"constraint\" instead"
+
+setConflictCtx :: Maybe ConflictCtx -> Q.TxE QErr ()
+setConflictCtx conflictCtxM = do
+  let t = maybe "null" conflictCtxToJSON conflictCtxM
+      setVal = toSQL $ S.SELit t
+      setVar = BB.string7 "SET LOCAL hasura.conflict_clause = "
+      q = Q.fromBuilder $ setVar <> setVal
+  Q.unitQE defaultTxErrorHandler q () False
+  where
+    conflictCtxToJSON (act, constrM) =
+      LT.toStrict $ AT.encodeToLazyText $ InsertTxConflictCtx act constrM
+
 instance HDBQuery InsertQuery where
 
   type Phase1Res InsertQuery = (InsertQueryP1, DS.Seq Q.PrepArg)
   phaseOne = convInsQ
 
-  phaseTwo _ = liftTx . insertP2
+  phaseTwo _ p1Res = do
+    role <- userRole <$> ask
+    liftTx $
+      bool (nonAdminInsert p1Res) (insertP2 p1Res) $ isAdmin role
 
   schemaCachePolicy = SCPNoChange

server/src-lib/Hasura/RQL/Types/DML.hs

@@ -29,6 +29,8 @@ module Hasura.RQL.Types.DML
        , ConflictAction(..)
        , ConstraintOn(..)
 
+       , InsertTxConflictCtx(..)
+
        , UpdVals
        , UpdateQuery(..)
 
@@ -268,6 +270,13 @@ data InsertQuery
 
 $(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''InsertQuery)
 
+data InsertTxConflictCtx
+  = InsertTxConflictCtx
+  { itcAction     :: !ConflictAction
+  , itcConstraint :: !(Maybe ConstraintName)
+  } deriving (Show, Eq)
+$(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''InsertTxConflictCtx)
+
 type UpdVals = M.HashMap PGCol Value
 
 data UpdateQuery