{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE ViewPatterns #-}

module Hasura.RQL.DDL.Permission
  ( CreatePerm,
    runCreatePerm,
    PermDef (..),
    InsPerm (..),
    InsPermDef,
    buildInsPermInfo,
    SelPerm (..),
    SelPermDef,
    buildSelPermInfo,
    UpdPerm (..),
    UpdPermDef,
    buildUpdPermInfo,
    DelPerm (..),
    DelPermDef,
    buildDelPermInfo,
    DropPerm,
    runDropPerm,
    dropPermissionInMetadata,
    SetPermComment (..),
    runSetPermComment,
    PermInfo,
    buildPermInfo,
    addPermissionToMetadata,
  )
where

import Control.Lens (Lens', (.~), (^?))
import Data.Aeson
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.HashMap.Strict qualified as HM
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashSet qualified as HS
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DDL.Permission.Internal
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Types
import Hasura.Session

{- Note [Backend only permissions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As of writing this note, Hasura permission system is meant to be used by the
frontend. After introducing "Actions", the webhook handlers now can make GraphQL
mutations to the server with some backend logic. These mutations shouldn't be
exposed to frontend for any user since they'll bypass the business logic.

Backend only permissions is available for all(insert/update/delete) mutation operations.

For example:-
=============

We've a table named "user" and it has a "email" column. We need to validate the
email address. So we define an action "create_user" and it expects the same inputs
as "insert_user" mutation (generated by Hasura). Note that both "create_user" and
"insert_user" can insert values into the "user" table but only "create_user" has the
logic to validate the email address.

In the current Hasura permission system, a role has permission for both 'actions' and
'insert operations' on the table. That means, both the "create_user" and "insert_user"
operations will be visible to the frontend client. This is bad, since users can use
"insert_user" operation to circumvent the validation logic of "create_user".

We can overcome this problem by using "Backend only permissions". In this if the
insert/update/delete permission is marked as "backend_only: true", then the insert
operation will not be visible to the frontend client unless specifically specified

Backend only permissions adds an additional privilege to Hasura generated operations.

Those are accessable only if the request is made with all of the following:
  * `x-hasura-admin-secret` (if authorization is configured),
  * `x-hasura-use-backend-only-permissions` (value must be set to "true"),
  * `x-hasura-role` to identify the role
  * other required session variables.

backend_only   `x-hasura-admin-secret`   `x-hasura-use-backend-only-permissions`  Result
------------    ---------------------     -------------------------------------   ------
FALSE           ANY                       ANY                                    Mutation is always visible (Default Case: When no authorization is setup)
TRUE            FALSE                     ANY                                    Mutation is always hidden
FALSE           TRUE                      ANY                                    Mutation is always visible
TRUE            TRUE (OR NOT-SET)         FALSE                                  Mutation is hidden
TRUE            TRUE (OR NOT-SET)         TRUE                                   Mutation is shown

case 1: default case - no authorization is set and no backend_only permission are set
then irresepective of the value of `x-hasura-use-backend-only-permissions` the
mutation will always be visible

case 2: the authorization is set and the backend_only permissions are set but the
`x-hasura-admin-secret` is not sent along with request then irresepective of the value
in `x-hasura-use-backend-only-permissions` the mutation will always be hidden

case 3: the authorization is set, but no backend_only permission are set, the
`x-hasura-admin-secret` is sent along with request then irresepective of the value
in `x-hasura-use-backend-only-permissions` the mutation will always be visible

case 4 and 5:
the authz is set and the backend_only permissions are also set and the
`x-hasura-admin` secret is also sent along with the request then:
  * if `x-hasura-use-backend-only-permissions` header is sent as FALSE along with the
    request then the mutation will be hidden (4th case)
  * if `x-hasura-use-backend-only-permissions` header is sent as TRUE along with the
    request then the mutation will be visible (5th case)

How it Works:-
===============

Hasura has two scenarios:
  * Frontend Scenario
  * Backend Scenario

When no backend-only permissions are set then Hasura runs only in frontend scenario,
i.e all the mutation operations are visible.

When backend-only permissions are set, there comes a notion of:
  * which mutations are visible by default i.e without any request headers (frontend scenario)
  * which mutations are visible when `x-hasura-use-backend-only-permissions` is set (backend scenario)

Hasura maintains two different graphql schema ('frontend schema' and 'backend schema')
for all mutation fields of a table:
  * 'frontend schema': info about the mutation operation allowed to be shown on the frontend client when no backend-only permissions is set
  * 'backend schema' : info about the mutation operation allowed to be shown on the frontend client when backend-only permissions is set

The generation of these schemas happen in the `buildSource` functions of
`buildRoleContext` and `buildRelayRoleContext` functions. The internal representation
of these schema's look like:
  {RoleName: (Frontend Schema/Default Schema, Backend Schema)}

For example:
------------
We've a table "user" tracked by hasura and a role "public"

* If the update permission for the table "user" is marked as backend_only then the
  GQL context for that table will look like:

    {"public": (["insert_user","delete_user"], ["update_user"])}

  In the above '["insert_user","delete_user"]' are the only mutation operation visible
  by default on the frontend client. And the 'update_user' opertaion is only visible
  when the `x-hasura-use-backend-only-permissions` request header is present.

* If there is no backend_only permissions defined on the role then the GQL context
  looks like:

    {"public": (["insert_user","delete_user", "update_user"], [])}

  In the above there is no specific schema for the backend scenario i.e all the
  mutation operations are visible by default.
-}
procSetObj ::
  forall b m.
  (QErrM m, BackendMetadata b) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  Maybe (ColumnValues b Value) ->
  m (PreSetColsPartial b, [Text], [SchemaDependency])
procSetObj :: SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (PreSetColsPartial b, [Text], [SchemaDependency])
procSetObj SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap Maybe (ColumnValues b Value)
mObj = do
  ([(Column b, PartialSQLExp b)]
setColTups, [SchemaDependency]
deps) <- Text
-> m ([(Column b, PartialSQLExp b)], [SchemaDependency])
-> m ([(Column b, PartialSQLExp b)], [SchemaDependency])
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"set" (m ([(Column b, PartialSQLExp b)], [SchemaDependency])
 -> m ([(Column b, PartialSQLExp b)], [SchemaDependency]))
-> m ([(Column b, PartialSQLExp b)], [SchemaDependency])
-> m ([(Column b, PartialSQLExp b)], [SchemaDependency])
forall a b. (a -> b) -> a -> b
$
    ([((Column b, PartialSQLExp b), SchemaDependency)]
 -> ([(Column b, PartialSQLExp b)], [SchemaDependency]))
-> m [((Column b, PartialSQLExp b), SchemaDependency)]
-> m ([(Column b, PartialSQLExp b)], [SchemaDependency])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((Column b, PartialSQLExp b), SchemaDependency)]
-> ([(Column b, PartialSQLExp b)], [SchemaDependency])
forall a b. [(a, b)] -> ([a], [b])
unzip (m [((Column b, PartialSQLExp b), SchemaDependency)]
 -> m ([(Column b, PartialSQLExp b)], [SchemaDependency]))
-> m [((Column b, PartialSQLExp b), SchemaDependency)]
-> m ([(Column b, PartialSQLExp b)], [SchemaDependency])
forall a b. (a -> b) -> a -> b
$
      [(Column b, Value)]
-> ((Column b, Value)
    -> m ((Column b, PartialSQLExp b), SchemaDependency))
-> m [((Column b, PartialSQLExp b), SchemaDependency)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ColumnValues b Value -> [(Column b, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList ColumnValues b Value
setObj) (((Column b, Value)
  -> m ((Column b, PartialSQLExp b), SchemaDependency))
 -> m [((Column b, PartialSQLExp b), SchemaDependency)])
-> ((Column b, Value)
    -> m ((Column b, PartialSQLExp b), SchemaDependency))
-> m [((Column b, PartialSQLExp b), SchemaDependency)]
forall a b. (a -> b) -> a -> b
$ \(Column b
pgCol, Value
val) -> do
        ColumnType b
ty <-
          FieldInfoMap (FieldInfo b) -> Column b -> Text -> m (ColumnType b)
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnType backend)
askColumnType FieldInfoMap (FieldInfo b)
fieldInfoMap Column b
pgCol (Text -> m (ColumnType b)) -> Text -> m (ColumnType b)
forall a b. (a -> b) -> a -> b
$
            Text
"column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column b
pgCol Column b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found in table " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tn
        PartialSQLExp b
sqlExp <- CollectableType (ColumnType b) -> Value -> m (PartialSQLExp b)
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
CollectableType (ColumnType b) -> Value -> m (PartialSQLExp b)
parseCollectableType (ColumnType b -> CollectableType (ColumnType b)
forall a. a -> CollectableType a
CollectableTypeScalar ColumnType b
ty) Value
val
        let dep :: SchemaDependency
dep = DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b (PartialSQLExp b -> DependencyReason
forall (backend :: BackendType).
PartialSQLExp backend -> DependencyReason
getDepReason PartialSQLExp b
sqlExp) SourceName
source TableName b
tn Column b
pgCol
        ((Column b, PartialSQLExp b), SchemaDependency)
-> m ((Column b, PartialSQLExp b), SchemaDependency)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Column b
pgCol, PartialSQLExp b
sqlExp), SchemaDependency
dep)
  (PreSetColsPartial b, [Text], [SchemaDependency])
-> m (PreSetColsPartial b, [Text], [SchemaDependency])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Column b, PartialSQLExp b)] -> PreSetColsPartial b
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Column b, PartialSQLExp b)]
setColTups, [Text]
depHeaders, [SchemaDependency]
deps)
  where
    setObj :: ColumnValues b Value
setObj = ColumnValues b Value
-> Maybe (ColumnValues b Value) -> ColumnValues b Value
forall a. a -> Maybe a -> a
fromMaybe ColumnValues b Value
forall a. Monoid a => a
mempty Maybe (ColumnValues b Value)
mObj
    depHeaders :: [Text]
depHeaders =
      Value -> [Text]
getDepHeadersFromVal (Value -> [Text]) -> Value -> [Text]
forall a b. (a -> b) -> a -> b
$
        Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
          [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
            ((Column b, Value) -> (Key, Value))
-> [(Column b, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((Column b -> Key) -> (Column b, Value) -> (Key, Value)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Text -> Key
K.fromText (Text -> Key) -> (Column b -> Text) -> Column b -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column b -> Text
forall a. ToTxt a => a -> Text
toTxt)) ([(Column b, Value)] -> [(Key, Value)])
-> [(Column b, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$
              ColumnValues b Value -> [(Column b, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList ColumnValues b Value
setObj

    getDepReason :: PartialSQLExp backend -> DependencyReason
getDepReason = DependencyReason -> DependencyReason -> Bool -> DependencyReason
forall a. a -> a -> Bool -> a
bool DependencyReason
DRSessionVariable DependencyReason
DROnType (Bool -> DependencyReason)
-> (PartialSQLExp backend -> Bool)
-> PartialSQLExp backend
-> DependencyReason
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialSQLExp backend -> Bool
forall (backend :: BackendType). PartialSQLExp backend -> Bool
isStaticValue

type family PermInfo perm where
  PermInfo SelPerm = SelPermInfo
  PermInfo InsPerm = InsPermInfo
  PermInfo UpdPerm = UpdPermInfo
  PermInfo DelPerm = DelPermInfo

addPermissionToMetadata ::
  PermDef b a ->
  TableMetadata b ->
  TableMetadata b
addPermissionToMetadata :: PermDef b a -> TableMetadata b -> TableMetadata b
addPermissionToMetadata PermDef b a
permDef = case PermDef b a -> PermDefPermission b a
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> PermDefPermission b perm
_pdPermission PermDef b a
permDef of
  InsPerm' InsPerm b
_ -> (Permissions (InsPermDef b)
 -> Identity (Permissions (InsPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (InsPermDef b))
tmInsertPermissions ((Permissions (InsPermDef b)
  -> Identity (Permissions (InsPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Permissions (InsPermDef b) -> Permissions (InsPermDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName
-> PermDef b a
-> InsOrdHashMap RoleName (PermDef b a)
-> InsOrdHashMap RoleName (PermDef b a)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permDef) PermDef b a
permDef
  SelPerm' SelPerm b
_ -> (Permissions (SelPermDef b)
 -> Identity (Permissions (SelPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (SelPermDef b))
tmSelectPermissions ((Permissions (SelPermDef b)
  -> Identity (Permissions (SelPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Permissions (SelPermDef b) -> Permissions (SelPermDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName
-> PermDef b a
-> InsOrdHashMap RoleName (PermDef b a)
-> InsOrdHashMap RoleName (PermDef b a)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permDef) PermDef b a
permDef
  UpdPerm' UpdPerm b
_ -> (Permissions (UpdPermDef b)
 -> Identity (Permissions (UpdPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (UpdPermDef b))
tmUpdatePermissions ((Permissions (UpdPermDef b)
  -> Identity (Permissions (UpdPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Permissions (UpdPermDef b) -> Permissions (UpdPermDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName
-> PermDef b a
-> InsOrdHashMap RoleName (PermDef b a)
-> InsOrdHashMap RoleName (PermDef b a)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permDef) PermDef b a
permDef
  DelPerm' DelPerm b
_ -> (Permissions (DelPermDef b)
 -> Identity (Permissions (DelPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (DelPermDef b))
tmDeletePermissions ((Permissions (DelPermDef b)
  -> Identity (Permissions (DelPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Permissions (DelPermDef b) -> Permissions (DelPermDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName
-> PermDef b a
-> InsOrdHashMap RoleName (PermDef b a)
-> InsOrdHashMap RoleName (PermDef b a)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permDef) PermDef b a
permDef

buildPermInfo ::
  ( BackendMetadata b,
    QErrM m,
    TableCoreInfoRM b m,
    GetAggregationPredicatesDeps b
  ) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  RoleName ->
  PermDefPermission b perm ->
  m (WithDeps (PermInfo perm b))
buildPermInfo :: SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> RoleName
-> PermDefPermission b perm
-> m (WithDeps (PermInfo perm b))
buildPermInfo SourceName
x1 TableName b
x2 FieldInfoMap (FieldInfo b)
x3 RoleName
roleName = \case
  SelPerm' SelPerm b
p -> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> RoleName
-> SelPerm b
-> m (WithDeps (SelPermInfo b))
forall (b :: BackendType) (m :: * -> *).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> RoleName
-> SelPerm b
-> m (WithDeps (SelPermInfo b))
buildSelPermInfo SourceName
x1 TableName b
x2 FieldInfoMap (FieldInfo b)
x3 RoleName
roleName SelPerm b
p
  InsPerm' InsPerm b
p -> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> InsPerm b
-> m (WithDeps (InsPermInfo b))
forall (b :: BackendType) (m :: * -> *).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> InsPerm b
-> m (WithDeps (InsPermInfo b))
buildInsPermInfo SourceName
x1 TableName b
x2 FieldInfoMap (FieldInfo b)
x3 InsPerm b
p
  UpdPerm' UpdPerm b
p -> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> UpdPerm b
-> m (WithDeps (UpdPermInfo b))
forall (b :: BackendType) (m :: * -> *).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> UpdPerm b
-> m (WithDeps (UpdPermInfo b))
buildUpdPermInfo SourceName
x1 TableName b
x2 FieldInfoMap (FieldInfo b)
x3 UpdPerm b
p
  DelPerm' DelPerm b
p -> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> DelPerm b
-> m (WithDeps (DelPermInfo b))
forall (b :: BackendType) (m :: * -> *).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> DelPerm b
-> m (WithDeps (DelPermInfo b))
buildDelPermInfo SourceName
x1 TableName b
x2 FieldInfoMap (FieldInfo b)
x3 DelPerm b
p

doesPermissionExistInMetadata ::
  forall b.
  TableMetadata b ->
  RoleName ->
  PermType ->
  Bool
doesPermissionExistInMetadata :: TableMetadata b -> RoleName -> PermType -> Bool
doesPermissionExistInMetadata TableMetadata b
tableMetadata RoleName
roleName = \case
  PermType
PTInsert -> Lens' (TableMetadata b) (Permissions (InsPermDef b)) -> Bool
forall a. Lens' (TableMetadata b) (Permissions a) -> Bool
hasPermissionTo forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (InsPermDef b))
Lens' (TableMetadata b) (Permissions (InsPermDef b))
tmInsertPermissions
  PermType
PTSelect -> Lens' (TableMetadata b) (Permissions (SelPermDef b)) -> Bool
forall a. Lens' (TableMetadata b) (Permissions a) -> Bool
hasPermissionTo forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (SelPermDef b))
Lens' (TableMetadata b) (Permissions (SelPermDef b))
tmSelectPermissions
  PermType
PTUpdate -> Lens' (TableMetadata b) (Permissions (UpdPermDef b)) -> Bool
forall a. Lens' (TableMetadata b) (Permissions a) -> Bool
hasPermissionTo forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (UpdPermDef b))
Lens' (TableMetadata b) (Permissions (UpdPermDef b))
tmUpdatePermissions
  PermType
PTDelete -> Lens' (TableMetadata b) (Permissions (DelPermDef b)) -> Bool
forall a. Lens' (TableMetadata b) (Permissions a) -> Bool
hasPermissionTo forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (DelPermDef b))
Lens' (TableMetadata b) (Permissions (DelPermDef b))
tmDeletePermissions
  where
    hasPermissionTo :: forall a. Lens' (TableMetadata b) (Permissions a) -> Bool
    hasPermissionTo :: Lens' (TableMetadata b) (Permissions a) -> Bool
hasPermissionTo Lens' (TableMetadata b) (Permissions a)
perms = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ TableMetadata b
tableMetadata TableMetadata b -> Getting (First a) (TableMetadata b) a -> Maybe a
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Permissions a -> Const (First a) (Permissions a))
-> TableMetadata b -> Const (First a) (TableMetadata b)
Lens' (TableMetadata b) (Permissions a)
perms ((Permissions a -> Const (First a) (Permissions a))
 -> TableMetadata b -> Const (First a) (TableMetadata b))
-> ((a -> Const (First a) a)
    -> Permissions a -> Const (First a) (Permissions a))
-> Getting (First a) (TableMetadata b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Permissions a)
-> Traversal' (Permissions a) (IxValue (Permissions a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Permissions a)
RoleName
roleName

runCreatePerm ::
  forall m b a.
  (UserInfoM m, CacheRWM m, MonadError QErr m, MetadataM m, BackendMetadata b) =>
  CreatePerm a b ->
  m EncJSON
runCreatePerm :: CreatePerm a b -> m EncJSON
runCreatePerm (CreatePerm (WithTable SourceName
source TableName b
tableName PermDef b a
permissionDefn)) = do
  TableMetadata b
tableMetadata <- SourceName -> TableName b -> m (TableMetadata b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, MetadataM m, Backend b) =>
SourceName -> TableName b -> m (TableMetadata b)
askTableMetadata @b SourceName
source TableName b
tableName
  let permissionType :: PermType
permissionType = PermDefPermission b a -> PermType
forall (b :: BackendType) (a :: BackendType -> *).
PermDefPermission b a -> PermType
reflectPermDefPermission (PermDef b a -> PermDefPermission b a
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> PermDefPermission b perm
_pdPermission PermDef b a
permissionDefn)
      ptText :: Text
ptText = PermType -> Text
permTypeToCode PermType
permissionType
      role :: RoleName
role = PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permissionDefn
      metadataObject :: MetadataObjId
metadataObject =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$
          SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$
            TableName b -> TableMetadataObjId -> SourceMetadataObjId b
forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
tableName (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$
              RoleName -> PermType -> TableMetadataObjId
MTOPerm RoleName
role PermType
permissionType

  -- NOTE: we check if a permission exists for a `(table, role)` entity in the metadata
  -- and not in the `RolePermInfoMap b` because there may exist a permission for the `role`
  -- which is an inherited one, so we check it in the metadata directly

  -- The metadata will not contain the permissions for the admin role,
  -- because the graphql-engine automatically creates the role and it's
  -- assumed that the admin role is an implicit role of the graphql-engine.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TableMetadata b -> RoleName -> PermType -> Bool
forall (b :: BackendType).
TableMetadata b -> RoleName -> PermType -> Bool
doesPermissionExistInMetadata TableMetadata b
tableMetadata RoleName
role PermType
permissionType Bool -> Bool -> Bool
|| RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
ptText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permission already defined on table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
tableName TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" with role " Text -> RoleName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RoleName
role
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObject (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$
    (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
      SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
tableName ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ PermDef b a -> TableMetadata b -> TableMetadata b
forall (b :: BackendType) (a :: BackendType -> *).
PermDef b a -> TableMetadata b -> TableMetadata b
addPermissionToMetadata PermDef b a
permissionDefn
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runDropPerm ::
  forall b m.
  (UserInfoM m, CacheRWM m, MonadError QErr m, MetadataM m, BackendMetadata b) =>
  PermType ->
  DropPerm b ->
  m EncJSON
runDropPerm :: PermType -> DropPerm b -> m EncJSON
runDropPerm PermType
permType (DropPerm SourceName
source TableName b
table RoleName
role) = do
  TableMetadata b
tableMetadata <- SourceName -> TableName b -> m (TableMetadata b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, MetadataM m, Backend b) =>
SourceName -> TableName b -> m (TableMetadata b)
askTableMetadata @b SourceName
source TableName b
table
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TableMetadata b -> RoleName -> PermType -> Bool
forall (b :: BackendType).
TableMetadata b -> RoleName -> PermType -> Bool
doesPermissionExistInMetadata TableMetadata b
tableMetadata RoleName
role PermType
permType) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let errMsg :: Text
errMsg = PermType -> Text
permTypeToCode PermType
permType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permission on " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
table TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
role RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
PermissionDenied Text
errMsg
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$
      (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
        SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
table ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName -> PermType -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RoleName -> PermType -> TableMetadata b -> TableMetadata b
dropPermissionInMetadata RoleName
role PermType
permType
  EncJSON -> m EncJSON
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

buildInsPermInfo ::
  forall b m.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b
  ) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  InsPerm b ->
  m (WithDeps (InsPermInfo b))
buildInsPermInfo :: SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> InsPerm b
-> m (WithDeps (InsPermInfo b))
buildInsPermInfo SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap (InsPerm BoolExp b
checkCond Maybe (ColumnValues b Value)
set Maybe (PermColSpec b)
mCols Bool
backendOnly) =
  Text
-> m (WithDeps (InsPermInfo b)) -> m (WithDeps (InsPermInfo b))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"permission" (m (WithDeps (InsPermInfo b)) -> m (WithDeps (InsPermInfo b)))
-> m (WithDeps (InsPermInfo b)) -> m (WithDeps (InsPermInfo b))
forall a b. (a -> b) -> a -> b
$ do
    (AnnBoolExpPartialSQL b
be, [SchemaDependency]
beDeps) <- Text
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"check" (m (AnnBoolExpPartialSQL b, [SchemaDependency])
 -> m (AnnBoolExpPartialSQL b, [SchemaDependency]))
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall a b. (a -> b) -> a -> b
$ SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) (b :: BackendType).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
procBoolExp SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap BoolExp b
checkCond
    (HashMap (Column b) (PartialSQLExp b)
setColsSQL, [Text]
setHdrs, [SchemaDependency]
setColDeps) <- SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (HashMap (Column b) (PartialSQLExp b), [Text],
      [SchemaDependency])
forall (b :: BackendType) (m :: * -> *).
(QErrM m, BackendMetadata b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (PreSetColsPartial b, [Text], [SchemaDependency])
procSetObj SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap Maybe (ColumnValues b Value)
set
    m [()] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [()] -> m ()) -> m [()] -> m ()
forall a b. (a -> b) -> a -> b
$
      Text -> m [()] -> m [()]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"columns" (m [()] -> m [()]) -> m [()] -> m [()]
forall a b. (a -> b) -> a -> b
$ do
        [Column b] -> (Column b -> m ()) -> m [()]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [Column b]
insCols ((Column b -> m ()) -> m [()]) -> (Column b -> m ()) -> m [()]
forall a b. (a -> b) -> a -> b
$ \Column b
col -> do
          -- Check that all columns specified do in fact exist and are columns
          ColumnType b
_ <- FieldInfoMap (FieldInfo b) -> Column b -> Text -> m (ColumnType b)
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnType backend)
askColumnType FieldInfoMap (FieldInfo b)
fieldInfoMap Column b
col Text
relInInsErr
          -- Check that the column is insertable
          ColumnInfo b
ci <- FieldInfoMap (FieldInfo b) -> Column b -> Text -> m (ColumnInfo b)
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnInfo backend)
askColInfo FieldInfoMap (FieldInfo b)
fieldInfoMap Column b
col Text
""
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ColumnMutability -> Bool
_cmIsInsertable (ColumnMutability -> Bool) -> ColumnMutability -> Bool
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> ColumnMutability
forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciMutability ColumnInfo b
ci) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
              ( Text
"Column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column b
col
                  Column b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not insertable and so cannot have insert permissions defined"
              )

    let fltrHeaders :: HashSet Text
fltrHeaders = BoolExp b -> HashSet Text
forall (b :: BackendType). BoolExp b -> HashSet Text
getDependentHeaders BoolExp b
checkCond
        reqHdrs :: HashSet Text
reqHdrs = HashSet Text
fltrHeaders HashSet Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`HS.union` ([Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [Text]
setHdrs)
        insColDeps :: [SchemaDependency]
insColDeps = (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map (DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b DependencyReason
DRUntyped SourceName
source TableName b
tn) [Column b]
insCols
        deps :: [SchemaDependency]
deps = SourceName -> TableName b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SchemaDependency
mkParentDep @b SourceName
source TableName b
tn SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
: [SchemaDependency]
beDeps [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. [a] -> [a] -> [a]
++ [SchemaDependency]
setColDeps [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. [a] -> [a] -> [a]
++ [SchemaDependency]
insColDeps
        insColsWithoutPresets :: [Column b]
insColsWithoutPresets = [Column b]
insCols [Column b] -> [Column b] -> [Column b]
forall a. Eq a => [a] -> [a] -> [a]
\\ HashMap (Column b) (PartialSQLExp b) -> [Column b]
forall k v. HashMap k v -> [k]
HM.keys HashMap (Column b) (PartialSQLExp b)
setColsSQL

    WithDeps (InsPermInfo b) -> m (WithDeps (InsPermInfo b))
forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet (Column b)
-> AnnBoolExpPartialSQL b
-> HashMap (Column b) (PartialSQLExp b)
-> Bool
-> HashSet Text
-> InsPermInfo b
forall (b :: BackendType).
HashSet (Column b)
-> AnnBoolExpPartialSQL b
-> PreSetColsPartial b
-> Bool
-> HashSet Text
-> InsPermInfo b
InsPermInfo ([Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [Column b]
insColsWithoutPresets) AnnBoolExpPartialSQL b
be HashMap (Column b) (PartialSQLExp b)
setColsSQL Bool
backendOnly HashSet Text
reqHdrs, [SchemaDependency]
deps)
  where
    allInsCols :: [Column b]
allInsCols = (ColumnInfo b -> Column b) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ([ColumnInfo b] -> [Column b]) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> a -> b
$ (ColumnInfo b -> Bool) -> [ColumnInfo b] -> [ColumnInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter (ColumnMutability -> Bool
_cmIsInsertable (ColumnMutability -> Bool)
-> (ColumnInfo b -> ColumnMutability) -> ColumnInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo b -> ColumnMutability
forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciMutability) ([ColumnInfo b] -> [ColumnInfo b])
-> [ColumnInfo b] -> [ColumnInfo b]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b) -> [ColumnInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ColumnInfo backend]
getCols FieldInfoMap (FieldInfo b)
fieldInfoMap
    insCols :: [Column b]
insCols = [Column b] -> PermColSpec b -> [Column b]
forall (b :: BackendType).
[Column b] -> PermColSpec b -> [Column b]
interpColSpec [Column b]
allInsCols (PermColSpec b -> Maybe (PermColSpec b) -> PermColSpec b
forall a. a -> Maybe a -> a
fromMaybe PermColSpec b
forall (b :: BackendType). PermColSpec b
PCStar Maybe (PermColSpec b)
mCols)
    relInInsErr :: Text
relInInsErr = Text
"Only table columns can have insert permissions defined, not relationships or other field types"

-- | validate the values present in the `query_root_fields` and the `subscription_root_fields`
--   present in the select permission
validateAllowedRootFields ::
  forall b m.
  (QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
  SourceName ->
  TableName b ->
  RoleName ->
  SelPerm b ->
  m (AllowedRootFields QueryRootFieldType, AllowedRootFields SubscriptionRootFieldType)
validateAllowedRootFields :: SourceName
-> TableName b
-> RoleName
-> SelPerm b
-> m (AllowedRootFields QueryRootFieldType,
      AllowedRootFields SubscriptionRootFieldType)
validateAllowedRootFields SourceName
sourceName TableName b
tableName RoleName
roleName SelPerm {Bool
[ComputedFieldName]
Maybe Int
BoolExp b
AllowedRootFields SubscriptionRootFieldType
AllowedRootFields QueryRootFieldType
PermColSpec b
spAllowedSubscriptionRootFields :: forall (b :: BackendType).
SelPerm b -> AllowedRootFields SubscriptionRootFieldType
spAllowedQueryRootFields :: forall (b :: BackendType).
SelPerm b -> AllowedRootFields QueryRootFieldType
spComputedFields :: forall (b :: BackendType). SelPerm b -> [ComputedFieldName]
spAllowAggregations :: forall (b :: BackendType). SelPerm b -> Bool
spLimit :: forall (b :: BackendType). SelPerm b -> Maybe Int
spFilter :: forall (b :: BackendType). SelPerm b -> BoolExp b
spColumns :: forall (b :: BackendType). SelPerm b -> PermColSpec b
spAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spComputedFields :: [ComputedFieldName]
spAllowAggregations :: Bool
spLimit :: Maybe Int
spFilter :: BoolExp b
spColumns :: PermColSpec b
..} = do
  TableCoreInfo b
tableCoreInfo <- TableName b -> m (Maybe (TableCoreInfo b))
forall (b :: BackendType) (m :: * -> *).
TableCoreInfoRM b m =>
TableName b -> m (Maybe (TableCoreInfo b))
lookupTableCoreInfo @b TableName b
tableName m (Maybe (TableCoreInfo b))
-> (Maybe (TableCoreInfo b) -> m (TableCoreInfo b))
-> m (TableCoreInfo b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe (TableCoreInfo b)
-> m (TableCoreInfo b) -> m (TableCoreInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` (Text -> m (TableCoreInfo b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m (TableCoreInfo b)) -> Text -> m (TableCoreInfo b)
forall a b. (a -> b) -> a -> b
$ Text
"unexpected: table not found " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName))

  -- validate the query_root_fields and subscription_root_fields values
  let needToValidatePrimaryKeyRootField :: Bool
needToValidatePrimaryKeyRootField =
        QueryRootFieldType
QRFTSelectByPk QueryRootFieldType -> AllowedRootFields QueryRootFieldType -> Bool
forall a. (Eq a, Hashable a) => a -> AllowedRootFields a -> Bool
`rootFieldNeedsValidation` AllowedRootFields QueryRootFieldType
spAllowedQueryRootFields
          Bool -> Bool -> Bool
|| SubscriptionRootFieldType
SRFTSelectByPk SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType -> Bool
forall a. (Eq a, Hashable a) => a -> AllowedRootFields a -> Bool
`rootFieldNeedsValidation` AllowedRootFields SubscriptionRootFieldType
spAllowedSubscriptionRootFields
      needToValidateAggregationRootField :: Bool
needToValidateAggregationRootField =
        QueryRootFieldType
QRFTSelectAggregate QueryRootFieldType -> AllowedRootFields QueryRootFieldType -> Bool
forall a. (Eq a, Hashable a) => a -> AllowedRootFields a -> Bool
`rootFieldNeedsValidation` AllowedRootFields QueryRootFieldType
spAllowedQueryRootFields
          Bool -> Bool -> Bool
|| SubscriptionRootFieldType
SRFTSelectAggregate SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType -> Bool
forall a. (Eq a, Hashable a) => a -> AllowedRootFields a -> Bool
`rootFieldNeedsValidation` AllowedRootFields SubscriptionRootFieldType
spAllowedSubscriptionRootFields

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needToValidatePrimaryKeyRootField (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ TableCoreInfo b -> m ()
validatePrimaryKeyRootField TableCoreInfo b
tableCoreInfo
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needToValidateAggregationRootField (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m ()
validateAggregationRootField

  (AllowedRootFields QueryRootFieldType,
 AllowedRootFields SubscriptionRootFieldType)
-> m (AllowedRootFields QueryRootFieldType,
      AllowedRootFields SubscriptionRootFieldType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllowedRootFields QueryRootFieldType
spAllowedQueryRootFields, AllowedRootFields SubscriptionRootFieldType
spAllowedSubscriptionRootFields)
  where
    rootFieldNeedsValidation :: a -> AllowedRootFields a -> Bool
rootFieldNeedsValidation a
rootField = \case
      AllowedRootFields a
ARFAllowAllRootFields -> Bool
False
      ARFAllowConfiguredRootFields HashSet a
allowedRootFields -> a
rootField a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet a
allowedRootFields

    pkValidationError :: m ()
pkValidationError =
      Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        Text
"The \"select_by_pk\" field cannot be included in the query_root_fields or subscription_root_fields"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because the role "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName
          RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not have access to the primary key of the table "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
tableName
          TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in the source " Text -> SourceName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SourceName
sourceName
    validatePrimaryKeyRootField :: TableCoreInfo b -> m ()
validatePrimaryKeyRootField TableCoreInfo {Maybe EnumValues
Maybe ApolloFederationConfig
Maybe PGDescription
Maybe ViewInfo
Maybe (PrimaryKey b (ColumnInfo b))
FieldInfoMap (FieldInfo b)
HashSet (ForeignKey b)
HashSet (UniqueConstraint b)
TableName b
ExtraTableMetadata b
TableConfig b
_tciApolloFederationConfig :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe ApolloFederationConfig
_tciExtraTableMetadata :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciCustomConfig :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciEnumValues :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe EnumValues
_tciViewInfo :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe ViewInfo
_tciForeignKeys :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> HashSet (ForeignKey b)
_tciUniqueConstraints :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> HashSet (UniqueConstraint b)
_tciPrimaryKey :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciFieldInfoMap :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciDescription :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe PGDescription
_tciName :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciApolloFederationConfig :: Maybe ApolloFederationConfig
_tciExtraTableMetadata :: ExtraTableMetadata b
_tciCustomConfig :: TableConfig b
_tciEnumValues :: Maybe EnumValues
_tciViewInfo :: Maybe ViewInfo
_tciForeignKeys :: HashSet (ForeignKey b)
_tciUniqueConstraints :: HashSet (UniqueConstraint b)
_tciPrimaryKey :: Maybe (PrimaryKey b (ColumnInfo b))
_tciFieldInfoMap :: FieldInfoMap (FieldInfo b)
_tciDescription :: Maybe PGDescription
_tciName :: TableName b
..} =
      case Maybe (PrimaryKey b (ColumnInfo b))
_tciPrimaryKey of
        Maybe (PrimaryKey b (ColumnInfo b))
Nothing -> m ()
pkValidationError
        Just (PrimaryKey Constraint b
_ NESeq (ColumnInfo b)
pkCols) ->
          case PermColSpec b
spColumns of
            PermColSpec b
PCStar -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            PCCols ([Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList -> HashSet (Column b)
selPermCols) ->
              -- Check if all the primary key columns of the table are
              -- accessible to the current role
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((ColumnInfo b -> Bool) -> NESeq (ColumnInfo b) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Column b -> HashSet (Column b) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet (Column b)
selPermCols) (Column b -> Bool)
-> (ColumnInfo b -> Column b) -> ColumnInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn) NESeq (ColumnInfo b)
pkCols) m ()
pkValidationError

    validateAggregationRootField :: m ()
validateAggregationRootField =
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
spAllowAggregations (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
          Text
"The \"select_aggregate\" root field can only be enabled in the query_root_fields or "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" the subscription_root_fields when \"allow_aggregations\" is set to true"

buildSelPermInfo ::
  forall b m.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b
  ) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  RoleName ->
  SelPerm b ->
  m (WithDeps (SelPermInfo b))
buildSelPermInfo :: SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> RoleName
-> SelPerm b
-> m (WithDeps (SelPermInfo b))
buildSelPermInfo SourceName
source TableName b
tableName FieldInfoMap (FieldInfo b)
fieldInfoMap RoleName
roleName SelPerm b
sp = Text
-> m (WithDeps (SelPermInfo b)) -> m (WithDeps (SelPermInfo b))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"permission" (m (WithDeps (SelPermInfo b)) -> m (WithDeps (SelPermInfo b)))
-> m (WithDeps (SelPermInfo b)) -> m (WithDeps (SelPermInfo b))
forall a b. (a -> b) -> a -> b
$ do
  let pgCols :: [Column b]
pgCols = [Column b] -> PermColSpec b -> [Column b]
forall (b :: BackendType).
[Column b] -> PermColSpec b -> [Column b]
interpColSpec ((ColumnInfo b -> Column b) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ([ColumnInfo b] -> [Column b]) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> a -> b
$ (FieldInfoMap (FieldInfo b) -> [ColumnInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ColumnInfo backend]
getCols FieldInfoMap (FieldInfo b)
fieldInfoMap)) (PermColSpec b -> [Column b]) -> PermColSpec b -> [Column b]
forall a b. (a -> b) -> a -> b
$ SelPerm b -> PermColSpec b
forall (b :: BackendType). SelPerm b -> PermColSpec b
spColumns SelPerm b
sp

  (AnnBoolExpPartialSQL b
spiFilter, [SchemaDependency]
boolExpDeps) <-
    Text
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"filter" (m (AnnBoolExpPartialSQL b, [SchemaDependency])
 -> m (AnnBoolExpPartialSQL b, [SchemaDependency]))
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall a b. (a -> b) -> a -> b
$
      SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) (b :: BackendType).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
procBoolExp SourceName
source TableName b
tableName FieldInfoMap (FieldInfo b)
fieldInfoMap (BoolExp b -> m (AnnBoolExpPartialSQL b, [SchemaDependency]))
-> BoolExp b -> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall a b. (a -> b) -> a -> b
$ SelPerm b -> BoolExp b
forall (b :: BackendType). SelPerm b -> BoolExp b
spFilter SelPerm b
sp

  -- check if the columns exist
  m [ColumnType b] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [ColumnType b] -> m ()) -> m [ColumnType b] -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> m [ColumnType b] -> m [ColumnType b]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"columns" (m [ColumnType b] -> m [ColumnType b])
-> m [ColumnType b] -> m [ColumnType b]
forall a b. (a -> b) -> a -> b
$
      [Column b] -> (Column b -> m (ColumnType b)) -> m [ColumnType b]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [Column b]
pgCols ((Column b -> m (ColumnType b)) -> m [ColumnType b])
-> (Column b -> m (ColumnType b)) -> m [ColumnType b]
forall a b. (a -> b) -> a -> b
$ \Column b
pgCol ->
        FieldInfoMap (FieldInfo b) -> Column b -> Text -> m (ColumnType b)
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnType backend)
askColumnType FieldInfoMap (FieldInfo b)
fieldInfoMap Column b
pgCol Text
autoInferredErr

  -- validate computed fields
  [ComputedFieldName]
validComputedFields <-
    Text -> m [ComputedFieldName] -> m [ComputedFieldName]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"computed_fields" (m [ComputedFieldName] -> m [ComputedFieldName])
-> m [ComputedFieldName] -> m [ComputedFieldName]
forall a b. (a -> b) -> a -> b
$
      [ComputedFieldName]
-> (ComputedFieldName -> m ComputedFieldName)
-> m [ComputedFieldName]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [ComputedFieldName]
computedFields ((ComputedFieldName -> m ComputedFieldName)
 -> m [ComputedFieldName])
-> (ComputedFieldName -> m ComputedFieldName)
-> m [ComputedFieldName]
forall a b. (a -> b) -> a -> b
$ \ComputedFieldName
fieldName -> do
        ComputedFieldInfo b
computedFieldInfo <- FieldInfoMap (FieldInfo b)
-> ComputedFieldName -> m (ComputedFieldInfo b)
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> ComputedFieldName -> m (ComputedFieldInfo backend)
askComputedFieldInfo FieldInfoMap (FieldInfo b)
fieldInfoMap ComputedFieldName
fieldName
        case ComputedFieldReturn b -> ComputedFieldReturnType b
forall (b :: BackendType).
Backend b =>
ComputedFieldReturn b -> ComputedFieldReturnType b
computedFieldReturnType @b (ComputedFieldInfo b -> ComputedFieldReturn b
forall (b :: BackendType).
ComputedFieldInfo b -> ComputedFieldReturn b
_cfiReturnType ComputedFieldInfo b
computedFieldInfo) of
          ReturnsScalar ScalarType b
_ -> ComputedFieldName -> m ComputedFieldName
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComputedFieldName
fieldName
          ReturnsTable TableName b
returnTable ->
            Code -> Text -> m ComputedFieldName
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m ComputedFieldName) -> Text -> m ComputedFieldName
forall a b. (a -> b) -> a -> b
$
              Text
"select permissions on computed field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComputedFieldName
fieldName
                ComputedFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" are auto-derived from the permissions on its returning table "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
returnTable
                TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" and cannot be specified manually"
          ComputedFieldReturnType b
ReturnsOthers -> ComputedFieldName -> m ComputedFieldName
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComputedFieldName
fieldName

  let deps :: [SchemaDependency]
deps =
        SourceName -> TableName b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SchemaDependency
mkParentDep @b SourceName
source TableName b
tableName SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
:
        [SchemaDependency]
boolExpDeps [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. [a] -> [a] -> [a]
++ (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map (DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b DependencyReason
DRUntyped SourceName
source TableName b
tableName) [Column b]
pgCols
          [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. [a] -> [a] -> [a]
++ (ComputedFieldName -> SchemaDependency)
-> [ComputedFieldName] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map (DependencyReason
-> SourceName
-> TableName b
-> ComputedFieldName
-> SchemaDependency
forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName
-> TableName b
-> ComputedFieldName
-> SchemaDependency
mkComputedFieldDep @b DependencyReason
DRUntyped SourceName
source TableName b
tableName) [ComputedFieldName]
validComputedFields
      spiRequiredHeaders :: HashSet Text
spiRequiredHeaders = BoolExp b -> HashSet Text
forall (b :: BackendType). BoolExp b -> HashSet Text
getDependentHeaders (BoolExp b -> HashSet Text) -> BoolExp b -> HashSet Text
forall a b. (a -> b) -> a -> b
$ SelPerm b -> BoolExp b
forall (b :: BackendType). SelPerm b -> BoolExp b
spFilter SelPerm b
sp
      spiLimit :: Maybe Int
spiLimit = SelPerm b -> Maybe Int
forall (b :: BackendType). SelPerm b -> Maybe Int
spLimit SelPerm b
sp

  Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"limit" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Int -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Int
spiLimit \Int
value ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
value Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"unexpected negative value"

  let spiCols :: HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiCols = [(Column b, Maybe (AnnColumnCaseBoolExpPartialSQL b))]
-> HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Column b, Maybe (AnnColumnCaseBoolExpPartialSQL b))]
 -> HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b)))
-> [(Column b, Maybe (AnnColumnCaseBoolExpPartialSQL b))]
-> HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
forall a b. (a -> b) -> a -> b
$ (Column b -> (Column b, Maybe (AnnColumnCaseBoolExpPartialSQL b)))
-> [Column b]
-> [(Column b, Maybe (AnnColumnCaseBoolExpPartialSQL b))]
forall a b. (a -> b) -> [a] -> [b]
map (,Maybe (AnnColumnCaseBoolExpPartialSQL b)
forall a. Maybe a
Nothing) [Column b]
pgCols
      spiComputedFields :: HashMap
  ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiComputedFields = HashSet ComputedFieldName -> HashMap ComputedFieldName ()
forall a. HashSet a -> HashMap a ()
HS.toMap ([ComputedFieldName] -> HashSet ComputedFieldName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [ComputedFieldName]
validComputedFields) HashMap ComputedFieldName ()
-> Maybe (AnnColumnCaseBoolExpPartialSQL b)
-> HashMap
     ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (AnnColumnCaseBoolExpPartialSQL b)
forall a. Maybe a
Nothing

  (AllowedRootFields QueryRootFieldType
spiAllowedQueryRootFields, AllowedRootFields SubscriptionRootFieldType
spiAllowedSubscriptionRootFields) <-
    SourceName
-> TableName b
-> RoleName
-> SelPerm b
-> m (AllowedRootFields QueryRootFieldType,
      AllowedRootFields SubscriptionRootFieldType)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
SourceName
-> TableName b
-> RoleName
-> SelPerm b
-> m (AllowedRootFields QueryRootFieldType,
      AllowedRootFields SubscriptionRootFieldType)
validateAllowedRootFields SourceName
source TableName b
tableName RoleName
roleName SelPerm b
sp

  WithDeps (SelPermInfo b) -> m (WithDeps (SelPermInfo b))
forall (m :: * -> *) a. Monad m => a -> m a
return (SelPermInfo :: forall (b :: BackendType).
HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
-> HashMap
     ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
-> AnnBoolExpPartialSQL b
-> Maybe Int
-> Bool
-> HashSet Text
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> SelPermInfo b
SelPermInfo {Bool
Maybe Int
HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
HashMap
  ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
HashSet Text
AnnBoolExpPartialSQL b
AllowedRootFields SubscriptionRootFieldType
AllowedRootFields QueryRootFieldType
spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spiRequiredHeaders :: HashSet Text
spiAllowAgg :: Bool
spiLimit :: Maybe Int
spiFilter :: AnnBoolExpPartialSQL b
spiComputedFields :: HashMap
  ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiCols :: HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiAllowAgg :: Bool
spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spiComputedFields :: HashMap
  ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiCols :: HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiLimit :: Maybe Int
spiRequiredHeaders :: HashSet Text
spiFilter :: AnnBoolExpPartialSQL b
..}, [SchemaDependency]
deps)
  where
    spiAllowAgg :: Bool
spiAllowAgg = SelPerm b -> Bool
forall (b :: BackendType). SelPerm b -> Bool
spAllowAggregations SelPerm b
sp
    computedFields :: [ComputedFieldName]
computedFields = SelPerm b -> [ComputedFieldName]
forall (b :: BackendType). SelPerm b -> [ComputedFieldName]
spComputedFields SelPerm b
sp
    autoInferredErr :: Text
autoInferredErr = Text
"permissions for relationships are automatically inferred"

buildUpdPermInfo ::
  forall b m.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b
  ) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  UpdPerm b ->
  m (WithDeps (UpdPermInfo b))
buildUpdPermInfo :: SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> UpdPerm b
-> m (WithDeps (UpdPermInfo b))
buildUpdPermInfo SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap (UpdPerm PermColSpec b
colSpec Maybe (ColumnValues b Value)
set BoolExp b
fltr Maybe (BoolExp b)
check Bool
backendOnly) = do
  (AnnBoolExpPartialSQL b
be, [SchemaDependency]
beDeps) <-
    Text
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"filter" (m (AnnBoolExpPartialSQL b, [SchemaDependency])
 -> m (AnnBoolExpPartialSQL b, [SchemaDependency]))
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall a b. (a -> b) -> a -> b
$
      SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) (b :: BackendType).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
procBoolExp SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap BoolExp b
fltr

  Maybe (AnnBoolExpPartialSQL b, [SchemaDependency])
checkExpr <- (BoolExp b -> m (AnnBoolExpPartialSQL b, [SchemaDependency]))
-> Maybe (BoolExp b)
-> m (Maybe (AnnBoolExpPartialSQL b, [SchemaDependency]))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"check" (m (AnnBoolExpPartialSQL b, [SchemaDependency])
 -> m (AnnBoolExpPartialSQL b, [SchemaDependency]))
-> (BoolExp b -> m (AnnBoolExpPartialSQL b, [SchemaDependency]))
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) (b :: BackendType).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
procBoolExp SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap) Maybe (BoolExp b)
check

  (HashMap (Column b) (PartialSQLExp b)
setColsSQL, [Text]
setHeaders, [SchemaDependency]
setColDeps) <- SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (HashMap (Column b) (PartialSQLExp b), [Text],
      [SchemaDependency])
forall (b :: BackendType) (m :: * -> *).
(QErrM m, BackendMetadata b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (PreSetColsPartial b, [Text], [SchemaDependency])
procSetObj SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap Maybe (ColumnValues b Value)
set

  -- check if the columns exist
  m [()] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [()] -> m ()) -> m [()] -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> m [()] -> m [()]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"columns" (m [()] -> m [()]) -> m [()] -> m [()]
forall a b. (a -> b) -> a -> b
$
      [Column b] -> (Column b -> m ()) -> m [()]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [Column b]
updCols ((Column b -> m ()) -> m [()]) -> (Column b -> m ()) -> m [()]
forall a b. (a -> b) -> a -> b
$ \Column b
updCol -> do
        -- Check that all columns specified do in fact exist and are columns
        ColumnType b
_ <- FieldInfoMap (FieldInfo b) -> Column b -> Text -> m (ColumnType b)
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnType backend)
askColumnType FieldInfoMap (FieldInfo b)
fieldInfoMap Column b
updCol Text
relInUpdErr
        -- Check that the column is updatable
        ColumnInfo b
ci <- FieldInfoMap (FieldInfo b) -> Column b -> Text -> m (ColumnInfo b)
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnInfo backend)
askColInfo FieldInfoMap (FieldInfo b)
fieldInfoMap Column b
updCol Text
""
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ColumnMutability -> Bool
_cmIsUpdatable (ColumnMutability -> Bool) -> ColumnMutability -> Bool
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> ColumnMutability
forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciMutability ColumnInfo b
ci) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
            ( Text
"Column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column b
updCol
                Column b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not updatable and so cannot have update permissions defined"
            )

  let updColDeps :: [SchemaDependency]
updColDeps = (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map (DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b DependencyReason
DRUntyped SourceName
source TableName b
tn) [Column b]
updCols
      deps :: [SchemaDependency]
deps = SourceName -> TableName b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SchemaDependency
mkParentDep @b SourceName
source TableName b
tn SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
: [SchemaDependency]
beDeps [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. [a] -> [a] -> [a]
++ [SchemaDependency]
-> ((AnnBoolExpPartialSQL b, [SchemaDependency])
    -> [SchemaDependency])
-> Maybe (AnnBoolExpPartialSQL b, [SchemaDependency])
-> [SchemaDependency]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (AnnBoolExpPartialSQL b, [SchemaDependency]) -> [SchemaDependency]
forall a b. (a, b) -> b
snd Maybe (AnnBoolExpPartialSQL b, [SchemaDependency])
checkExpr [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. [a] -> [a] -> [a]
++ [SchemaDependency]
updColDeps [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. [a] -> [a] -> [a]
++ [SchemaDependency]
setColDeps
      depHeaders :: HashSet Text
depHeaders = BoolExp b -> HashSet Text
forall (b :: BackendType). BoolExp b -> HashSet Text
getDependentHeaders BoolExp b
fltr
      reqHeaders :: HashSet Text
reqHeaders = HashSet Text
depHeaders HashSet Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`HS.union` ([Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [Text]
setHeaders)
      updColsWithoutPreSets :: [Column b]
updColsWithoutPreSets = [Column b]
updCols [Column b] -> [Column b] -> [Column b]
forall a. Eq a => [a] -> [a] -> [a]
\\ HashMap (Column b) (PartialSQLExp b) -> [Column b]
forall k v. HashMap k v -> [k]
HM.keys HashMap (Column b) (PartialSQLExp b)
setColsSQL

  WithDeps (UpdPermInfo b) -> m (WithDeps (UpdPermInfo b))
forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet (Column b)
-> TableName b
-> AnnBoolExpPartialSQL b
-> Maybe (AnnBoolExpPartialSQL b)
-> HashMap (Column b) (PartialSQLExp b)
-> Bool
-> HashSet Text
-> UpdPermInfo b
forall (b :: BackendType).
HashSet (Column b)
-> TableName b
-> AnnBoolExpPartialSQL b
-> Maybe (AnnBoolExpPartialSQL b)
-> PreSetColsPartial b
-> Bool
-> HashSet Text
-> UpdPermInfo b
UpdPermInfo ([Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [Column b]
updColsWithoutPreSets) TableName b
tn AnnBoolExpPartialSQL b
be ((AnnBoolExpPartialSQL b, [SchemaDependency])
-> AnnBoolExpPartialSQL b
forall a b. (a, b) -> a
fst ((AnnBoolExpPartialSQL b, [SchemaDependency])
 -> AnnBoolExpPartialSQL b)
-> Maybe (AnnBoolExpPartialSQL b, [SchemaDependency])
-> Maybe (AnnBoolExpPartialSQL b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AnnBoolExpPartialSQL b, [SchemaDependency])
checkExpr) HashMap (Column b) (PartialSQLExp b)
setColsSQL Bool
backendOnly HashSet Text
reqHeaders, [SchemaDependency]
deps)
  where
    allUpdCols :: [Column b]
allUpdCols = (ColumnInfo b -> Column b) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ([ColumnInfo b] -> [Column b]) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> a -> b
$ (ColumnInfo b -> Bool) -> [ColumnInfo b] -> [ColumnInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter (ColumnMutability -> Bool
_cmIsUpdatable (ColumnMutability -> Bool)
-> (ColumnInfo b -> ColumnMutability) -> ColumnInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo b -> ColumnMutability
forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciMutability) ([ColumnInfo b] -> [ColumnInfo b])
-> [ColumnInfo b] -> [ColumnInfo b]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b) -> [ColumnInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ColumnInfo backend]
getCols FieldInfoMap (FieldInfo b)
fieldInfoMap
    updCols :: [Column b]
updCols = [Column b] -> PermColSpec b -> [Column b]
forall (b :: BackendType).
[Column b] -> PermColSpec b -> [Column b]
interpColSpec [Column b]
allUpdCols PermColSpec b
colSpec
    relInUpdErr :: Text
relInUpdErr = Text
"Only table columns can have update permissions defined, not relationships or other field types"

buildDelPermInfo ::
  forall b m.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b
  ) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  DelPerm b ->
  m (WithDeps (DelPermInfo b))
buildDelPermInfo :: SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> DelPerm b
-> m (WithDeps (DelPermInfo b))
buildDelPermInfo SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap (DelPerm BoolExp b
fltr Bool
backendOnly) = do
  (AnnBoolExpPartialSQL b
be, [SchemaDependency]
beDeps) <-
    Text
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"filter" (m (AnnBoolExpPartialSQL b, [SchemaDependency])
 -> m (AnnBoolExpPartialSQL b, [SchemaDependency]))
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall a b. (a -> b) -> a -> b
$
      SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) (b :: BackendType).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
procBoolExp SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap BoolExp b
fltr
  let deps :: [SchemaDependency]
deps = SourceName -> TableName b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SchemaDependency
mkParentDep @b SourceName
source TableName b
tn SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
: [SchemaDependency]
beDeps
      depHeaders :: HashSet Text
depHeaders = BoolExp b -> HashSet Text
forall (b :: BackendType). BoolExp b -> HashSet Text
getDependentHeaders BoolExp b
fltr
  WithDeps (DelPermInfo b) -> m (WithDeps (DelPermInfo b))
forall (m :: * -> *) a. Monad m => a -> m a
return (TableName b
-> AnnBoolExpPartialSQL b -> Bool -> HashSet Text -> DelPermInfo b
forall (b :: BackendType).
TableName b
-> AnnBoolExpPartialSQL b -> Bool -> HashSet Text -> DelPermInfo b
DelPermInfo TableName b
tn AnnBoolExpPartialSQL b
be Bool
backendOnly HashSet Text
depHeaders, [SchemaDependency]
deps)

data SetPermComment b = SetPermComment
  { SetPermComment b -> SourceName
apSource :: SourceName,
    SetPermComment b -> TableName b
apTable :: TableName b,
    SetPermComment b -> RoleName
apRole :: RoleName,
    SetPermComment b -> PermType
apPermission :: PermType,
    SetPermComment b -> Maybe Text
apComment :: Maybe Text
  }

instance (Backend b) => FromJSON (SetPermComment b) where
  parseJSON :: Value -> Parser (SetPermComment b)
parseJSON = String
-> (Object -> Parser (SetPermComment b))
-> Value
-> Parser (SetPermComment b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetPermComment" ((Object -> Parser (SetPermComment b))
 -> Value -> Parser (SetPermComment b))
-> (Object -> Parser (SetPermComment b))
-> Value
-> Parser (SetPermComment b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName
-> TableName b
-> RoleName
-> PermType
-> Maybe Text
-> SetPermComment b
forall (b :: BackendType).
SourceName
-> TableName b
-> RoleName
-> PermType
-> Maybe Text
-> SetPermComment b
SetPermComment
      (SourceName
 -> TableName b
 -> RoleName
 -> PermType
 -> Maybe Text
 -> SetPermComment b)
-> Parser SourceName
-> Parser
     (TableName b
      -> RoleName -> PermType -> Maybe Text -> SetPermComment b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser
  (TableName b
   -> RoleName -> PermType -> Maybe Text -> SetPermComment b)
-> Parser (TableName b)
-> Parser (RoleName -> PermType -> Maybe Text -> SetPermComment b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (RoleName -> PermType -> Maybe Text -> SetPermComment b)
-> Parser RoleName
-> Parser (PermType -> Maybe Text -> SetPermComment b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser RoleName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"
      Parser (PermType -> Maybe Text -> SetPermComment b)
-> Parser PermType -> Parser (Maybe Text -> SetPermComment b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser PermType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permission"
      Parser (Maybe Text -> SetPermComment b)
-> Parser (Maybe Text) -> Parser (SetPermComment b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment"

runSetPermComment ::
  forall b m.
  (QErrM m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  SetPermComment b ->
  m EncJSON
runSetPermComment :: SetPermComment b -> m EncJSON
runSetPermComment (SetPermComment SourceName
source TableName b
table RoleName
roleName PermType
permType Maybe Text
comment) = do
  TableInfo b
tableInfo <- SourceName -> TableName b -> m (TableInfo b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @b SourceName
source TableName b
table

  -- assert permission exists and return appropriate permission modifier
  TableMetadata b -> TableMetadata b
permModifier <- case PermType
permType of
    PermType
PTInsert -> do
      RoleName -> PermType -> TableInfo b -> m ()
forall (backend :: BackendType) (m :: * -> *).
(Backend backend, MonadError QErr m) =>
RoleName -> PermType -> TableInfo backend -> m ()
assertPermDefined RoleName
roleName PermType
PTInsert TableInfo b
tableInfo
      (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ (Permissions (InsPermDef b)
 -> Identity (Permissions (InsPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (InsPermDef b))
tmInsertPermissions ((Permissions (InsPermDef b)
  -> Identity (Permissions (InsPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Permissions (InsPermDef b)
    -> Identity (Permissions (InsPermDef b)))
-> (Maybe Text -> Identity (Maybe Text))
-> TableMetadata b
-> Identity (TableMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Permissions (InsPermDef b))
-> Traversal'
     (Permissions (InsPermDef b)) (IxValue (Permissions (InsPermDef b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Permissions (InsPermDef b))
RoleName
roleName ((InsPermDef b -> Identity (InsPermDef b))
 -> Permissions (InsPermDef b)
 -> Identity (Permissions (InsPermDef b)))
-> ((Maybe Text -> Identity (Maybe Text))
    -> InsPermDef b -> Identity (InsPermDef b))
-> (Maybe Text -> Identity (Maybe Text))
-> Permissions (InsPermDef b)
-> Identity (Permissions (InsPermDef b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> InsPermDef b -> Identity (InsPermDef b)
forall (b :: BackendType) (perm :: BackendType -> *).
Lens' (PermDef b perm) (Maybe Text)
pdComment ((Maybe Text -> Identity (Maybe Text))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe Text -> TableMetadata b -> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
comment
    PermType
PTSelect -> do
      RoleName -> PermType -> TableInfo b -> m ()
forall (backend :: BackendType) (m :: * -> *).
(Backend backend, MonadError QErr m) =>
RoleName -> PermType -> TableInfo backend -> m ()
assertPermDefined RoleName
roleName PermType
PTSelect TableInfo b
tableInfo
      (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ (Permissions (SelPermDef b)
 -> Identity (Permissions (SelPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (SelPermDef b))
tmSelectPermissions ((Permissions (SelPermDef b)
  -> Identity (Permissions (SelPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Permissions (SelPermDef b)
    -> Identity (Permissions (SelPermDef b)))
-> (Maybe Text -> Identity (Maybe Text))
-> TableMetadata b
-> Identity (TableMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Permissions (SelPermDef b))
-> Traversal'
     (Permissions (SelPermDef b)) (IxValue (Permissions (SelPermDef b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Permissions (SelPermDef b))
RoleName
roleName ((SelPermDef b -> Identity (SelPermDef b))
 -> Permissions (SelPermDef b)
 -> Identity (Permissions (SelPermDef b)))
-> ((Maybe Text -> Identity (Maybe Text))
    -> SelPermDef b -> Identity (SelPermDef b))
-> (Maybe Text -> Identity (Maybe Text))
-> Permissions (SelPermDef b)
-> Identity (Permissions (SelPermDef b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> SelPermDef b -> Identity (SelPermDef b)
forall (b :: BackendType) (perm :: BackendType -> *).
Lens' (PermDef b perm) (Maybe Text)
pdComment ((Maybe Text -> Identity (Maybe Text))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe Text -> TableMetadata b -> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
comment
    PermType
PTUpdate -> do
      RoleName -> PermType -> TableInfo b -> m ()
forall (backend :: BackendType) (m :: * -> *).
(Backend backend, MonadError QErr m) =>
RoleName -> PermType -> TableInfo backend -> m ()
assertPermDefined RoleName
roleName PermType
PTUpdate TableInfo b
tableInfo
      (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ (Permissions (UpdPermDef b)
 -> Identity (Permissions (UpdPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (UpdPermDef b))
tmUpdatePermissions ((Permissions (UpdPermDef b)
  -> Identity (Permissions (UpdPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Permissions (UpdPermDef b)
    -> Identity (Permissions (UpdPermDef b)))
-> (Maybe Text -> Identity (Maybe Text))
-> TableMetadata b
-> Identity (TableMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Permissions (UpdPermDef b))
-> Traversal'
     (Permissions (UpdPermDef b)) (IxValue (Permissions (UpdPermDef b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Permissions (UpdPermDef b))
RoleName
roleName ((UpdPermDef b -> Identity (UpdPermDef b))
 -> Permissions (UpdPermDef b)
 -> Identity (Permissions (UpdPermDef b)))
-> ((Maybe Text -> Identity (Maybe Text))
    -> UpdPermDef b -> Identity (UpdPermDef b))
-> (Maybe Text -> Identity (Maybe Text))
-> Permissions (UpdPermDef b)
-> Identity (Permissions (UpdPermDef b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> UpdPermDef b -> Identity (UpdPermDef b)
forall (b :: BackendType) (perm :: BackendType -> *).
Lens' (PermDef b perm) (Maybe Text)
pdComment ((Maybe Text -> Identity (Maybe Text))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe Text -> TableMetadata b -> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
comment
    PermType
PTDelete -> do
      RoleName -> PermType -> TableInfo b -> m ()
forall (backend :: BackendType) (m :: * -> *).
(Backend backend, MonadError QErr m) =>
RoleName -> PermType -> TableInfo backend -> m ()
assertPermDefined RoleName
roleName PermType
PTDelete TableInfo b
tableInfo
      (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ (Permissions (DelPermDef b)
 -> Identity (Permissions (DelPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Permissions (DelPermDef b))
tmDeletePermissions ((Permissions (DelPermDef b)
  -> Identity (Permissions (DelPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Permissions (DelPermDef b)
    -> Identity (Permissions (DelPermDef b)))
-> (Maybe Text -> Identity (Maybe Text))
-> TableMetadata b
-> Identity (TableMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Permissions (DelPermDef b))
-> Traversal'
     (Permissions (DelPermDef b)) (IxValue (Permissions (DelPermDef b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Permissions (DelPermDef b))
RoleName
roleName ((DelPermDef b -> Identity (DelPermDef b))
 -> Permissions (DelPermDef b)
 -> Identity (Permissions (DelPermDef b)))
-> ((Maybe Text -> Identity (Maybe Text))
    -> DelPermDef b -> Identity (DelPermDef b))
-> (Maybe Text -> Identity (Maybe Text))
-> Permissions (DelPermDef b)
-> Identity (Permissions (DelPermDef b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> DelPermDef b -> Identity (DelPermDef b)
forall (b :: BackendType) (perm :: BackendType -> *).
Lens' (PermDef b perm) (Maybe Text)
pdComment ((Maybe Text -> Identity (Maybe Text))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe Text -> TableMetadata b -> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
comment

  let metadataObject :: MetadataObjId
metadataObject =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$
          SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$
            TableName b -> TableMetadataObjId -> SourceMetadataObjId b
forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
table (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$
              RoleName -> PermType -> TableMetadataObjId
MTOPerm RoleName
roleName PermType
permType
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObject (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$
    (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
      SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
table ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TableMetadata b -> TableMetadata b
permModifier
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg