2018-10-05 18:13:51 +03:00
|
|
|
module Hasura.GraphQL.Resolve.Insert
|
2020-02-13 20:38:23 +03:00
|
|
|
( convertInsert
|
|
|
|
, convertInsertOne
|
|
|
|
)
|
2018-10-05 18:13:51 +03:00
|
|
|
where
|
|
|
|
|
2019-10-09 13:09:20 +03:00
|
|
|
import Control.Arrow ((>>>))
|
2018-10-05 18:13:51 +03:00
|
|
|
import Data.Has
|
2019-03-18 19:22:21 +03:00
|
|
|
import Hasura.EncJSON
|
2018-10-05 18:13:51 +03:00
|
|
|
import Hasura.Prelude
|
|
|
|
|
|
|
|
import qualified Data.Aeson as J
|
2018-11-02 17:01:01 +03:00
|
|
|
import qualified Data.Aeson.Casing as J
|
|
|
|
import qualified Data.Aeson.TH as J
|
2018-10-05 18:13:51 +03:00
|
|
|
import qualified Data.HashMap.Strict as Map
|
2018-10-12 13:36:47 +03:00
|
|
|
import qualified Data.HashMap.Strict.InsOrd as OMap
|
2018-10-05 18:13:51 +03:00
|
|
|
import qualified Data.Sequence as Seq
|
|
|
|
import qualified Data.Text as T
|
|
|
|
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.SQL.DML as S
|
|
|
|
|
2019-10-09 13:09:20 +03:00
|
|
|
import Hasura.GraphQL.Resolve.BoolExp
|
2018-10-05 18:13:51 +03:00
|
|
|
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
|
2020-02-13 10:38:49 +03:00
|
|
|
import Hasura.RQL.DML.Insert (insertOrUpdateCheckExpr)
|
2020-02-13 20:38:23 +03:00
|
|
|
import Hasura.RQL.DML.Internal (convAnnBoolExpPartialSQL, convPartialSQLExp,
|
|
|
|
dmlTxErrorHandler, sessVarFromCurrentSetting)
|
2019-03-07 13:24:07 +03:00
|
|
|
import Hasura.RQL.DML.Mutation
|
2018-12-15 19:10:29 +03:00
|
|
|
import Hasura.RQL.GBoolExp (toSQLBoolExp)
|
2018-10-05 18:13:51 +03:00
|
|
|
import Hasura.RQL.Types
|
|
|
|
import Hasura.SQL.Types
|
|
|
|
import Hasura.SQL.Value
|
|
|
|
|
2020-02-04 18:34:17 +03:00
|
|
|
type ColumnValuesText = ColumnValues TxtEncodedPGVal
|
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
newtype InsResp
|
|
|
|
= InsResp
|
|
|
|
{ _irResponse :: Maybe J.Object
|
|
|
|
} deriving (Show, Eq)
|
|
|
|
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''InsResp)
|
|
|
|
|
|
|
|
data AnnIns a
|
|
|
|
= AnnIns
|
|
|
|
{ _aiInsObj :: !a
|
|
|
|
, _aiConflictClause :: !(Maybe RI.ConflictClauseP1)
|
2020-02-13 10:38:49 +03:00
|
|
|
, _aiCheckCond :: !(AnnBoolExpPartialSQL, Maybe AnnBoolExpPartialSQL)
|
2019-08-11 18:34:38 +03:00
|
|
|
, _aiTableCols :: ![PGColumnInfo]
|
2018-11-02 17:01:01 +03:00
|
|
|
, _aiDefVals :: !(Map.HashMap PGCol S.SQLExp)
|
2019-03-07 13:24:07 +03:00
|
|
|
} deriving (Show, Eq, Functor, Foldable, Traversable)
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
type SingleObjIns = AnnIns AnnInsObj
|
|
|
|
type MultiObjIns = AnnIns [AnnInsObj]
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2019-03-07 13:24:07 +03:00
|
|
|
multiToSingles :: MultiObjIns -> [SingleObjIns]
|
|
|
|
multiToSingles = sequenceA
|
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
data RelIns a
|
|
|
|
= RelIns
|
|
|
|
{ _riAnnIns :: !a
|
|
|
|
, _riRelInfo :: !RelInfo
|
|
|
|
} deriving (Show, Eq)
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
type ObjRelIns = RelIns SingleObjIns
|
|
|
|
type ArrRelIns = RelIns MultiObjIns
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2019-08-11 18:34:38 +03:00
|
|
|
type PGColWithValue = (PGCol, WithScalarType PGScalarValue)
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2019-03-07 13:24:07 +03:00
|
|
|
data CTEExp
|
|
|
|
= CTEExp
|
|
|
|
{ _iweExp :: !S.CTE
|
|
|
|
, _iwePrepArgs :: !(Seq.Seq Q.PrepArg)
|
2018-11-02 17:01:01 +03:00
|
|
|
} deriving (Show, Eq)
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
data AnnInsObj
|
|
|
|
= AnnInsObj
|
2019-07-22 15:47:13 +03:00
|
|
|
{ _aioColumns :: ![PGColWithValue]
|
2018-11-02 17:01:01 +03:00
|
|
|
, _aioObjRels :: ![ObjRelIns]
|
|
|
|
, _aioArrRels :: ![ArrRelIns]
|
|
|
|
} deriving (Show, Eq)
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
mkAnnInsObj
|
2019-10-16 17:33:34 +03:00
|
|
|
:: (MonadReusability m, MonadError QErr m, Has InsCtxMap r, MonadReader r m, Has FieldMap r)
|
2018-11-02 17:01:01 +03:00
|
|
|
=> RelationInfoMap
|
2019-09-19 07:47:36 +03:00
|
|
|
-> PGColGNameMap
|
2018-11-02 17:01:01 +03:00
|
|
|
-> AnnGObject
|
|
|
|
-> m AnnInsObj
|
2019-09-19 07:47:36 +03:00
|
|
|
mkAnnInsObj relInfoMap allColMap annObj =
|
|
|
|
foldrM (traverseInsObj relInfoMap allColMap) emptyInsObj $ OMap.toList annObj
|
2018-10-05 18:13:51 +03:00
|
|
|
where
|
2018-11-02 17:01:01 +03:00
|
|
|
emptyInsObj = AnnInsObj [] [] []
|
|
|
|
|
|
|
|
traverseInsObj
|
2019-10-16 17:33:34 +03:00
|
|
|
:: (MonadReusability m, MonadError QErr m, Has InsCtxMap r, MonadReader r m, Has FieldMap r)
|
2018-11-02 17:01:01 +03:00
|
|
|
=> RelationInfoMap
|
2019-09-19 07:47:36 +03:00
|
|
|
-> PGColGNameMap
|
2019-03-20 09:31:49 +03:00
|
|
|
-> (G.Name, AnnInpVal)
|
2018-11-02 17:01:01 +03:00
|
|
|
-> AnnInsObj
|
|
|
|
-> m AnnInsObj
|
2019-09-19 07:47:36 +03:00
|
|
|
traverseInsObj rim allColMap (gName, annVal) defVal@(AnnInsObj cols objRels arrRels) =
|
2019-03-20 09:31:49 +03:00
|
|
|
case _aivValue annVal of
|
2019-07-22 15:47:13 +03:00
|
|
|
AGScalar{} -> parseValue
|
|
|
|
AGEnum{} -> parseValue
|
|
|
|
_ -> parseObject
|
|
|
|
where
|
|
|
|
parseValue = do
|
2019-08-11 18:34:38 +03:00
|
|
|
(_, WithScalarType scalarType maybeScalarValue) <- asPGColumnTypeAndValueM annVal
|
2019-09-19 07:47:36 +03:00
|
|
|
columnInfo <- onNothing (Map.lookup gName allColMap) $
|
|
|
|
throw500 "column not found in PGColGNameMap"
|
|
|
|
let columnName = pgiColumn columnInfo
|
2019-09-14 09:01:06 +03:00
|
|
|
scalarValue <- maybe (pure $ PGNull scalarType) openOpaqueValue maybeScalarValue
|
2019-08-11 18:34:38 +03:00
|
|
|
pure $ AnnInsObj ((columnName, WithScalarType scalarType scalarValue):cols) objRels arrRels
|
2018-11-02 17:01:01 +03:00
|
|
|
|
2019-07-22 15:47:13 +03:00
|
|
|
parseObject = do
|
2019-01-11 10:22:58 +03:00
|
|
|
objM <- asObjectM annVal
|
|
|
|
-- if relational insert input is 'null' then ignore
|
|
|
|
-- return default value
|
|
|
|
fmap (fromMaybe defVal) $ forM objM $ \obj -> do
|
2019-07-11 12:00:45 +03:00
|
|
|
let relNameM = RelName <$> mkNonEmptyText (G.unName gName)
|
2019-01-11 10:22:58 +03:00
|
|
|
onConflictM = OMap.lookup "on_conflict" obj
|
2019-07-11 12:00:45 +03:00
|
|
|
relName <- onNothing relNameM $ throw500 "found empty GName String"
|
2019-01-11 10:22:58 +03:00
|
|
|
dataVal <- onNothing (OMap.lookup "data" obj) $
|
|
|
|
throw500 "\"data\" object not found"
|
|
|
|
relInfo <- onNothing (Map.lookup relName rim) $
|
|
|
|
throw500 $ "relation " <> relName <<> " not found"
|
|
|
|
|
|
|
|
let rTable = riRTable relInfo
|
2020-01-16 07:53:28 +03:00
|
|
|
InsCtx rtColMap checkCond rtDefVals rtRelInfoMap rtUpdPerm <- getInsCtx rTable
|
2019-09-19 07:47:36 +03:00
|
|
|
let rtCols = Map.elems rtColMap
|
2019-07-22 15:47:13 +03:00
|
|
|
rtDefValsRes <- mapM (convPartialSQLExp sessVarFromCurrentSetting) rtDefVals
|
2019-01-11 10:22:58 +03:00
|
|
|
|
|
|
|
withPathK (G.unName gName) $ case riType relInfo of
|
|
|
|
ObjRel -> do
|
|
|
|
dataObj <- asObject dataVal
|
2019-09-19 07:47:36 +03:00
|
|
|
annDataObj <- mkAnnInsObj rtRelInfoMap rtColMap dataObj
|
|
|
|
ccM <- forM onConflictM $ parseOnConflict rTable rtUpdPerm rtColMap
|
2020-02-13 10:38:49 +03:00
|
|
|
let singleObjIns = AnnIns annDataObj ccM (checkCond, rtUpdPerm >>= upfiCheck) rtCols rtDefValsRes
|
2019-01-11 10:22:58 +03:00
|
|
|
objRelIns = RelIns singleObjIns relInfo
|
|
|
|
return (AnnInsObj cols (objRelIns:objRels) arrRels)
|
|
|
|
|
|
|
|
ArrRel -> do
|
|
|
|
arrDataVals <- asArray dataVal
|
|
|
|
let withNonEmptyArrData = do
|
|
|
|
annDataObjs <- forM arrDataVals $ \arrDataVal -> do
|
|
|
|
dataObj <- asObject arrDataVal
|
2019-09-19 07:47:36 +03:00
|
|
|
mkAnnInsObj rtRelInfoMap rtColMap dataObj
|
|
|
|
ccM <- forM onConflictM $ parseOnConflict rTable rtUpdPerm rtColMap
|
2020-02-13 10:38:49 +03:00
|
|
|
let multiObjIns = AnnIns annDataObjs ccM (checkCond, rtUpdPerm >>= upfiCheck) rtCols rtDefValsRes
|
2019-01-11 10:22:58 +03:00
|
|
|
arrRelIns = RelIns multiObjIns relInfo
|
|
|
|
return (AnnInsObj cols objRels (arrRelIns:arrRels))
|
|
|
|
-- if array relation insert input data has empty objects
|
|
|
|
-- then ignore and return default value
|
|
|
|
bool withNonEmptyArrData (return defVal) $ null arrDataVals
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
parseOnConflict
|
2019-10-16 17:33:34 +03:00
|
|
|
:: (MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r)
|
2019-09-19 07:47:36 +03:00
|
|
|
=> QualifiedTable
|
|
|
|
-> Maybe UpdPermForIns
|
|
|
|
-> PGColGNameMap
|
|
|
|
-> AnnInpVal
|
|
|
|
-> m RI.ConflictClauseP1
|
|
|
|
parseOnConflict tn updFiltrM allColMap val = withPathK "on_conflict" $
|
2018-10-05 18:13:51 +03:00
|
|
|
flip withObject val $ \_ obj -> do
|
2019-12-09 07:18:53 +03:00
|
|
|
constraint <- RI.CTConstraint <$> parseConstraint obj
|
2018-12-15 19:10:29 +03:00
|
|
|
updCols <- getUpdCols obj
|
|
|
|
case updCols of
|
|
|
|
[] -> return $ RI.CP1DoNothing $ Just constraint
|
|
|
|
_ -> do
|
2020-02-13 10:38:49 +03:00
|
|
|
UpdPermForIns _ _ updFiltr preSet <- onNothing updFiltrM $ throw500
|
2018-12-15 19:10:29 +03:00
|
|
|
"cannot update columns since update permission is not defined"
|
2019-04-17 12:48:41 +03:00
|
|
|
preSetRes <- mapM (convPartialSQLExp sessVarFromCurrentSetting) preSet
|
|
|
|
updFltrRes <- traverseAnnBoolExp
|
|
|
|
(convPartialSQLExp sessVarFromCurrentSetting)
|
|
|
|
updFiltr
|
2019-10-09 13:09:20 +03:00
|
|
|
whereExp <- parseWhereExp obj
|
|
|
|
let updateBoolExp = toSQLBoolExp (S.mkQual tn) updFltrRes
|
|
|
|
whereCondition = S.BEBin S.AndOp updateBoolExp whereExp
|
|
|
|
return $ RI.CP1Update constraint updCols preSetRes whereCondition
|
2018-12-15 19:10:29 +03:00
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
where
|
2018-12-15 19:10:29 +03:00
|
|
|
getUpdCols o = do
|
|
|
|
updColsVal <- onNothing (OMap.lookup "update_columns" o) $ throw500
|
|
|
|
"\"update_columns\" argument in expected in \"on_conflict\" field "
|
2019-09-19 07:47:36 +03:00
|
|
|
parseColumns allColMap updColsVal
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
parseConstraint o = do
|
|
|
|
v <- onNothing (OMap.lookup "constraint" o) $ throw500
|
|
|
|
"\"constraint\" is expected, but not found"
|
|
|
|
(_, enumVal) <- asEnumVal v
|
|
|
|
return $ ConstraintName $ G.unName $ G.unEnumValue enumVal
|
|
|
|
|
2019-10-09 13:09:20 +03:00
|
|
|
parseWhereExp =
|
|
|
|
OMap.lookup "where"
|
|
|
|
>>> traverse (parseBoolExp >=> traverse (traverse resolveValTxt))
|
|
|
|
>>> fmap (maybe (S.BELit True) (toSQLBoolExp (S.mkQual tn)))
|
|
|
|
|
2019-03-20 09:31:49 +03:00
|
|
|
toSQLExps
|
|
|
|
:: (MonadError QErr m, MonadState PrepArgs m)
|
2019-07-22 15:47:13 +03:00
|
|
|
=> [PGColWithValue]
|
2019-03-20 09:31:49 +03:00
|
|
|
-> m [(PGCol, S.SQLExp)]
|
2018-10-05 18:13:51 +03:00
|
|
|
toSQLExps cols =
|
2019-07-22 15:47:13 +03:00
|
|
|
forM cols $ \(c, v) -> do
|
|
|
|
prepExp <- prepareColVal v
|
2018-10-05 18:13:51 +03:00
|
|
|
return (c, prepExp)
|
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
mkSQLRow :: Map.HashMap PGCol S.SQLExp -> [(PGCol, S.SQLExp)] -> [S.SQLExp]
|
2019-09-19 07:47:36 +03:00
|
|
|
mkSQLRow defVals withPGCol = map snd $
|
|
|
|
flip map (Map.toList defVals) $
|
|
|
|
\(col, defVal) -> (col,) $ fromMaybe defVal $ Map.lookup col withPGColMap
|
|
|
|
where
|
|
|
|
withPGColMap = Map.fromList withPGCol
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2019-03-20 09:31:49 +03:00
|
|
|
mkInsertQ
|
|
|
|
:: MonadError QErr m
|
|
|
|
=> QualifiedTable
|
|
|
|
-> Maybe RI.ConflictClauseP1
|
2019-07-22 15:47:13 +03:00
|
|
|
-> [PGColWithValue]
|
2019-03-20 09:31:49 +03:00
|
|
|
-> Map.HashMap PGCol S.SQLExp
|
|
|
|
-> RoleName
|
2020-02-13 10:38:49 +03:00
|
|
|
-> (AnnBoolExpSQL, Maybe AnnBoolExpSQL)
|
2020-01-16 07:53:28 +03:00
|
|
|
-> m CTEExp
|
2020-02-13 10:38:49 +03:00
|
|
|
mkInsertQ tn onConflictM insCols defVals role (insCheck, updCheck) = do
|
2018-10-05 18:13:51 +03:00
|
|
|
(givenCols, args) <- flip runStateT Seq.Empty $ toSQLExps insCols
|
|
|
|
let sqlConflict = RI.toSQLConflict <$> onConflictM
|
2018-11-02 17:01:01 +03:00
|
|
|
sqlExps = mkSQLRow defVals givenCols
|
2019-03-22 10:08:42 +03:00
|
|
|
valueExp = S.ValuesExp [S.TupleExp sqlExps]
|
2019-09-19 07:47:36 +03:00
|
|
|
tableCols = Map.keys defVals
|
|
|
|
sqlInsert =
|
2020-02-04 18:34:17 +03:00
|
|
|
S.SQLInsert tn tableCols valueExp sqlConflict
|
2020-01-16 07:53:28 +03:00
|
|
|
. Just
|
|
|
|
$ S.RetExp
|
|
|
|
[ S.selectStar
|
2020-02-13 10:38:49 +03:00
|
|
|
, S.Extractor
|
|
|
|
(insertOrUpdateCheckExpr tn onConflictM
|
|
|
|
(toSQLBoolExp (S.QualTable tn) insCheck)
|
|
|
|
(fmap (toSQLBoolExp (S.QualTable tn)) updCheck))
|
|
|
|
Nothing
|
2020-01-16 07:53:28 +03:00
|
|
|
]
|
2020-02-04 18:34:17 +03:00
|
|
|
|
2020-01-16 07:53:28 +03:00
|
|
|
adminIns = return (CTEExp (S.CTEInsert sqlInsert) args)
|
2018-11-02 17:01:01 +03:00
|
|
|
nonAdminInsert = do
|
2020-01-16 07:53:28 +03:00
|
|
|
let cteIns = S.CTEInsert sqlInsert
|
|
|
|
return (CTEExp cteIns args)
|
2018-11-02 17:01:01 +03:00
|
|
|
|
|
|
|
bool nonAdminInsert adminIns $ isAdmin role
|
|
|
|
|
2019-03-07 13:24:07 +03:00
|
|
|
fetchFromColVals
|
|
|
|
:: MonadError QErr m
|
2020-02-04 18:34:17 +03:00
|
|
|
=> ColumnValuesText
|
2019-08-11 18:34:38 +03:00
|
|
|
-> [PGColumnInfo]
|
2020-02-04 18:34:17 +03:00
|
|
|
-> m [(PGCol, WithScalarType PGScalarValue)]
|
|
|
|
fetchFromColVals colVal reqCols =
|
2019-03-07 13:24:07 +03:00
|
|
|
forM reqCols $ \ci -> do
|
2019-09-19 07:47:36 +03:00
|
|
|
let valM = Map.lookup (pgiColumn ci) colVal
|
2019-03-07 13:24:07 +03:00
|
|
|
val <- onNothing valM $ throw500 $ "column "
|
2019-09-19 07:47:36 +03:00
|
|
|
<> pgiColumn ci <<> " not found in given colVal"
|
2020-02-04 18:34:17 +03:00
|
|
|
pgColVal <- parseTxtEncodedPGValue (pgiType ci) val
|
|
|
|
return (pgiColumn ci, pgColVal)
|
2018-11-02 17:01:01 +03:00
|
|
|
|
|
|
|
-- | validate an insert object based on insert columns,
|
|
|
|
-- | insert object relations and additional columns from parent
|
|
|
|
validateInsert
|
2018-10-05 18:13:51 +03:00
|
|
|
:: (MonadError QErr m)
|
2018-11-02 17:01:01 +03:00
|
|
|
=> [PGCol] -- ^ inserting columns
|
|
|
|
-> [RelInfo] -- ^ object relation inserts
|
|
|
|
-> [PGCol] -- ^ additional fields from parent
|
|
|
|
-> m ()
|
|
|
|
validateInsert insCols objRels addCols = do
|
|
|
|
-- validate insertCols
|
|
|
|
unless (null insConflictCols) $ throwVE $
|
2018-12-15 19:10:29 +03:00
|
|
|
"cannot insert " <> showPGCols insConflictCols
|
2018-11-02 17:01:01 +03:00
|
|
|
<> " columns as their values are already being determined by parent insert"
|
|
|
|
|
|
|
|
forM_ objRels $ \relInfo -> do
|
2019-12-13 00:46:33 +03:00
|
|
|
let lCols = Map.keys $ riMapping relInfo
|
2018-11-02 17:01:01 +03:00
|
|
|
relName = riName relInfo
|
2019-07-11 12:00:45 +03:00
|
|
|
relNameTxt = relNameToTxt relName
|
2018-11-02 17:01:01 +03:00
|
|
|
lColConflicts = lCols `intersect` (addCols <> insCols)
|
|
|
|
withPathK relNameTxt $ unless (null lColConflicts) $ throwVE $
|
|
|
|
"cannot insert object relation ship " <> relName
|
2018-12-15 19:10:29 +03:00
|
|
|
<<> " as " <> showPGCols lColConflicts
|
2018-11-02 17:01:01 +03:00
|
|
|
<> " column values are already determined"
|
|
|
|
where
|
|
|
|
insConflictCols = insCols `intersect` addCols
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
-- | insert an object relationship and return affected rows
|
|
|
|
-- | and parent dependent columns
|
|
|
|
insertObjRel
|
2019-03-01 14:45:04 +03:00
|
|
|
:: Bool
|
|
|
|
-> RoleName
|
2018-11-02 17:01:01 +03:00
|
|
|
-> ObjRelIns
|
2018-10-05 18:13:51 +03:00
|
|
|
-> Q.TxE QErr (Int, [PGColWithValue])
|
2019-03-01 14:45:04 +03:00
|
|
|
insertObjRel strfyNum role objRelIns =
|
2018-10-05 18:13:51 +03:00
|
|
|
withPathK relNameTxt $ do
|
2020-02-04 18:34:17 +03:00
|
|
|
(affRows, colValM) <- withPathK "data" $ insertObj strfyNum role tn singleObjIns []
|
2019-03-07 13:24:07 +03:00
|
|
|
colVal <- onNothing colValM $ throw400 NotSupported errMsg
|
2020-02-04 18:34:17 +03:00
|
|
|
retColsWithVals <- fetchFromColVals colVal rColInfos
|
2019-12-13 00:46:33 +03:00
|
|
|
let c = mergeListsWith (Map.toList mapCols) retColsWithVals
|
2018-10-05 18:13:51 +03:00
|
|
|
(\(_, rCol) (col, _) -> rCol == col)
|
2019-03-07 13:24:07 +03:00
|
|
|
(\(lCol, _) (_, cVal) -> (lCol, cVal))
|
2020-02-04 18:34:17 +03:00
|
|
|
return (affRows, c)
|
2018-10-05 18:13:51 +03:00
|
|
|
where
|
2018-11-02 17:01:01 +03:00
|
|
|
RelIns singleObjIns relInfo = objRelIns
|
2020-02-04 18:34:17 +03:00
|
|
|
-- multiObjIns = singleToMulti singleObjIns
|
2018-10-05 18:13:51 +03:00
|
|
|
relName = riName relInfo
|
2019-07-11 12:00:45 +03:00
|
|
|
relNameTxt = relNameToTxt relName
|
2018-10-05 18:13:51 +03:00
|
|
|
mapCols = riMapping relInfo
|
|
|
|
tn = riRTable relInfo
|
2018-11-02 17:01:01 +03:00
|
|
|
allCols = _aiTableCols singleObjIns
|
2019-12-13 00:46:33 +03:00
|
|
|
rCols = Map.elems mapCols
|
2019-03-07 13:24:07 +03:00
|
|
|
rColInfos = getColInfos rCols allCols
|
|
|
|
errMsg = "cannot proceed to insert object relation "
|
|
|
|
<> relName <<> " since insert to table "
|
|
|
|
<> tn <<> " affects zero rows"
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2019-03-18 19:22:21 +03:00
|
|
|
decodeEncJSON :: (J.FromJSON a, QErrM m) => EncJSON -> m a
|
|
|
|
decodeEncJSON =
|
|
|
|
either (throw500 . T.pack) decodeValue .
|
|
|
|
J.eitherDecode . encJToLBS
|
|
|
|
|
2018-10-05 18:13:51 +03:00
|
|
|
-- | insert an array relationship and return affected rows
|
|
|
|
insertArrRel
|
2019-03-01 14:45:04 +03:00
|
|
|
:: Bool
|
|
|
|
-> RoleName
|
2018-10-05 18:13:51 +03:00
|
|
|
-> [PGColWithValue]
|
2018-11-02 17:01:01 +03:00
|
|
|
-> ArrRelIns
|
2018-10-05 18:13:51 +03:00
|
|
|
-> Q.TxE QErr Int
|
2019-03-01 14:45:04 +03:00
|
|
|
insertArrRel strfyNum role resCols arrRelIns =
|
2018-10-05 18:13:51 +03:00
|
|
|
withPathK relNameTxt $ do
|
2019-12-13 00:46:33 +03:00
|
|
|
let addCols = mergeListsWith resCols (Map.toList colMapping)
|
2018-10-05 18:13:51 +03:00
|
|
|
(\(col, _) (lCol, _) -> col == lCol)
|
|
|
|
(\(_, colVal) (_, rCol) -> (rCol, colVal))
|
|
|
|
|
2020-02-13 20:38:23 +03:00
|
|
|
resBS <- insertMultipleObjects strfyNum role tn multiObjIns addCols mutOutput "data"
|
2019-03-18 19:22:21 +03:00
|
|
|
resObj <- decodeEncJSON resBS
|
2018-10-05 18:13:51 +03:00
|
|
|
onNothing (Map.lookup ("affected_rows" :: T.Text) resObj) $
|
|
|
|
throw500 "affected_rows not returned in array rel insert"
|
|
|
|
where
|
2018-11-02 17:01:01 +03:00
|
|
|
RelIns multiObjIns relInfo = arrRelIns
|
2018-10-05 18:13:51 +03:00
|
|
|
colMapping = riMapping relInfo
|
|
|
|
tn = riRTable relInfo
|
2019-07-11 12:00:45 +03:00
|
|
|
relNameTxt = relNameToTxt $ riName relInfo
|
2020-02-13 20:38:23 +03:00
|
|
|
mutOutput = RR.MOutMultirowFields [("affected_rows", RR.MCount)]
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
-- | insert an object with object and array relationships
|
|
|
|
insertObj
|
2019-03-01 14:45:04 +03:00
|
|
|
:: Bool
|
|
|
|
-> RoleName
|
2018-10-05 18:13:51 +03:00
|
|
|
-> QualifiedTable
|
2018-11-02 17:01:01 +03:00
|
|
|
-> SingleObjIns
|
2018-10-05 18:13:51 +03:00
|
|
|
-> [PGColWithValue] -- ^ additional fields
|
2020-02-04 18:34:17 +03:00
|
|
|
-> Q.TxE QErr (Int, Maybe ColumnValuesText)
|
2019-03-01 14:45:04 +03:00
|
|
|
insertObj strfyNum role tn singleObjIns addCols = do
|
2018-10-05 18:13:51 +03:00
|
|
|
-- validate insert
|
2019-07-22 15:47:13 +03:00
|
|
|
validateInsert (map fst cols) (map _riRelInfo objRels) $ map fst addCols
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
-- insert all object relations and fetch this insert dependent column values
|
2019-03-01 14:45:04 +03:00
|
|
|
objInsRes <- forM objRels $ insertObjRel strfyNum role
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
-- prepare final insert columns
|
2019-03-07 13:24:07 +03:00
|
|
|
let objRelAffRows = sum $ map fst objInsRes
|
2018-10-05 18:13:51 +03:00
|
|
|
objRelDeterminedCols = concatMap snd objInsRes
|
2019-07-22 15:47:13 +03:00
|
|
|
finalInsCols = cols <> objRelDeterminedCols <> addCols
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
-- prepare insert query as with expression
|
2020-02-13 10:38:49 +03:00
|
|
|
insCheck <- convAnnBoolExpPartialSQL sessVarFromCurrentSetting insCond
|
|
|
|
updCheck <- traverse (convAnnBoolExpPartialSQL sessVarFromCurrentSetting) updCond
|
2020-02-13 20:38:23 +03:00
|
|
|
|
2020-02-13 10:38:49 +03:00
|
|
|
CTEExp cte insPArgs <-
|
|
|
|
mkInsertQ tn onConflictM finalInsCols defVals role (insCheck, updCheck)
|
2019-03-07 13:24:07 +03:00
|
|
|
|
2019-03-22 10:08:42 +03:00
|
|
|
MutateResp affRows colVals <- mutateAndFetchCols tn allCols (cte, insPArgs) strfyNum
|
2019-03-07 13:24:07 +03:00
|
|
|
colValM <- asSingleObject colVals
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2019-03-22 10:08:42 +03:00
|
|
|
arrRelAffRows <- bool (withArrRels colValM) (return 0) $ null arrRels
|
2019-03-07 13:24:07 +03:00
|
|
|
let totAffRows = objRelAffRows + affRows + arrRelAffRows
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2020-02-04 18:34:17 +03:00
|
|
|
return (totAffRows, colValM)
|
2018-10-05 18:13:51 +03:00
|
|
|
where
|
2020-02-13 10:38:49 +03:00
|
|
|
AnnIns annObj onConflictM (insCond, updCond) allCols defVals = singleObjIns
|
2018-11-02 17:01:01 +03:00
|
|
|
AnnInsObj cols objRels arrRels = annObj
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2019-03-22 10:08:42 +03:00
|
|
|
arrRelDepCols = flip getColInfos allCols $
|
2019-12-13 00:46:33 +03:00
|
|
|
concatMap (Map.keys . riMapping . _riRelInfo) arrRels
|
2019-03-22 10:08:42 +03:00
|
|
|
|
|
|
|
withArrRels colValM = do
|
2019-03-07 13:24:07 +03:00
|
|
|
colVal <- onNothing colValM $ throw400 NotSupported cannotInsArrRelErr
|
2020-02-04 18:34:17 +03:00
|
|
|
arrDepColsWithVal <- fetchFromColVals colVal arrRelDepCols
|
2019-03-01 14:45:04 +03:00
|
|
|
arrInsARows <- forM arrRels $ insertArrRel strfyNum role arrDepColsWithVal
|
2019-03-07 13:24:07 +03:00
|
|
|
return $ sum arrInsARows
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2020-02-04 18:34:17 +03:00
|
|
|
asSingleObject = \case
|
|
|
|
[] -> pure Nothing
|
|
|
|
[r] -> pure $ Just r
|
|
|
|
_ -> throw500 "more than one row returned"
|
|
|
|
|
2018-11-02 17:01:01 +03:00
|
|
|
cannotInsArrRelErr =
|
2018-10-05 18:13:51 +03:00
|
|
|
"cannot proceed to insert array relations since insert to table "
|
|
|
|
<> tn <<> " affects zero rows"
|
|
|
|
|
|
|
|
|
|
|
|
-- | insert multiple Objects in postgres
|
|
|
|
insertMultipleObjects
|
2019-03-01 14:45:04 +03:00
|
|
|
:: Bool
|
|
|
|
-> RoleName
|
2018-11-02 17:01:01 +03:00
|
|
|
-> QualifiedTable
|
|
|
|
-> MultiObjIns
|
2018-10-05 18:13:51 +03:00
|
|
|
-> [PGColWithValue] -- ^ additional fields
|
2020-02-13 20:38:23 +03:00
|
|
|
-> RR.MutationOutput
|
2018-11-02 17:01:01 +03:00
|
|
|
-> T.Text -- ^ error path
|
2019-03-18 19:22:21 +03:00
|
|
|
-> Q.TxE QErr EncJSON
|
2020-02-13 20:38:23 +03:00
|
|
|
insertMultipleObjects strfyNum role tn multiObjIns addCols mutOutput errP =
|
2018-11-02 17:01:01 +03:00
|
|
|
bool withoutRelsInsert withRelsInsert anyRelsToInsert
|
2018-10-05 18:13:51 +03:00
|
|
|
where
|
2020-02-13 10:38:49 +03:00
|
|
|
AnnIns insObjs onConflictM (insCond, updCond) tableColInfos defVals = multiObjIns
|
2019-03-07 13:24:07 +03:00
|
|
|
singleObjInserts = multiToSingles multiObjIns
|
2018-11-02 17:01:01 +03:00
|
|
|
insCols = map _aioColumns insObjs
|
|
|
|
allInsObjRels = concatMap _aioObjRels insObjs
|
|
|
|
allInsArrRels = concatMap _aioArrRels insObjs
|
|
|
|
anyRelsToInsert = not $ null allInsArrRels && null allInsObjRels
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
withErrPath = withPathK errP
|
|
|
|
|
|
|
|
-- insert all column rows at one go
|
2018-11-02 17:01:01 +03:00
|
|
|
withoutRelsInsert = withErrPath $ do
|
2018-10-05 18:13:51 +03:00
|
|
|
indexedForM_ insCols $ \insCol ->
|
2019-07-22 15:47:13 +03:00
|
|
|
validateInsert (map fst insCol) [] $ map fst addCols
|
2018-10-05 18:13:51 +03:00
|
|
|
|
2019-07-22 15:47:13 +03:00
|
|
|
let withAddCols = flip map insCols $ union addCols
|
2019-09-19 07:47:36 +03:00
|
|
|
tableCols = Map.keys defVals
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
(sqlRows, prepArgs) <- flip runStateT Seq.Empty $ do
|
2019-03-20 09:31:49 +03:00
|
|
|
rowsWithCol <- mapM toSQLExps withAddCols
|
2018-11-02 17:01:01 +03:00
|
|
|
return $ map (mkSQLRow defVals) rowsWithCol
|
2020-02-04 18:34:17 +03:00
|
|
|
|
2020-02-13 10:38:49 +03:00
|
|
|
insCheck <- convAnnBoolExpPartialSQL sessVarFromCurrentSetting insCond
|
|
|
|
updCheck <- traverse (convAnnBoolExpPartialSQL sessVarFromCurrentSetting) updCond
|
2020-02-13 20:38:23 +03:00
|
|
|
|
|
|
|
let insQP1 = RI.InsertQueryP1 tn tableCols sqlRows onConflictM
|
|
|
|
(insCheck, updCheck) mutOutput tableColInfos
|
2018-10-05 18:13:51 +03:00
|
|
|
p1 = (insQP1, prepArgs)
|
2020-01-16 07:53:28 +03:00
|
|
|
RI.insertP2 strfyNum p1
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
-- insert each object with relations
|
|
|
|
withRelsInsert = withErrPath $ do
|
2018-11-02 17:01:01 +03:00
|
|
|
insResps <- indexedForM singleObjInserts $ \objIns ->
|
2019-03-01 14:45:04 +03:00
|
|
|
insertObj strfyNum role tn objIns addCols
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
let affRows = sum $ map fst insResps
|
2020-02-04 18:34:17 +03:00
|
|
|
columnValues = catMaybes $ map snd insResps
|
|
|
|
cteExp <- mkSelCTEFromColVals tn tableColInfos columnValues
|
2020-02-13 20:38:23 +03:00
|
|
|
let sql = toSQL $ RR.mkMutationOutputExp tn (Just affRows) cteExp mutOutput strfyNum
|
2020-02-04 18:34:17 +03:00
|
|
|
runIdentity . Q.getRow
|
|
|
|
<$> Q.rawQE dmlTxErrorHandler (Q.fromBuilder sql) [] False
|
2018-10-05 18:13:51 +03:00
|
|
|
|
|
|
|
prefixErrPath :: (MonadError QErr m) => Field -> m a -> m a
|
|
|
|
prefixErrPath fld =
|
|
|
|
withPathK "selectionSet" . fieldAsPath fld . withPathK "args"
|
|
|
|
|
|
|
|
convertInsert
|
2019-10-16 17:33:34 +03:00
|
|
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
2019-04-17 12:48:41 +03:00
|
|
|
, Has OrdByCtx r, Has SQLGenCtx r, Has InsCtxMap r
|
|
|
|
)
|
|
|
|
=> RoleName
|
2018-10-05 18:13:51 +03:00
|
|
|
-> QualifiedTable -- table
|
|
|
|
-> Field -- the mutation field
|
2019-04-17 12:48:41 +03:00
|
|
|
-> m RespTx
|
2018-10-05 18:13:51 +03:00
|
|
|
convertInsert role tn fld = prefixErrPath fld $ do
|
2020-02-13 20:38:23 +03:00
|
|
|
mutOutputUnres <- RR.MOutMultirowFields <$> resolveMutationFields (_fType fld) (_fSelSet fld)
|
|
|
|
mutOutputRes <- RR.traverseMutationOutput resolveValTxt mutOutputUnres
|
2019-01-11 10:22:58 +03:00
|
|
|
annVals <- withArg arguments "objects" asArray
|
|
|
|
-- if insert input objects is empty array then
|
|
|
|
-- do not perform insert and return mutation response
|
2020-02-13 20:38:23 +03:00
|
|
|
bool (withNonEmptyObjs annVals mutOutputRes)
|
|
|
|
(withEmptyObjs mutOutputRes) $ null annVals
|
2018-10-05 18:13:51 +03:00
|
|
|
where
|
2020-02-13 20:38:23 +03:00
|
|
|
withNonEmptyObjs annVals mutOutput = do
|
2020-01-16 07:53:28 +03:00
|
|
|
InsCtx tableColMap checkCond defValMap relInfoMap updPerm <- getInsCtx tn
|
2019-09-19 07:47:36 +03:00
|
|
|
annObjs <- mapM asObject annVals
|
|
|
|
annInsObjs <- forM annObjs $ mkAnnInsObj relInfoMap tableColMap
|
|
|
|
conflictClauseM <- forM onConflictM $ parseOnConflict tn updPerm tableColMap
|
2019-04-17 12:48:41 +03:00
|
|
|
defValMapRes <- mapM (convPartialSQLExp sessVarFromCurrentSetting)
|
|
|
|
defValMap
|
2020-02-13 10:38:49 +03:00
|
|
|
let multiObjIns = AnnIns annInsObjs conflictClauseM (checkCond, updPerm >>= upfiCheck)
|
2020-01-16 07:53:28 +03:00
|
|
|
tableCols defValMapRes
|
2019-09-19 07:47:36 +03:00
|
|
|
tableCols = Map.elems tableColMap
|
2019-03-01 14:45:04 +03:00
|
|
|
strfyNum <- stringifyNum <$> asks getter
|
|
|
|
return $ prefixErrPath fld $ insertMultipleObjects strfyNum role tn
|
2020-02-13 20:38:23 +03:00
|
|
|
multiObjIns [] mutOutput "objects"
|
|
|
|
withEmptyObjs mutOutput =
|
|
|
|
return $ return $ buildEmptyMutResp mutOutput
|
2018-10-05 18:13:51 +03:00
|
|
|
arguments = _fArguments fld
|
|
|
|
onConflictM = Map.lookup "on_conflict" arguments
|
|
|
|
|
2020-02-13 20:38:23 +03:00
|
|
|
convertInsertOne
|
|
|
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
|
|
|
, Has OrdByCtx r, Has SQLGenCtx r, Has InsCtxMap r
|
|
|
|
)
|
|
|
|
=> RoleName
|
|
|
|
-> QualifiedTable -- table
|
|
|
|
-> Field -- the mutation field
|
|
|
|
-> m RespTx
|
|
|
|
convertInsertOne role qt field = prefixErrPath field $ do
|
|
|
|
tableSelFields <- processTableSelectionSet (_fType field) $ _fSelSet field
|
|
|
|
let mutationOutputUnresolved = RR.MOutSinglerowObject tableSelFields
|
|
|
|
mutationOutputResolved <- RR.traverseMutationOutput resolveValTxt mutationOutputUnresolved
|
|
|
|
annInputObj <- withArg arguments "object" asObject
|
|
|
|
InsCtx tableColMap checkCond defValMap relInfoMap updPerm <- getInsCtx qt
|
|
|
|
annInsertObj <- mkAnnInsObj relInfoMap tableColMap annInputObj
|
|
|
|
conflictClauseM <- forM (Map.lookup "on_conflict" arguments) $ parseOnConflict qt updPerm tableColMap
|
|
|
|
defValMapRes <- mapM (convPartialSQLExp sessVarFromCurrentSetting) defValMap
|
|
|
|
let multiObjIns = AnnIns [annInsertObj] conflictClauseM (checkCond, updPerm >>= upfiCheck)
|
|
|
|
tableCols defValMapRes
|
|
|
|
tableCols = Map.elems tableColMap
|
|
|
|
strfyNum <- stringifyNum <$> asks getter
|
|
|
|
pure $ prefixErrPath field $ insertMultipleObjects strfyNum role qt
|
|
|
|
multiObjIns [] mutationOutputResolved "object"
|
|
|
|
where
|
|
|
|
arguments = _fArguments field
|
|
|
|
|
2018-10-05 18:13:51 +03:00
|
|
|
-- helper functions
|
2018-12-15 19:10:29 +03:00
|
|
|
getInsCtx
|
2018-11-02 17:01:01 +03:00
|
|
|
:: (MonadError QErr m, MonadReader r m, Has InsCtxMap r)
|
2018-12-15 19:10:29 +03:00
|
|
|
=> QualifiedTable -> m InsCtx
|
|
|
|
getInsCtx tn = do
|
2018-11-02 17:01:01 +03:00
|
|
|
ctxMap <- asks getter
|
2018-12-15 19:10:29 +03:00
|
|
|
insCtx <- onNothing (Map.lookup tn ctxMap) $
|
2018-11-02 17:01:01 +03:00
|
|
|
throw500 $ "table " <> tn <<> " not found"
|
2019-09-19 07:47:36 +03:00
|
|
|
let defValMap = fmap PSESQLExp $ S.mkColDefValMap $ map pgiColumn $
|
|
|
|
Map.elems $ icAllCols insCtx
|
2018-12-15 19:10:29 +03:00
|
|
|
setCols = icSet insCtx
|
|
|
|
return $ insCtx {icSet = Map.union setCols defValMap}
|
2018-11-02 17:01:01 +03:00
|
|
|
|
2018-10-05 18:13:51 +03:00
|
|
|
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
|