mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
8a77386fcf
### Description This PR adds the required IR for DB to DB joins, based on @paf31 and @0x777 's `feature/db-to-db` branch. To do so, it also refactors the IR to introduce a new type parameter, `r`, which is used to recursively constructs the `v` parameter of remote QueryDBs. When collecting remote joins, we replace `r` with `Const Void`, indicating at the type level that there cannot be any leftover remote join. Furthermore, this PR refactors IR.Select for readability, moves some code from IR.Root to IR.Select to avoid having to deal with circular dependencies, and makes it compile by adding `error` in all new cases in the execution pipeline. The diff doesn't make it clear, but most of Select.hs is actually unchanged. Declarations have just been reordered by topic, in the following order: - type declarations - instance declarations - type aliases - constructor functions - traverse functions https://github.com/hasura/graphql-engine-mono/pull/1580 Co-authored-by: Phil Freeman <630306+paf31@users.noreply.github.com> GitOrigin-RevId: bbdcb4119cec8bb3fc32f1294f91b8dea0728721
479 lines
23 KiB
Haskell
479 lines
23 KiB
Haskell
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
module Hasura.GraphQL.Schema.Mutation
|
|
( insertIntoTable
|
|
, insertOneIntoTable
|
|
, updateTable
|
|
, updateTableByPk
|
|
, deleteFromTable
|
|
, deleteFromTableByPk
|
|
) where
|
|
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Data.HashSet as Set
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
import Data.Text.Extended
|
|
|
|
import qualified Hasura.GraphQL.Parser as P
|
|
import qualified Hasura.RQL.IR.Delete as IR
|
|
import qualified Hasura.RQL.IR.Insert as IR
|
|
import qualified Hasura.RQL.IR.Returning as IR
|
|
import qualified Hasura.RQL.IR.Update as IR
|
|
|
|
import Hasura.GraphQL.Parser (FieldParser, InputFieldsParser, Kind (..), Parser,
|
|
UnpreparedValue (..), mkParameter)
|
|
import Hasura.GraphQL.Parser.Class
|
|
import Hasura.GraphQL.Schema.Backend
|
|
import Hasura.GraphQL.Schema.BoolExp
|
|
import Hasura.GraphQL.Schema.Common
|
|
import Hasura.GraphQL.Schema.Select
|
|
import Hasura.GraphQL.Schema.Table
|
|
import Hasura.RQL.Types
|
|
|
|
|
|
-- insert
|
|
|
|
-- | Construct a root field, normally called insert_tablename, that can be used to add several rows to a DB table
|
|
insertIntoTable
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName
|
|
-> TableInfo b -- ^ qualified name of the table
|
|
-> G.Name -- ^ field display name
|
|
-> Maybe G.Description -- ^ field description, if any
|
|
-> InsPermInfo b -- ^ insert permissions of the table
|
|
-> Maybe (SelPermInfo b) -- ^ select permissions of the table (if any)
|
|
-> Maybe (UpdPermInfo b) -- ^ update permissions of the table (if any)
|
|
-> m (FieldParser n (IR.AnnInsert b UnpreparedValue (UnpreparedValue b)))
|
|
insertIntoTable sourceName tableInfo fieldName description insertPerms selectPerms updatePerms = do
|
|
let columns = tableColumns tableInfo
|
|
selectionParser <- mutationSelectionSet sourceName tableInfo selectPerms
|
|
objectsParser <- P.list <$> tableFieldsInput sourceName tableInfo insertPerms
|
|
conflictParser <- fmap join $ sequenceA $ conflictObject sourceName tableInfo selectPerms <$> updatePerms
|
|
let objectsName = $$(G.litName "objects")
|
|
objectsDesc = "the rows to be inserted"
|
|
argsParser = do
|
|
conflictClause <- mkConflictClause conflictParser
|
|
objects <- P.field objectsName (Just objectsDesc) objectsParser
|
|
pure (conflictClause, objects)
|
|
pure $ P.subselection fieldName description argsParser selectionParser
|
|
<&> \((conflictClause, objects), output) -> IR.AnnInsert (G.unName fieldName) False
|
|
( mkInsertObject objects (tableInfoName tableInfo) columns conflictClause insertPerms updatePerms )
|
|
( IR.MOutMultirowFields output )
|
|
|
|
mkConflictClause :: MonadParse n => Maybe (Parser 'Input n a) -> InputFieldsParser n (Maybe a)
|
|
mkConflictClause conflictParser
|
|
= maybe
|
|
(pure Nothing) -- Empty InputFieldsParser (no arguments allowed)
|
|
(P.fieldOptional conflictName (Just conflictDesc))
|
|
conflictParser
|
|
where
|
|
conflictName = $$(G.litName "on_conflict")
|
|
conflictDesc = "on conflict condition"
|
|
|
|
-- | Variant of 'insertIntoTable' that inserts a single row
|
|
insertOneIntoTable
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName -- ^ source of the table
|
|
-> TableInfo b -- ^ table info
|
|
-> G.Name -- ^ field display name
|
|
-> Maybe G.Description -- ^ field description, if any
|
|
-> InsPermInfo b -- ^ insert permissions of the table
|
|
-> SelPermInfo b -- ^ select permissions of the table
|
|
-> Maybe (UpdPermInfo b) -- ^ update permissions of the table (if any)
|
|
-> m (FieldParser n (IR.AnnInsert b UnpreparedValue (UnpreparedValue b)))
|
|
insertOneIntoTable sourceName tableInfo fieldName description insertPerms selectPerms updatePerms = do
|
|
let columns = tableColumns tableInfo
|
|
selectionParser <- tableSelectionSet sourceName tableInfo selectPerms
|
|
objectParser <- tableFieldsInput sourceName tableInfo insertPerms
|
|
conflictParser <- fmap join $ sequenceA $ conflictObject sourceName tableInfo (Just selectPerms) <$> updatePerms
|
|
let objectName = $$(G.litName "object")
|
|
objectDesc = "the row to be inserted"
|
|
argsParser = do
|
|
conflictClause <- mkConflictClause conflictParser
|
|
object <- P.field objectName (Just objectDesc) objectParser
|
|
pure (conflictClause, object)
|
|
pure $ P.subselection fieldName description argsParser selectionParser
|
|
<&> \((conflictClause, object), output) -> IR.AnnInsert (G.unName fieldName) True
|
|
( mkInsertObject [object] (tableInfoName tableInfo) columns conflictClause insertPerms updatePerms )
|
|
( IR.MOutSinglerowObject output )
|
|
|
|
-- | We specify the data of an individual row to insert through this input parser.
|
|
tableFieldsInput
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName
|
|
-> TableInfo b -- ^ qualified name of the table
|
|
-> InsPermInfo b -- ^ insert permissions of the table
|
|
-> m (Parser 'Input n (IR.AnnInsObj b (UnpreparedValue b)))
|
|
tableFieldsInput sourceName tableInfo insertPerms = memoizeOn 'tableFieldsInput (sourceName, tableName) do
|
|
tableGQLName <- getTableGQLName tableInfo
|
|
roleName <- askRoleName
|
|
let allFields = _tciFieldInfoMap . _tiCoreInfo $ tableInfo
|
|
objectFields <- catMaybes <$> for (Map.elems allFields) \case
|
|
FIComputedField _ -> pure Nothing
|
|
FIRemoteRelationship _ -> pure Nothing
|
|
FIColumn columnInfo ->
|
|
whenMaybe (Set.member (pgiColumn columnInfo) (ipiCols insertPerms)) do
|
|
let columnName = pgiName columnInfo
|
|
columnDesc = pgiDescription columnInfo
|
|
fieldParser <- columnParser (pgiType columnInfo) (G.Nullability $ pgiIsNullable columnInfo)
|
|
pure $ P.fieldOptional columnName columnDesc fieldParser `mapField`
|
|
\(mkParameter -> value) -> IR.AnnInsObj [(pgiColumn columnInfo, value)] [] []
|
|
FIRelationship relationshipInfo -> runMaybeT $ do
|
|
let otherTableName = riRTable relationshipInfo
|
|
relName = riName relationshipInfo
|
|
otherTableInfo <- askTableInfo sourceName otherTableName
|
|
permissions <- MaybeT $ tablePermissions otherTableInfo
|
|
relFieldName <- lift $ textToName $ relNameToTxt relName
|
|
insPerms <- hoistMaybe $ _permIns permissions
|
|
let selPerms = _permSel permissions
|
|
updPerms = _permUpd permissions
|
|
lift $ case riType relationshipInfo of
|
|
ObjRel -> do
|
|
parser <- objectRelationshipInput sourceName otherTableInfo insPerms selPerms updPerms
|
|
pure $ P.fieldOptional relFieldName Nothing parser `mapField`
|
|
\objRelIns -> IR.AnnInsObj [] [IR.RelIns objRelIns relationshipInfo] []
|
|
ArrRel -> do
|
|
parser <- P.nullable <$> arrayRelationshipInput sourceName otherTableInfo insPerms selPerms updPerms
|
|
pure $ P.fieldOptional relFieldName Nothing parser <&> \arrRelIns -> do
|
|
rel <- join arrRelIns
|
|
Just $ IR.AnnInsObj [] [] [IR.RelIns rel relationshipInfo | not $ null $ IR._aiInsObj rel]
|
|
let objectName = tableGQLName <> $$(G.litName "_insert_input")
|
|
objectDesc = G.Description $ "input type for inserting data into table " <>> tableName
|
|
pure $ P.object objectName (Just objectDesc) $ catMaybes <$> sequenceA objectFields
|
|
<&> mconcat
|
|
where
|
|
tableName = tableInfoName tableInfo
|
|
|
|
-- | Used by 'tableFieldsInput' for object data that is nested through object relationships
|
|
objectRelationshipInput
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName
|
|
-> TableInfo b
|
|
-> InsPermInfo b
|
|
-> Maybe (SelPermInfo b)
|
|
-> Maybe (UpdPermInfo b)
|
|
-> m (Parser 'Input n (IR.SingleObjIns b (UnpreparedValue b)))
|
|
objectRelationshipInput sourceName tableInfo insertPerms selectPerms updatePerms =
|
|
memoizeOn 'objectRelationshipInput (sourceName, tableName) do
|
|
tableGQLName <- getTableGQLName tableInfo
|
|
let columns = tableColumns tableInfo
|
|
objectParser <- tableFieldsInput sourceName tableInfo insertPerms
|
|
conflictParser <- fmap join $ sequenceA $ conflictObject sourceName tableInfo selectPerms <$> updatePerms
|
|
let objectName = $$(G.litName "data")
|
|
inputName = tableGQLName <> $$(G.litName "_obj_rel_insert_input")
|
|
inputDesc = G.Description $ "input type for inserting object relation for remote table " <>> tableName
|
|
inputParser = do
|
|
conflictClause <- mkConflictClause conflictParser
|
|
object <- P.field objectName Nothing objectParser
|
|
pure $ mkInsertObject object tableName columns conflictClause insertPerms updatePerms
|
|
pure $ P.object inputName (Just inputDesc) inputParser
|
|
where tableName = tableInfoName tableInfo
|
|
|
|
-- | Used by 'tableFieldsInput' for object data that is nested through object relationships
|
|
arrayRelationshipInput
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName
|
|
-> TableInfo b
|
|
-> InsPermInfo b
|
|
-> Maybe (SelPermInfo b)
|
|
-> Maybe (UpdPermInfo b)
|
|
-> m (Parser 'Input n (IR.MultiObjIns b (UnpreparedValue b)))
|
|
arrayRelationshipInput sourceName tableInfo insertPerms selectPerms updatePerms =
|
|
memoizeOn 'arrayRelationshipInput (sourceName, tableName) do
|
|
tableGQLName <- getTableGQLName tableInfo
|
|
let columns = tableColumns tableInfo
|
|
objectParser <- tableFieldsInput sourceName tableInfo insertPerms
|
|
conflictParser <- fmap join $ sequenceA $ conflictObject sourceName tableInfo selectPerms <$> updatePerms
|
|
let objectsName = $$(G.litName "data")
|
|
inputName = tableGQLName <> $$(G.litName "_arr_rel_insert_input")
|
|
inputDesc = G.Description $ "input type for inserting array relation for remote table " <>> tableName
|
|
inputParser = do
|
|
conflictClause <- mkConflictClause conflictParser
|
|
objects <- P.field objectsName Nothing $ P.list objectParser
|
|
pure $ mkInsertObject objects tableName columns conflictClause insertPerms updatePerms
|
|
pure $ P.object inputName (Just inputDesc) inputParser
|
|
where tableName = tableInfoName tableInfo
|
|
|
|
mkInsertObject
|
|
:: forall b a
|
|
. BackendSchema b
|
|
=> a
|
|
-> TableName b
|
|
-> [ColumnInfo b]
|
|
-> Maybe (IR.ConflictClauseP1 b (UnpreparedValue b))
|
|
-> InsPermInfo b
|
|
-> Maybe (UpdPermInfo b)
|
|
-> IR.AnnIns b a (UnpreparedValue b)
|
|
mkInsertObject objects table columns conflictClause insertPerms updatePerms =
|
|
IR.AnnIns { _aiInsObj = objects
|
|
, _aiTableName = table
|
|
, _aiConflictClause = conflictClause
|
|
, _aiCheckCond = (insertCheck, updateCheck)
|
|
, _aiTableCols = columns
|
|
, _aiDefVals = defaultValues
|
|
}
|
|
where insertCheck = fmapAnnBoolExp partialSQLExpToUnpreparedValue $ ipiCheck insertPerms
|
|
updateCheck = fmapAnnBoolExp partialSQLExpToUnpreparedValue <$> (upiCheck =<< updatePerms)
|
|
defaultValues = Map.union (partialSQLExpToUnpreparedValue <$> ipiSet insertPerms)
|
|
$ Map.fromList [(column, UVLiteral $ columnDefaultValue @b column) | column <- pgiColumn <$> columns]
|
|
|
|
-- | Specifies the "ON CONFLICT" SQL clause.
|
|
-- This object cannot exist if there aren't any unique or primary keys constraints. However,
|
|
-- if there are no columns for which the current role has update permissions, we must still
|
|
-- accept an empty list for `update_columns`; we do this by adding a placeholder value to
|
|
-- the enum (see 'tableUpdateColumnsEnum').
|
|
conflictObject
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName
|
|
-> TableInfo b
|
|
-> Maybe (SelPermInfo b)
|
|
-> UpdPermInfo b
|
|
-> m (Maybe (Parser 'Input n (IR.ConflictClauseP1 b (UnpreparedValue b))))
|
|
conflictObject sourceName tableInfo selectPerms updatePerms = runMaybeT $ do
|
|
tableGQLName <- getTableGQLName tableInfo
|
|
columnsEnum <- lift $ tableUpdateColumnsEnum tableInfo updatePerms
|
|
constraints <- hoistMaybe $ tciUniqueOrPrimaryKeyConstraints . _tiCoreInfo $ tableInfo
|
|
constraintParser <- lift $ conflictConstraint constraints sourceName tableInfo
|
|
whereExpParser <- lift $ boolExp sourceName tableInfo selectPerms
|
|
let objectName = tableGQLName <> $$(G.litName "_on_conflict")
|
|
objectDesc = G.Description $ "on conflict condition type for table " <>> tableInfoName tableInfo
|
|
constraintName = $$(G.litName "constraint")
|
|
columnsName = $$(G.litName "update_columns")
|
|
whereExpName = $$(G.litName "where")
|
|
fieldsParser = do
|
|
constraint <- IR.CTConstraint <$> P.field constraintName Nothing constraintParser
|
|
whereExp <- P.fieldOptional whereExpName Nothing whereExpParser
|
|
columns <- P.fieldWithDefault columnsName Nothing (G.VList []) (P.list columnsEnum) `P.bindFields` \cs ->
|
|
-- this can only happen if the placeholder was used
|
|
sequenceA cs `onNothing` parseError "erroneous column name"
|
|
pure $ case columns of
|
|
[] -> IR.CP1DoNothing $ Just constraint
|
|
_ -> IR.CP1Update constraint columns preSetColumns $
|
|
BoolAnd $ catMaybes [whereExp, Just $ fmapAnnBoolExp partialSQLExpToUnpreparedValue $ upiFilter updatePerms]
|
|
pure $ P.object objectName (Just objectDesc) fieldsParser
|
|
where preSetColumns = partialSQLExpToUnpreparedValue <$> upiSet updatePerms
|
|
|
|
conflictConstraint
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> NonEmpty (Constraint b)
|
|
-> SourceName
|
|
-> TableInfo b
|
|
-> m (Parser 'Both n (ConstraintName b))
|
|
conflictConstraint constraints sourceName tableInfo = memoizeOn 'conflictConstraint (sourceName, tableName) $ do
|
|
tableGQLName <- getTableGQLName tableInfo
|
|
constraintEnumValues <- for constraints \constraint -> do
|
|
name <- textToName $ toTxt $ _cName constraint
|
|
pure ( P.mkDefinition name (Just "unique or primary key constraint") P.EnumValueInfo
|
|
, _cName constraint
|
|
)
|
|
let enumName = tableGQLName <> $$(G.litName "_constraint")
|
|
enumDesc = G.Description $ "unique or primary key constraints on table " <>> tableName
|
|
pure $ P.enum enumName (Just enumDesc) constraintEnumValues
|
|
where
|
|
tableName = tableInfoName tableInfo
|
|
|
|
|
|
-- update
|
|
|
|
-- | Construct a root field, normally called update_tablename, that can be used
|
|
-- to update rows in a DB table specified by filters. Only returns a parser if
|
|
-- there are columns the user is allowed to update; otherwise returns Nothing.
|
|
updateTable
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName -- ^ table source
|
|
-> TableInfo b -- ^ table info
|
|
-> G.Name -- ^ field display name
|
|
-> Maybe G.Description -- ^ field description, if any
|
|
-> UpdPermInfo b -- ^ update permissions of the table
|
|
-> Maybe (SelPermInfo b) -- ^ select permissions of the table (if any)
|
|
-> m (Maybe (FieldParser n (IR.AnnUpdG b UnpreparedValue (UnpreparedValue b))))
|
|
updateTable sourceName tableInfo fieldName description updatePerms selectPerms = runMaybeT $ do
|
|
let whereName = $$(G.litName "where")
|
|
whereDesc = "filter the rows which have to be updated"
|
|
opArgs <- MaybeT $ updateOperators tableInfo updatePerms
|
|
let columns = tableColumns tableInfo
|
|
whereArg <- lift $ P.field whereName (Just whereDesc) <$> boolExp sourceName tableInfo selectPerms
|
|
selection <- lift $ mutationSelectionSet sourceName tableInfo selectPerms
|
|
let argsParser = liftA2 (,) opArgs whereArg
|
|
pure $ P.subselection fieldName description argsParser selection
|
|
<&> mkUpdateObject tableName columns updatePerms . fmap IR.MOutMultirowFields
|
|
where tableName = tableInfoName tableInfo
|
|
|
|
-- | Construct a root field, normally called update_tablename, that can be used
|
|
-- to update a single in a DB table, specified by primary key. Only returns a
|
|
-- parser if there are columns the user is allowed to update and if the user has
|
|
-- select permissions on all primary keys; otherwise returns Nothing.
|
|
updateTableByPk
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName -- ^ table source
|
|
-> TableInfo b -- ^ table info
|
|
-> G.Name -- ^ field display name
|
|
-> Maybe G.Description -- ^ field description, if any
|
|
-> UpdPermInfo b -- ^ update permissions of the table
|
|
-> SelPermInfo b -- ^ select permissions of the table
|
|
-> m (Maybe (FieldParser n (IR.AnnUpdG b UnpreparedValue (UnpreparedValue b))))
|
|
updateTableByPk sourceName tableInfo fieldName description updatePerms selectPerms = runMaybeT $ do
|
|
tableGQLName <- getTableGQLName tableInfo
|
|
let columns = tableColumns tableInfo
|
|
pkArgs <- MaybeT $ primaryKeysArguments tableInfo selectPerms
|
|
opArgs <- MaybeT $ updateOperators tableInfo updatePerms
|
|
selection <- lift $ tableSelectionSet sourceName tableInfo selectPerms
|
|
let pkFieldName = $$(G.litName "pk_columns")
|
|
pkObjectName = tableGQLName <> $$(G.litName "_pk_columns_input")
|
|
pkObjectDesc = G.Description $ "primary key columns input for table: " <> G.unName tableGQLName
|
|
argsParser = do
|
|
operators <- opArgs
|
|
primaryKeys <- P.field pkFieldName Nothing $ P.object pkObjectName (Just pkObjectDesc) pkArgs
|
|
pure (operators, primaryKeys)
|
|
pure $ P.subselection fieldName description argsParser selection
|
|
<&> mkUpdateObject tableName columns updatePerms . fmap IR.MOutSinglerowObject
|
|
where tableName = tableInfoName tableInfo
|
|
|
|
mkUpdateObject
|
|
:: Backend b
|
|
=> TableName b
|
|
-> [ColumnInfo b]
|
|
-> UpdPermInfo b
|
|
-> ( ( [(Column b, IR.UpdOpExpG (UnpreparedValue b))]
|
|
, AnnBoolExp b (UnpreparedValue b)
|
|
)
|
|
, IR.MutationOutputG b UnpreparedValue (UnpreparedValue b)
|
|
)
|
|
-> IR.AnnUpdG b UnpreparedValue (UnpreparedValue b)
|
|
mkUpdateObject table columns updatePerms ((opExps, whereExp), mutationOutput) =
|
|
IR.AnnUpd { IR.uqp1Table = table
|
|
, IR.uqp1OpExps = opExps
|
|
, IR.uqp1Where = (permissionFilter, whereExp)
|
|
, IR.uqp1Check = checkExp
|
|
, IR.uqp1Output = mutationOutput
|
|
, IR.uqp1AllCols = columns
|
|
}
|
|
where
|
|
permissionFilter = fmapAnnBoolExp partialSQLExpToUnpreparedValue $ upiFilter updatePerms
|
|
checkExp = maybe annBoolExpTrue (fmapAnnBoolExp partialSQLExpToUnpreparedValue) $ upiCheck updatePerms
|
|
|
|
|
|
-- delete
|
|
|
|
-- | Construct a root field, normally called delete_tablename, that can be used
|
|
-- to delete several rows from a DB table
|
|
deleteFromTable
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName -- ^ table source
|
|
-> TableInfo b -- ^ table info
|
|
-> G.Name -- ^ field display name
|
|
-> Maybe G.Description -- ^ field description, if any
|
|
-> DelPermInfo b -- ^ delete permissions of the table
|
|
-> Maybe (SelPermInfo b) -- ^ select permissions of the table (if any)
|
|
-> m (FieldParser n (IR.AnnDelG b UnpreparedValue (UnpreparedValue b)))
|
|
deleteFromTable sourceName tableInfo fieldName description deletePerms selectPerms = do
|
|
let whereName = $$(G.litName "where")
|
|
whereDesc = "filter the rows which have to be deleted"
|
|
whereArg <- P.field whereName (Just whereDesc) <$> boolExp sourceName tableInfo selectPerms
|
|
selection <- mutationSelectionSet sourceName tableInfo selectPerms
|
|
let columns = tableColumns tableInfo
|
|
pure $ P.subselection fieldName description whereArg selection
|
|
<&> mkDeleteObject (tableInfoName tableInfo) columns deletePerms . fmap IR.MOutMultirowFields
|
|
|
|
-- | Construct a root field, normally called delete_tablename_by_pk, that can be used to delete an
|
|
-- individual rows from a DB table, specified by primary key. Select permissions are required, as
|
|
-- the user must be allowed to access all the primary keys of the table.
|
|
deleteFromTableByPk
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName -- ^ table source
|
|
-> TableInfo b -- ^ table info
|
|
-> G.Name -- ^ field display name
|
|
-> Maybe G.Description -- ^ field description, if any
|
|
-> DelPermInfo b -- ^ delete permissions of the table
|
|
-> SelPermInfo b -- ^ select permissions of the table
|
|
-> m (Maybe (FieldParser n (IR.AnnDelG b UnpreparedValue (UnpreparedValue b))))
|
|
deleteFromTableByPk sourceName tableInfo fieldName description deletePerms selectPerms = runMaybeT $ do
|
|
let columns = tableColumns tableInfo
|
|
pkArgs <- MaybeT $ primaryKeysArguments tableInfo selectPerms
|
|
selection <- lift $ tableSelectionSet sourceName tableInfo selectPerms
|
|
pure $ P.subselection fieldName description pkArgs selection
|
|
<&> mkDeleteObject (tableInfoName tableInfo) columns deletePerms . fmap IR.MOutSinglerowObject
|
|
|
|
mkDeleteObject
|
|
:: Backend b
|
|
=> TableName b
|
|
-> [ColumnInfo b]
|
|
-> DelPermInfo b
|
|
-> (AnnBoolExp b (UnpreparedValue b), IR.MutationOutputG b UnpreparedValue (UnpreparedValue b))
|
|
-> IR.AnnDelG b UnpreparedValue (UnpreparedValue b)
|
|
mkDeleteObject table columns deletePerms (whereExp, mutationOutput) =
|
|
IR.AnnDel { IR.dqp1Table = table
|
|
, IR.dqp1Where = (permissionFilter, whereExp)
|
|
, IR.dqp1Output = mutationOutput
|
|
, IR.dqp1AllCols = columns
|
|
}
|
|
where
|
|
permissionFilter = fmapAnnBoolExp partialSQLExpToUnpreparedValue $ dpiFilter deletePerms
|
|
|
|
|
|
-- common
|
|
|
|
-- | All mutations allow returning results, such as what the updated database
|
|
-- rows look like. This parser allows a query to specify what data to fetch.
|
|
mutationSelectionSet
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> SourceName
|
|
-> TableInfo b
|
|
-> Maybe (SelPermInfo b)
|
|
-> m (Parser 'Output n (IR.MutFldsG b UnpreparedValue (UnpreparedValue b)))
|
|
mutationSelectionSet sourceName tableInfo selectPerms =
|
|
memoizeOn 'mutationSelectionSet (sourceName, tableName) do
|
|
tableGQLName <- getTableGQLName tableInfo
|
|
returning <- runMaybeT do
|
|
permissions <- hoistMaybe selectPerms
|
|
tableSet <- lift $ tableSelectionList sourceName tableInfo permissions
|
|
let returningName = $$(G.litName "returning")
|
|
returningDesc = "data from the rows affected by the mutation"
|
|
pure $ IR.MRet <$> P.subselection_ returningName (Just returningDesc) tableSet
|
|
let affectedRowsName = $$(G.litName "affected_rows")
|
|
affectedRowsDesc = "number of rows affected by the mutation"
|
|
selectionName = tableGQLName <> $$(G.litName "_mutation_response")
|
|
selectionDesc = G.Description $ "response of any mutation on the table " <>> tableName
|
|
|
|
selectionFields = catMaybes
|
|
[ Just $ IR.MCount <$
|
|
P.selection_ affectedRowsName (Just affectedRowsDesc) P.int
|
|
, returning
|
|
]
|
|
pure $ P.selectionSet selectionName (Just selectionDesc) selectionFields
|
|
<&> parsedSelectionsToFields IR.MExp
|
|
where
|
|
tableName = tableInfoName tableInfo
|
|
|
|
-- | How to specify a database row by primary key.
|
|
primaryKeysArguments
|
|
:: forall b r m n
|
|
. MonadBuildSchema b r m n
|
|
=> TableInfo b
|
|
-> SelPermInfo b
|
|
-> m (Maybe (InputFieldsParser n (AnnBoolExp b (UnpreparedValue b))))
|
|
primaryKeysArguments tableInfo selectPerms = runMaybeT $ do
|
|
primaryKeys <- hoistMaybe $ _tciPrimaryKey . _tiCoreInfo $ tableInfo
|
|
let columns = _pkColumns primaryKeys
|
|
guard $ all (\c -> pgiColumn c `Map.member` spiCols selectPerms) columns
|
|
lift $ fmap (BoolAnd . toList) . sequenceA <$> for columns \columnInfo -> do
|
|
field <- columnParser (pgiType columnInfo) (G.Nullability False)
|
|
pure $ BoolFld . AVCol columnInfo . pure . AEQ True . mkParameter <$>
|
|
P.field (pgiName columnInfo) (pgiDescription columnInfo) field
|