hasura/graphql-engine
1
0
Fork 0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-17 20:41:49 +03:00
Code Issues Projects Releases Wiki Activity
6093010a6e
graphql-engine/server/src-lib/Hasura/GraphQL/Schema/Mutation.hs
Karthikeyan Chinnakonda 92026b769f [Preview] Inherited roles for postgres read queries 
fixes #3868

docker image - `hasura/graphql-engine:inherited-roles-preview-48b73a2de`

Note:

To be able to use the inherited roles feature, the graphql-engine should be started with the env variable `HASURA_GRAPHQL_EXPERIMENTAL_FEATURES` set to `inherited_roles`.

Introduction
------------

This PR implements the idea of multiple roles as presented in this [paper](https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/FGALanguageICDE07.pdf). The multiple roles feature in this PR can be used via inherited roles. An inherited role is a role which can be created by combining multiple singular roles. For example, if there are two roles `author` and `editor` configured in the graphql-engine, then we can create a inherited role with the name of `combined_author_editor` role which will combine the select permissions of the `author` and `editor` roles and then make GraphQL queries using the `combined_author_editor`.

How are select permissions of different roles are combined?
------------------------------------------------------------

A select permission includes 5 things:

1. Columns accessible to the role
2. Row selection filter
3. Limit
4. Allow aggregation
5. Scalar computed fields accessible to the role

 Suppose there are two roles, `role1` gives access to the `address` column with row filter `P1` and `role2` gives access to both the `address` and the `phone` column with row filter `P2` and we create a new role `combined_roles` which combines `role1` and `role2`.

Let's say the following GraphQL query is queried with the `combined_roles` role.

```graphql
query {
   employees {
     address
     phone
   }
}
```

This will translate to the following SQL query:

```sql

 select
    (case when (P1 or P2) then address else null end) as address,
    (case when P2 then phone else null end) as phone
 from employee
 where (P1 or P2)
```

The other parameters of the select permission will be combined in the following manner:

1. Limit - Minimum of the limits will be the limit of the inherited role
2. Allow aggregations - If any of the role allows aggregation, then the inherited role will allow aggregation
3. Scalar computed fields - same as table column fields, as in the above example

APIs for inherited roles:
----------------------

1. `add_inherited_role`

`add_inherited_role` is the [metadata API](https://hasura.io/docs/1.0/graphql/core/api-reference/index.html#schema-metadata-api) to create a new inherited role. It accepts two arguments

`role_name`: the name of the inherited role to be added (String)
`role_set`: list of roles that need to be combined (Array of Strings)

Example:

```json
{
  "type": "add_inherited_role",
  "args": {
      "role_name":"combined_user",
      "role_set":[
          "user",
          "user1"
      ]
  }
}
```

After adding the inherited role, the inherited role can be used like single roles like earlier

Note:

An inherited role can only be created with non-inherited/singular roles.

2. `drop_inherited_role`

The `drop_inherited_role` API accepts the name of the inherited role and drops it from the metadata. It accepts a single argument:

`role_name`: name of the inherited role to be dropped

Example:

```json

{
  "type": "drop_inherited_role",
  "args": {
      "role_name":"combined_user"
  }
}
```

Metadata
---------

The derived roles metadata will be included under the `experimental_features` key while exporting the metadata.

```json
{
  "experimental_features": {
    "derived_roles": [
      {
        "role_name": "manager_is_employee_too",
        "role_set": [
          "employee",
          "manager"
        ]
      }
    ]
  }
}
```

Scope
------

Only postgres queries and subscriptions are supported in this PR.

Important points:
-----------------

1. All columns exposed to an inherited role will be marked as `nullable`, this is done so that cell value nullification can be done.

TODOs
-------

- [ ] Tests
   - [ ] Test a GraphQL query running with a inherited role without enabling inherited roles in experimental features
   - [] Tests for aggregate queries, limit, computed fields, functions, subscriptions (?)
   - [ ] Introspection test with a inherited role (nullability changes in a inherited role)
- [ ] Docs
- [ ] Changelog

Co-authored-by: Vamshi Surabhi <6562944+0x777@users.noreply.github.com>
GitOrigin-RevId: 3b8ee1e11f5ceca80fe294f8c074d42fbccfec63
2021-03-08 11:15:10 +00:00

451 lines
21 KiB
Haskell
Raw Blame History

{-# 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
=> TableName 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 b)))
insertIntoTable table fieldName description insertPerms selectPerms updatePerms = do
columns <- tableColumns table
selectionParser <- mutationSelectionSet table selectPerms
objectsParser <- P.list <$> tableFieldsInput table insertPerms
conflictParser <- fmap join $ sequenceA $ conflictObject table 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 table 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
=> TableName 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
-> SelPermInfo b -- ^ select permissions of the table
-> Maybe (UpdPermInfo b) -- ^ update permissions of the table (if any)
-> m (FieldParser n (IR.AnnInsert b (UnpreparedValue b)))
insertOneIntoTable table fieldName description insertPerms selectPerms updatePerms = do
columns <- tableColumns table
selectionParser <- tableSelectionSet table selectPerms
objectParser <- tableFieldsInput table insertPerms
conflictParser <- fmap join $ sequenceA $ conflictObject table (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] table 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
=> TableName b -- ^ qualified name of the table
-> InsPermInfo b -- ^ insert permissions of the table
-> m (Parser 'Input n (IR.AnnInsObj b (UnpreparedValue b)))
tableFieldsInput table insertPerms = memoizeOn 'tableFieldsInput table do
tableGQLName <- getTableGQLName @b table
roleName <- askRoleName
allFields <- _tciFieldInfoMap . _tiCoreInfo <$> askTableInfo table
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 otherTable = riRTable relationshipInfo
relName = riName relationshipInfo
permissions <- MaybeT $ tablePermissions otherTable
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 otherTable insPerms selPerms updPerms
pure $ P.fieldOptional relFieldName Nothing parser `mapField`
\objRelIns -> IR.AnnInsObj [] [IR.RelIns objRelIns relationshipInfo] []
ArrRel -> do
parser <- P.nullable <$> arrayRelationshipInput otherTable 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 " <>> table
pure $ P.object objectName (Just objectDesc) $ catMaybes <$> sequenceA objectFields
<&> mconcat
-- | Used by 'tableFieldsInput' for object data that is nested through object relationships
objectRelationshipInput
:: forall b r m n
. MonadBuildSchema b r m n
=> TableName b
-> InsPermInfo b
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> m (Parser 'Input n (IR.SingleObjIns b (UnpreparedValue b)))
objectRelationshipInput table insertPerms selectPerms updatePerms =
memoizeOn 'objectRelationshipInput table do
tableGQLName <- getTableGQLName @b table
columns <- tableColumns table
objectParser <- tableFieldsInput table insertPerms
conflictParser <- fmap join $ sequenceA $ conflictObject table 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 " <>> table
inputParser = do
conflictClause <- mkConflictClause conflictParser
object <- P.field objectName Nothing objectParser
pure $ mkInsertObject object table columns conflictClause insertPerms updatePerms
pure $ P.object inputName (Just inputDesc) inputParser
-- | Used by 'tableFieldsInput' for object data that is nested through object relationships
arrayRelationshipInput
:: forall b r m n
. MonadBuildSchema b r m n
=> TableName b
-> InsPermInfo b
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> m (Parser 'Input n (IR.MultiObjIns b (UnpreparedValue b)))
arrayRelationshipInput table insertPerms selectPerms updatePerms =
memoizeOn 'arrayRelationshipInput table do
tableGQLName <- getTableGQLName @b table
columns <- tableColumns table
objectParser <- tableFieldsInput table insertPerms
conflictParser <- fmap join $ sequenceA $ conflictObject table 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 " <>> table
inputParser = do
conflictClause <- mkConflictClause conflictParser
objects <- P.field objectsName Nothing $ P.list objectParser
pure $ mkInsertObject objects table columns conflictClause insertPerms updatePerms
pure $ P.object inputName (Just inputDesc) inputParser
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
conflictObject
:: forall b r m n
. MonadBuildSchema b r m n
=> TableName b
-> Maybe (SelPermInfo b)
-> UpdPermInfo b
-> m (Maybe (Parser 'Input n (IR.ConflictClauseP1 b (UnpreparedValue b))))
conflictObject table selectPerms updatePerms = runMaybeT $ do
tableGQLName <- getTableGQLName @b table
columnsEnum <- MaybeT $ tableUpdateColumnsEnum table updatePerms
constraints <- MaybeT $ tciUniqueOrPrimaryKeyConstraints . _tiCoreInfo <$> askTableInfo @b table
constraintParser <- lift $ conflictConstraint constraints table
whereExpParser <- lift $ boolExp table selectPerms
let objectName = tableGQLName <> $$(G.litName "_on_conflict")
objectDesc = G.Description $ "on conflict condition type for table " <>> table
constraintName = $$(G.litName "constraint")
columnsName = $$(G.litName "update_columns")
whereExpName = $$(G.litName "where")
fieldsParser = do
constraint <- IR.CTConstraint <$> P.field constraintName Nothing constraintParser
columns <- P.field columnsName Nothing $ P.list columnsEnum
whereExp <- P.fieldOptional whereExpName Nothing whereExpParser
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)
-> TableName b
-> m (Parser 'Both n (ConstraintName b))
conflictConstraint constraints table = memoizeOn 'conflictConstraint table $ do
tableGQLName <- getTableGQLName @b table
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 " <>> table
pure $ P.enum enumName (Just enumDesc) constraintEnumValues
-- 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
=> TableName b -- ^ qualified name of the table
-> 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 b))))
updateTable table fieldName description updatePerms selectPerms = runMaybeT $ do
let whereName = $$(G.litName "where")
whereDesc = "filter the rows which have to be updated"
opArgs <- MaybeT $ updateOperators table updatePerms
columns <- lift $ tableColumns table
whereArg <- lift $ P.field whereName (Just whereDesc) <$> boolExp table selectPerms
selection <- lift $ mutationSelectionSet table selectPerms
let argsParser = liftA2 (,) opArgs whereArg
pure $ P.subselection fieldName description argsParser selection
<&> mkUpdateObject table columns updatePerms . fmap IR.MOutMultirowFields
-- | 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
=> TableName b -- ^ qualified name of the table
-> 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 b))))
updateTableByPk table fieldName description updatePerms selectPerms = runMaybeT $ do
tableGQLName <- getTableGQLName @b table
columns <- lift $ tableColumns table
pkArgs <- MaybeT $ primaryKeysArguments table selectPerms
opArgs <- MaybeT $ updateOperators table updatePerms
selection <- lift $ tableSelectionSet table 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 table columns updatePerms . fmap IR.MOutSinglerowObject
mkUpdateObject
:: TableName b
-> [ColumnInfo b]
-> UpdPermInfo b
-> ( ( [(Column b, IR.UpdOpExpG (UnpreparedValue b))]
, AnnBoolExp b (UnpreparedValue b)
)
, IR.MutationOutputG b (UnpreparedValue b)
)
-> IR.AnnUpdG b (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
=> TableName b -- ^ qualified name of the table
-> 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 b)))
deleteFromTable table 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 table selectPerms
selection <- mutationSelectionSet table selectPerms
columns <- tableColumns table
pure $ P.subselection fieldName description whereArg selection
<&> mkDeleteObject table 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
=> TableName b -- ^ qualified name of the table
-> 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 b))))
deleteFromTableByPk table fieldName description deletePerms selectPerms = runMaybeT $ do
columns <- lift $ tableColumns table
pkArgs <- MaybeT $ primaryKeysArguments table selectPerms
selection <- lift $ tableSelectionSet table selectPerms
pure $ P.subselection fieldName description pkArgs selection
<&> mkDeleteObject table columns deletePerms . fmap IR.MOutSinglerowObject
mkDeleteObject
:: TableName b
-> [ColumnInfo b]
-> DelPermInfo b
-> (AnnBoolExp b (UnpreparedValue b), IR.MutationOutputG b (UnpreparedValue b))
-> IR.AnnDelG b (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
=> TableName b
-> Maybe (SelPermInfo b)
-> m (Parser 'Output n (IR.MutFldsG b (UnpreparedValue b)))
mutationSelectionSet table selectPerms =
memoizeOn 'mutationSelectionSet table do
tableGQLName <- getTableGQLName @b table
returning <- runMaybeT do
permissions <- hoistMaybe selectPerms
tableSet <- lift $ tableSelectionList table 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 " <>> table
selectionFields = catMaybes
[ Just $ IR.MCount <$
P.selection_ affectedRowsName (Just affectedRowsDesc) P.int
, returning
]
pure $ P.selectionSet selectionName (Just selectionDesc) selectionFields
<&> parsedSelectionsToFields IR.MExp
-- | How to specify a database row by primary key.
primaryKeysArguments
:: forall b r m n
. MonadBuildSchema b r m n
=> TableName b
-> SelPermInfo b
-> m (Maybe (InputFieldsParser n (AnnBoolExp b (UnpreparedValue b))))
primaryKeysArguments table selectPerms = runMaybeT $ do
primaryKeys <- MaybeT $ _tciPrimaryKey . _tiCoreInfo <$> askTableInfo table
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
Reference in New Issue View Git Blame Copy Permalink