mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
d91029ad51
### Description This PR removes all `fmapX` and `traverseX` functions from RQL.IR, favouring instead `Functor` and `Traversable` instances throughout the code. This was a relatively straightforward change, except for two small pain points: `AnnSelectG` and `AnnInsert`. Both were parametric over two types `a` and `v`, making it impossible to make them traversable functors... But it turns out that in every single use case, `a ~ f v`. By changing those types to take such an `f :: Type -> Type` as an argument instead of `a :: Type` makes it possible to make them functors. The only small difference is for `AnnIns`, I had to introduce one `Identity` transformation for one of the `f` parameters. This is relatively straightforward. ### Notes This PR fixes the most verbose BigQuery hint (`let` instead of `<- pure`). https://github.com/hasura/graphql-engine-mono/pull/1668 GitOrigin-RevId: e632263a8c559aa04aeae10dcaec915b4a81ad1a
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 (IR.Single 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 f
|
|
. BackendSchema b
|
|
=> f (IR.AnnInsObj b (UnpreparedValue b))
|
|
-> TableName b
|
|
-> [ColumnInfo b]
|
|
-> Maybe (IR.ConflictClauseP1 b (UnpreparedValue b))
|
|
-> InsPermInfo b
|
|
-> Maybe (UpdPermInfo b)
|
|
-> IR.AnnIns b f (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 = (fmap . fmap) partialSQLExpToUnpreparedValue $ ipiCheck insertPerms
|
|
updateCheck = (fmap . fmap) 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 $ (fmap . fmap) 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 = (fmap . fmap) partialSQLExpToUnpreparedValue $ upiFilter updatePerms
|
|
checkExp = maybe annBoolExpTrue ((fmap . fmap) 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 = (fmap . fmap) 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 . AVColumn columnInfo . pure . AEQ True . mkParameter <$>
|
|
P.field (pgiName columnInfo) (pgiDescription columnInfo) field
|