{-# 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,
    buildLogicalModelPermInfo,
    addPermissionToMetadata,
    annBoolExp,
  )
where

import Control.Lens (Lens', (.~), (^?))
import Data.Aeson
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Environment qualified as Env
import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashSet qualified as HS
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.LogicalModel.Common (logicalModelFieldsToFieldInfo)
import Hasura.LogicalModel.Types (LogicalModelField (..), LogicalModelName)
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.Roles (RoleName, adminRoleName)
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Types
import Hasura.Session (UserInfoM)
import Hasura.Table.Cache
import Hasura.Table.Metadata
  ( Permissions,
    TableMetadata,
    tmDeletePermissions,
    tmInsertPermissions,
    tmSelectPermissions,
    tmUpdatePermissions,
  )

{- 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 r.
  (QErrM m, BackendMetadata b, MonadReader r m, Has (ScalarTypeParsingContext b) r) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  Maybe (ColumnValues b Value) ->
  m (PreSetColsPartial b, [Text], Seq SchemaDependency)
procSetObj :: forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, BackendMetadata b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (PreSetColsPartial b, [Text], Seq SchemaDependency)
procSetObj SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap Maybe (HashMap (Column 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 a b. (a -> b) -> m a -> m b
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 (HashMap (Column b) Value -> [(Column b, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap (Column 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 :: * -> *) r.
(BackendMetadata b, MonadError QErr m, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
CollectableType (ColumnType b) -> Value -> m (PartialSQLExp b)
forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
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 = 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Column b
pgCol, PartialSQLExp b
sqlExp), SchemaDependency
dep)
  (PreSetColsPartial b, [Text], Seq SchemaDependency)
-> m (PreSetColsPartial b, [Text], Seq SchemaDependency)
forall a. a -> m a
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
HashMap.fromList [(Column b, PartialSQLExp b)]
setColTups, [Text]
depHeaders, [SchemaDependency] -> Seq SchemaDependency
forall a. [a] -> Seq a
Seq.fromList [SchemaDependency]
deps)
  where
    setObj :: HashMap (Column b) Value
setObj = HashMap (Column b) Value
-> Maybe (HashMap (Column b) Value) -> HashMap (Column b) Value
forall a. a -> Maybe a -> a
fromMaybe HashMap (Column b) Value
forall a. Monoid a => a
mempty Maybe (HashMap (Column 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 b c d. (b -> c) -> (b, d) -> (c, d)
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
$ HashMap (Column b) Value -> [(Column b, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap (Column 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 :: forall (b :: BackendType) (a :: BackendType -> *).
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) (f :: * -> *).
Functor f =>
(Permissions (InsPermDef b) -> f (Permissions (InsPermDef b)))
-> TableMetadata b -> f (TableMetadata 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
-> InsPermDef b
-> Permissions (InsPermDef b)
-> Permissions (InsPermDef b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permDef) PermDef b a
InsPermDef b
permDef
  SelPerm' SelPerm b
_ -> (Permissions (SelPermDef b)
 -> Identity (Permissions (SelPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (SelPermDef b) -> f (Permissions (SelPermDef b)))
-> TableMetadata b -> f (TableMetadata 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
-> SelPermDef b
-> Permissions (SelPermDef b)
-> Permissions (SelPermDef b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permDef) PermDef b a
SelPermDef b
permDef
  UpdPerm' UpdPerm b
_ -> (Permissions (UpdPermDef b)
 -> Identity (Permissions (UpdPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (UpdPermDef b) -> f (Permissions (UpdPermDef b)))
-> TableMetadata b -> f (TableMetadata 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
-> UpdPermDef b
-> Permissions (UpdPermDef b)
-> Permissions (UpdPermDef b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permDef) PermDef b a
UpdPermDef b
permDef
  DelPerm' DelPerm b
_ -> (Permissions (DelPermDef b)
 -> Identity (Permissions (DelPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (DelPermDef b) -> f (Permissions (DelPermDef b)))
-> TableMetadata b -> f (TableMetadata 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
-> DelPermDef b
-> Permissions (DelPermDef b)
-> Permissions (DelPermDef b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permDef) PermDef b a
DelPermDef b
permDef

buildPermInfo ::
  ( BackendMetadata b,
    QErrM m,
    TableCoreInfoRM b m,
    GetAggregationPredicatesDeps b,
    MonadReader r m,
    Has (ScalarTypeParsingContext b) r
  ) =>
  Env.Environment ->
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  RoleName ->
  PermDefPermission b perm ->
  m (WithDeps (PermInfo perm b))
buildPermInfo :: forall (b :: BackendType) (m :: * -> *) r
       (perm :: BackendType -> *).
(BackendMetadata b, QErrM m, TableCoreInfoRM b m,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> RoleName
-> PermDefPermission b perm
-> m (WithDeps (PermInfo perm b))
buildPermInfo Environment
e 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 :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
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 -> Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> InsPerm b
-> m (WithDeps (InsPermInfo b))
forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> InsPerm b
-> m (WithDeps (InsPermInfo b))
buildInsPermInfo Environment
e SourceName
x1 TableName b
x2 FieldInfoMap (FieldInfo b)
x3 InsPerm b
p
  UpdPerm' UpdPerm b
p -> Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> UpdPerm b
-> m (WithDeps (UpdPermInfo b))
forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> UpdPerm b
-> m (WithDeps (UpdPermInfo b))
buildUpdPermInfo Environment
e SourceName
x1 TableName b
x2 FieldInfoMap (FieldInfo b)
x3 UpdPerm b
p
  DelPerm' DelPerm b
p -> Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> DelPerm b
-> m (WithDeps (DelPermInfo b))
forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> DelPerm b
-> m (WithDeps (DelPermInfo b))
buildDelPermInfo Environment
e SourceName
x1 TableName b
x2 FieldInfoMap (FieldInfo b)
x3 DelPerm b
p

-- | Given the logical model's definition and the permissions as defined in the
-- logical model's metadata, try to construct the permission definition.
buildLogicalModelPermInfo ::
  ( BackendMetadata b,
    QErrM m,
    TableCoreInfoRM b m,
    GetAggregationPredicatesDeps b,
    MonadReader r m,
    Has (ScalarTypeParsingContext b) r
  ) =>
  SourceName ->
  LogicalModelName ->
  InsOrdHashMap.InsOrdHashMap (Column b) (LogicalModelField b) ->
  PermDefPermission b perm ->
  m (WithDeps (PermInfo perm b))
buildLogicalModelPermInfo :: forall (b :: BackendType) (m :: * -> *) r
       (perm :: BackendType -> *).
(BackendMetadata b, QErrM m, TableCoreInfoRM b m,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> PermDefPermission b perm
-> m (WithDeps (PermInfo perm b))
buildLogicalModelPermInfo SourceName
sourceName LogicalModelName
logicalModelName InsOrdHashMap (Column b) (LogicalModelField b)
fieldInfoMap = \case
  SelPerm' SelPerm b
p -> SourceName
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> SelPerm b
-> m (WithDeps (SelPermInfo b))
forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> SelPerm b
-> m (WithDeps (SelPermInfo b))
buildLogicalModelSelPermInfo SourceName
sourceName LogicalModelName
logicalModelName InsOrdHashMap (Column b) (LogicalModelField b)
fieldInfoMap SelPerm b
p
  InsPerm' InsPerm b
_ -> [Char] -> m (WithDeps (InsPermInfo b))
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented yet"
  UpdPerm' UpdPerm b
_ -> [Char] -> m (WithDeps (UpdPermInfo b))
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented yet"
  DelPerm' DelPerm b
_ -> [Char] -> m (WithDeps (DelPermInfo b))
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented yet"

doesPermissionExistInMetadata ::
  forall b.
  TableMetadata b ->
  RoleName ->
  PermType ->
  Bool
doesPermissionExistInMetadata :: forall (b :: BackendType).
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 (Permissions (InsPermDef b) -> f (Permissions (InsPermDef b)))
-> TableMetadata b -> f (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (InsPermDef b) -> f (Permissions (InsPermDef b)))
-> TableMetadata b -> f (TableMetadata 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 (Permissions (SelPermDef b) -> f (Permissions (SelPermDef b)))
-> TableMetadata b -> f (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (SelPermDef b) -> f (Permissions (SelPermDef b)))
-> TableMetadata b -> f (TableMetadata 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 (Permissions (UpdPermDef b) -> f (Permissions (UpdPermDef b)))
-> TableMetadata b -> f (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (UpdPermDef b) -> f (Permissions (UpdPermDef b)))
-> TableMetadata b -> f (TableMetadata 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 (Permissions (DelPermDef b) -> f (Permissions (DelPermDef b)))
-> TableMetadata b -> f (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (DelPermDef b) -> f (Permissions (DelPermDef b)))
-> TableMetadata b -> f (TableMetadata b)
Lens' (TableMetadata b) (Permissions (DelPermDef b))
tmDeletePermissions
  where
    hasPermissionTo :: forall a. Lens' (TableMetadata b) (Permissions a) -> Bool
    hasPermissionTo :: forall a. 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 :: forall (m :: * -> *) (b :: BackendType) (a :: BackendType -> *).
(UserInfoM m, CacheRWM m, MonadError QErr m, MetadataM m,
 BackendMetadata b) =>
CreatePerm a b -> m EncJSON
runCreatePerm (CreatePerm (WithTable SourceName
source TableName b
tableName PermDef b a
permissionDefn)) = do
  TableMetadata b
tableMetadata <- 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
$ 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
$ 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 a. a -> m a
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 :: forall (b :: BackendType) (m :: * -> *).
(UserInfoM m, CacheRWM m, MonadError QErr m, MetadataM m,
 BackendMetadata b) =>
PermType -> DropPerm b -> m EncJSON
runDropPerm PermType
permType (DropPerm SourceName
source TableName b
table RoleName
role) = do
  TableMetadata b
tableMetadata <- 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
$ 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

buildInsPermInfo ::
  forall b m r.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b,
    MonadReader r m,
    Has (ScalarTypeParsingContext b) r
  ) =>
  Env.Environment ->
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  InsPerm b ->
  m (WithDeps (InsPermInfo b))
buildInsPermInfo :: forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> InsPerm b
-> m (WithDeps (InsPermInfo b))
buildInsPermInfo Environment
env SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap (InsPerm BoolExp b
checkCond Maybe (ColumnValues b Value)
set Maybe (PermColSpec b)
mCols Bool
backendOnly Maybe (ValidateInput InputWebhook)
validateInput) =
  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, Seq SchemaDependency
beDeps) <- Text
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"check" (m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
 -> m (AnnBoolExpPartialSQL b, Seq SchemaDependency))
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall a b. (a -> b) -> a -> b
$ SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (m :: * -> *) (b :: BackendType) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
procBoolExp SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap BoolExp b
checkCond
    (HashMap (Column b) (PartialSQLExp b)
setColsSQL, [Text]
setHdrs, Seq SchemaDependency
setColDeps) <- SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (HashMap (Column b) (PartialSQLExp b), [Text],
      Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, BackendMetadata b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (PreSetColsPartial b, [Text], Seq 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 = forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b DependencyReason
DRUntyped SourceName
source TableName b
tn (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column b]
insCols
        deps :: Seq SchemaDependency
deps = forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SchemaDependency
mkParentDep @b SourceName
source TableName b
tn SchemaDependency -> Seq SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a -> Seq a
Seq.:<| Seq SchemaDependency
beDeps Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> Seq SchemaDependency
setColDeps Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> [SchemaDependency] -> Seq SchemaDependency
forall a. [a] -> Seq a
Seq.fromList [SchemaDependency]
insColDeps
        insColsWithoutPresets :: HashSet (Column b)
insColsWithoutPresets = [Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [Column b]
insCols HashSet (Column b) -> HashSet (Column b) -> HashSet (Column b)
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`HS.difference` HashMap (Column b) (PartialSQLExp b) -> HashSet (Column b)
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap (Column b) (PartialSQLExp b)
setColsSQL

    Maybe (ValidateInput ResolvedWebhook)
resolvedValidateInput <- Maybe (ValidateInput InputWebhook)
-> (ValidateInput InputWebhook
    -> m (ValidateInput ResolvedWebhook))
-> m (Maybe (ValidateInput ResolvedWebhook))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (ValidateInput InputWebhook)
validateInput ((InputWebhook -> m ResolvedWebhook)
-> ValidateInput InputWebhook -> m (ValidateInput ResolvedWebhook)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ValidateInput a -> f (ValidateInput b)
traverse (Environment -> InputWebhook -> m ResolvedWebhook
forall (m :: * -> *).
QErrM m =>
Environment -> InputWebhook -> m ResolvedWebhook
resolveWebhook Environment
env))

    WithDeps (InsPermInfo b) -> m (WithDeps (InsPermInfo b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet (Column b)
-> AnnBoolExpPartialSQL b
-> HashMap (Column b) (PartialSQLExp b)
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> InsPermInfo b
forall (b :: BackendType).
HashSet (Column b)
-> AnnBoolExpPartialSQL b
-> PreSetColsPartial b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> InsPermInfo b
InsPermInfo HashSet (Column b)
insColsWithoutPresets AnnBoolExpPartialSQL b
be HashMap (Column b) (PartialSQLExp b)
setColsSQL Bool
backendOnly HashSet Text
reqHdrs Maybe (ValidateInput ResolvedWebhook)
resolvedValidateInput, Seq SchemaDependency
deps)
  where
    allInsCols :: [Column b]
allInsCols = (StructuredColumnInfo b -> Column b)
-> [StructuredColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
map StructuredColumnInfo b -> Column b
forall (b :: BackendType). StructuredColumnInfo b -> Column b
structuredColumnInfoColumn ([StructuredColumnInfo b] -> [Column b])
-> [StructuredColumnInfo b] -> [Column b]
forall a b. (a -> b) -> a -> b
$ (StructuredColumnInfo b -> Bool)
-> [StructuredColumnInfo b] -> [StructuredColumnInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter (ColumnMutability -> Bool
_cmIsInsertable (ColumnMutability -> Bool)
-> (StructuredColumnInfo b -> ColumnMutability)
-> StructuredColumnInfo b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredColumnInfo b -> ColumnMutability
forall (b :: BackendType).
StructuredColumnInfo b -> ColumnMutability
structuredColumnInfoMutability) ([StructuredColumnInfo b] -> [StructuredColumnInfo b])
-> [StructuredColumnInfo b] -> [StructuredColumnInfo b]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b) -> [StructuredColumnInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [StructuredColumnInfo 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 :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
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
spColumns :: PermColSpec b
spFilter :: BoolExp b
spLimit :: Maybe Int
spAllowAggregations :: Bool
spComputedFields :: [ComputedFieldName]
spAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spColumns :: forall (b :: BackendType). SelPerm b -> PermColSpec b
spFilter :: forall (b :: BackendType). SelPerm b -> BoolExp b
spLimit :: forall (b :: BackendType). SelPerm b -> Maybe Int
spAllowAggregations :: forall (b :: BackendType). SelPerm b -> Bool
spComputedFields :: forall (b :: BackendType). SelPerm b -> [ComputedFieldName]
spAllowedQueryRootFields :: forall (b :: BackendType).
SelPerm b -> AllowedRootFields QueryRootFieldType
spAllowedSubscriptionRootFields :: forall (b :: BackendType).
SelPerm b -> AllowedRootFields SubscriptionRootFieldType
..} = do
  TableCoreInfo b
tableCoreInfo <- 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 a b. m a -> (a -> m b) -> m 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}. Hashable a => a -> AllowedRootFields a -> Bool
`rootFieldNeedsValidation` AllowedRootFields QueryRootFieldType
spAllowedQueryRootFields
          Bool -> Bool -> Bool
|| SubscriptionRootFieldType
SRFTSelectByPk
          SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType -> Bool
forall {a}. Hashable a => a -> AllowedRootFields a -> Bool
`rootFieldNeedsValidation` AllowedRootFields SubscriptionRootFieldType
spAllowedSubscriptionRootFields
      needToValidateAggregationRootField :: Bool
needToValidateAggregationRootField =
        QueryRootFieldType
QRFTSelectAggregate
          QueryRootFieldType -> AllowedRootFields QueryRootFieldType -> Bool
forall {a}. Hashable a => a -> AllowedRootFields a -> Bool
`rootFieldNeedsValidation` AllowedRootFields QueryRootFieldType
spAllowedQueryRootFields
          Bool -> Bool -> Bool
|| SubscriptionRootFieldType
SRFTSelectAggregate
          SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType -> Bool
forall {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 a. a -> m a
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 {[RawColumnInfo b]
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
_tciName :: TableName b
_tciDescription :: Maybe PGDescription
_tciFieldInfoMap :: FieldInfoMap (FieldInfo b)
_tciPrimaryKey :: Maybe (PrimaryKey b (ColumnInfo b))
_tciUniqueConstraints :: HashSet (UniqueConstraint b)
_tciForeignKeys :: HashSet (ForeignKey b)
_tciViewInfo :: Maybe ViewInfo
_tciEnumValues :: Maybe EnumValues
_tciCustomConfig :: TableConfig b
_tciExtraTableMetadata :: ExtraTableMetadata b
_tciApolloFederationConfig :: Maybe ApolloFederationConfig
_tciRawColumns :: [RawColumnInfo b]
_tciName :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciDescription :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe PGDescription
_tciFieldInfoMap :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciPrimaryKey :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciUniqueConstraints :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> HashSet (UniqueConstraint b)
_tciForeignKeys :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> HashSet (ForeignKey b)
_tciViewInfo :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe ViewInfo
_tciEnumValues :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe EnumValues
_tciCustomConfig :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciExtraTableMetadata :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciApolloFederationConfig :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe ApolloFederationConfig
_tciRawColumns :: forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> [RawColumnInfo 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 a. a -> m a
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"

-- | Given the native query's definition and the permissions as defined in the
-- native query's metadata, try to construct the @SELECT@ permission
-- definition.
buildLogicalModelSelPermInfo ::
  forall b m r.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b,
    MonadReader r m,
    Has (ScalarTypeParsingContext b) r
  ) =>
  SourceName ->
  LogicalModelName ->
  InsOrdHashMap.InsOrdHashMap (Column b) (LogicalModelField b) ->
  SelPerm b ->
  m (WithDeps (SelPermInfo b))
buildLogicalModelSelPermInfo :: forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> SelPerm b
-> m (WithDeps (SelPermInfo b))
buildLogicalModelSelPermInfo SourceName
source LogicalModelName
logicalModelName InsOrdHashMap (Column b) (LogicalModelField b)
logicalModelFieldMap 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" do
  let columns :: [Column b]
      columns :: [Column b]
columns = [Column b] -> PermColSpec b -> [Column b]
forall (b :: BackendType).
[Column b] -> PermColSpec b -> [Column b]
interpColSpec (LogicalModelField b -> Column b
forall (b :: BackendType). LogicalModelField b -> Column b
lmfName (LogicalModelField b -> Column b)
-> [LogicalModelField b] -> [Column b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InsOrdHashMap (Column b) (LogicalModelField b)
-> [LogicalModelField b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems InsOrdHashMap (Column b) (LogicalModelField b)
logicalModelFieldMap) (SelPerm b -> PermColSpec b
forall (b :: BackendType). SelPerm b -> PermColSpec b
spColumns SelPerm b
sp)

  -- Interpret the row permissions in the 'SelPerm' definition.
  -- TODO: do row permisions work on non-scalar fields? Going to assume not and
  -- filter out the non-scalars.
  (AnnBoolExpPartialSQL b
spiFilter, Seq SchemaDependency
boolExpDeps) <-
    Text
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"filter"
      (m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
 -> m (AnnBoolExpPartialSQL b, Seq SchemaDependency))
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall a b. (a -> b) -> a -> b
$ SourceName
-> LogicalModelName
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> LogicalModelName
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
procLogicalModelBoolExp SourceName
source LogicalModelName
logicalModelName (InsOrdHashMap (Column b) (LogicalModelField b)
-> FieldInfoMap (FieldInfo b)
forall (b :: BackendType).
Backend b =>
InsOrdHashMap (Column b) (LogicalModelField b)
-> FieldInfoMap (FieldInfo b)
logicalModelFieldsToFieldInfo InsOrdHashMap (Column b) (LogicalModelField b)
logicalModelFieldMap) (SelPerm b -> BoolExp b
forall (b :: BackendType). SelPerm b -> BoolExp b
spFilter SelPerm b
sp)

  let -- What parts of the metadata are interesting when computing the
      -- permissions? These dependencies bubble all the way up to
      -- 'buildSchemaCacheRule' so we can know when we need to rebuild the
      -- schema.
      deps :: Seq SchemaDependency
      deps :: Seq SchemaDependency
deps =
        [Seq SchemaDependency] -> Seq SchemaDependency
forall a. Monoid a => [a] -> a
mconcat
          [ SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a
Seq.singleton (forall (b :: BackendType).
Backend b =>
SourceName -> LogicalModelName -> SchemaDependency
mkLogicalModelParentDep @b SourceName
source LogicalModelName
logicalModelName),
            Seq SchemaDependency
boolExpDeps,
            (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> LogicalModelName -> Column b -> SchemaDependency
mkLogicalModelColDep @b DependencyReason
DRUntyped SourceName
source LogicalModelName
logicalModelName)
              (Seq (Column b) -> Seq SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall a b. (a -> b) -> a -> b
$ [Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList [Column b]
columns
          ]

      -- What headers are required in order to evaluate a given permission? For
      -- example, does the permission mention the user's ID? If so, this
      -- permission will require @x-hasura-user-id@.
      spiRequiredHeaders :: HashSet Text
      spiRequiredHeaders :: HashSet Text
spiRequiredHeaders = BoolExp b -> HashSet Text
forall (b :: BackendType). BoolExp b -> HashSet Text
getDependentHeaders (SelPerm b -> BoolExp b
forall (b :: BackendType). SelPerm b -> BoolExp b
spFilter SelPerm b
sp)

  -- Are any row limits being applied to the user's results?
  Maybe Int
spiLimit <- Text -> m (Maybe Int) -> m (Maybe Int)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"limit" case SelPerm b -> Maybe Int
forall (b :: BackendType). SelPerm b -> Maybe Int
spLimit SelPerm b
sp of
    Just Int
value | Int
value Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Code -> Text -> m (Maybe Int)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"unexpected negative value"
    Maybe Int
_ -> Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelPerm b -> Maybe Int
forall (b :: BackendType). SelPerm b -> Maybe Int
spLimit SelPerm b
sp)

  let -- The columns accessible to this role.
      --
      -- TODO: do we care about inherited roles? We don't seem to set this to
      -- anything other than 'Nothing' for in 'buildSelPermInfo' either.
      spiCols :: HashMap (Column b) (AnnRedactionExpPartialSQL b)
      spiCols :: HashMap (Column b) (AnnRedactionExpPartialSQL b)
spiCols = [(Column b, AnnRedactionExpPartialSQL b)]
-> HashMap (Column b) (AnnRedactionExpPartialSQL b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ((Column b -> (Column b, AnnRedactionExpPartialSQL b))
-> [Column b] -> [(Column b, AnnRedactionExpPartialSQL b)]
forall a b. (a -> b) -> [a] -> [b]
map (,AnnRedactionExpPartialSQL b
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction) [Column b]
columns)

      -- Native queries don't have computed fields.
      spiComputedFields :: HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
      spiComputedFields :: HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
spiComputedFields = HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
forall a. Monoid a => a
mempty

  let -- We don't need something like validateAllowedRootFields because we
      -- don't have any primary key or aggregate fields (table_by_pk etc).
      spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
      spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spiAllowedQueryRootFields = SelPerm b -> AllowedRootFields QueryRootFieldType
forall (b :: BackendType).
SelPerm b -> AllowedRootFields QueryRootFieldType
spAllowedQueryRootFields SelPerm b
sp

      spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
      spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spiAllowedSubscriptionRootFields = SelPerm b -> AllowedRootFields SubscriptionRootFieldType
forall (b :: BackendType).
SelPerm b -> AllowedRootFields SubscriptionRootFieldType
spAllowedSubscriptionRootFields SelPerm b
sp

      -- We don't currently allow for aggregations over native queries.
      spiAllowAgg :: Bool
      spiAllowAgg :: Bool
spiAllowAgg = SelPerm b -> Bool
forall (b :: BackendType). SelPerm b -> Bool
spAllowAggregations SelPerm b
sp

  WithDeps (SelPermInfo b) -> m (WithDeps (SelPermInfo b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SelPermInfo {Bool
Maybe Int
HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
HashMap (Column b) (AnnRedactionExpPartialSQL b)
HashSet Text
AnnBoolExpPartialSQL b
AllowedRootFields SubscriptionRootFieldType
AllowedRootFields QueryRootFieldType
spiFilter :: AnnBoolExpPartialSQL b
spiRequiredHeaders :: HashSet Text
spiLimit :: Maybe Int
spiCols :: HashMap (Column b) (AnnRedactionExpPartialSQL b)
spiComputedFields :: HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spiAllowAgg :: Bool
spiCols :: HashMap (Column b) (AnnRedactionExpPartialSQL b)
spiComputedFields :: HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
spiFilter :: AnnBoolExpPartialSQL b
spiLimit :: Maybe Int
spiAllowAgg :: Bool
spiRequiredHeaders :: HashSet Text
spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
..}, Seq SchemaDependency
deps)

buildSelPermInfo ::
  forall b m r.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b,
    MonadReader r m,
    Has (ScalarTypeParsingContext b) r
  ) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  RoleName ->
  SelPerm b ->
  m (WithDeps (SelPermInfo b))
buildSelPermInfo :: forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
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 (StructuredColumnInfo b -> Column b
forall (b :: BackendType). StructuredColumnInfo b -> Column b
structuredColumnInfoColumn (StructuredColumnInfo b -> Column b)
-> [StructuredColumnInfo b] -> [Column b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldInfoMap (FieldInfo b) -> [StructuredColumnInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [StructuredColumnInfo 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, Seq SchemaDependency
boolExpDeps) <-
    Text
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"filter"
      (m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
 -> m (AnnBoolExpPartialSQL b, Seq SchemaDependency))
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall a b. (a -> b) -> a -> b
$ SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (m :: * -> *) (b :: BackendType) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
procBoolExp SourceName
source TableName b
tableName FieldInfoMap (FieldInfo b)
fieldInfoMap
      (BoolExp b -> m (AnnBoolExpPartialSQL b, Seq SchemaDependency))
-> BoolExp b -> m (AnnBoolExpPartialSQL b, Seq 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 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 a. a -> m a
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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComputedFieldName
fieldName

  let deps :: Seq SchemaDependency
deps =
        forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SchemaDependency
mkParentDep @b SourceName
source TableName b
tableName
          SchemaDependency -> Seq SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a -> Seq a
Seq.:<| Seq SchemaDependency
boolExpDeps
            Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> (forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b DependencyReason
DRUntyped SourceName
source TableName b
tableName (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList [Column b]
pgCols)
            Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> (forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName
-> TableName b
-> ComputedFieldName
-> SchemaDependency
mkComputedFieldDep @b DependencyReason
DRUntyped SourceName
source TableName b
tableName (ComputedFieldName -> SchemaDependency)
-> Seq ComputedFieldName -> Seq SchemaDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ComputedFieldName] -> Seq ComputedFieldName
forall a. [a] -> Seq a
Seq.fromList [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) (AnnRedactionExp b (PartialSQLExp b))
spiCols = [(Column b, AnnRedactionExp b (PartialSQLExp b))]
-> HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Column b, AnnRedactionExp b (PartialSQLExp b))]
 -> HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b)))
-> [(Column b, AnnRedactionExp b (PartialSQLExp b))]
-> HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
forall a b. (a -> b) -> a -> b
$ (Column b -> (Column b, AnnRedactionExp b (PartialSQLExp b)))
-> [Column b] -> [(Column b, AnnRedactionExp b (PartialSQLExp b))]
forall a b. (a -> b) -> [a] -> [b]
map (,AnnRedactionExp b (PartialSQLExp b)
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction) [Column b]
pgCols
      spiComputedFields :: HashMap ComputedFieldName (AnnRedactionExp b (PartialSQLExp 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 ()
-> AnnRedactionExp b (PartialSQLExp b)
-> HashMap ComputedFieldName (AnnRedactionExp b (PartialSQLExp b))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AnnRedactionExp b (PartialSQLExp b)
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction

  (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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SelPermInfo {Bool
Maybe Int
HashMap ComputedFieldName (AnnRedactionExp b (PartialSQLExp b))
HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
HashSet Text
AnnBoolExpPartialSQL b
AllowedRootFields SubscriptionRootFieldType
AllowedRootFields QueryRootFieldType
spiCols :: HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
spiComputedFields :: HashMap ComputedFieldName (AnnRedactionExp b (PartialSQLExp b))
spiFilter :: AnnBoolExpPartialSQL b
spiLimit :: Maybe Int
spiAllowAgg :: Bool
spiRequiredHeaders :: HashSet Text
spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spiFilter :: AnnBoolExpPartialSQL b
spiRequiredHeaders :: HashSet Text
spiLimit :: Maybe Int
spiCols :: HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
spiComputedFields :: HashMap ComputedFieldName (AnnRedactionExp b (PartialSQLExp b))
spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spiAllowAgg :: Bool
..}, Seq 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 r.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b,
    MonadReader r m,
    Has (ScalarTypeParsingContext b) r
  ) =>
  Env.Environment ->
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  UpdPerm b ->
  m (WithDeps (UpdPermInfo b))
buildUpdPermInfo :: forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> UpdPerm b
-> m (WithDeps (UpdPermInfo b))
buildUpdPermInfo Environment
env 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 Maybe (ValidateInput InputWebhook)
validateInput) = do
  (AnnBoolExpPartialSQL b
be, Seq SchemaDependency
beDeps) <-
    Text
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"filter"
      (m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
 -> m (AnnBoolExpPartialSQL b, Seq SchemaDependency))
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall a b. (a -> b) -> a -> b
$ SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (m :: * -> *) (b :: BackendType) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
procBoolExp SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap BoolExp b
fltr

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

  (HashMap (Column b) (PartialSQLExp b)
setColsSQL, [Text]
setHeaders, Seq SchemaDependency
setColDeps) <- SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (HashMap (Column b) (PartialSQLExp b), [Text],
      Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, BackendMetadata b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> Maybe (ColumnValues b Value)
-> m (PreSetColsPartial b, [Text], Seq 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 = forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b DependencyReason
DRUntyped SourceName
source TableName b
tn (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column b]
updCols
      deps :: Seq SchemaDependency
deps = forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SchemaDependency
mkParentDep @b SourceName
source TableName b
tn SchemaDependency -> Seq SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a -> Seq a
Seq.:<| Seq SchemaDependency
beDeps Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> Seq SchemaDependency
-> ((AnnBoolExpPartialSQL b, Seq SchemaDependency)
    -> Seq SchemaDependency)
-> Maybe (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> Seq SchemaDependency
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq SchemaDependency
forall a. Monoid a => a
mempty (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> Seq SchemaDependency
forall a b. (a, b) -> b
snd Maybe (AnnBoolExpPartialSQL b, Seq SchemaDependency)
checkExpr Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> [SchemaDependency] -> Seq SchemaDependency
forall a. [a] -> Seq a
Seq.fromList [SchemaDependency]
updColDeps Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> Seq 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 :: HashSet (Column b)
updColsWithoutPreSets = [Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [Column b]
updCols HashSet (Column b) -> HashSet (Column b) -> HashSet (Column b)
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`HS.difference` HashMap (Column b) (PartialSQLExp b) -> HashSet (Column b)
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap (Column b) (PartialSQLExp b)
setColsSQL
  Maybe (ValidateInput ResolvedWebhook)
resolvedValidateInput <- Maybe (ValidateInput InputWebhook)
-> (ValidateInput InputWebhook
    -> m (ValidateInput ResolvedWebhook))
-> m (Maybe (ValidateInput ResolvedWebhook))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (ValidateInput InputWebhook)
validateInput ((InputWebhook -> m ResolvedWebhook)
-> ValidateInput InputWebhook -> m (ValidateInput ResolvedWebhook)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ValidateInput a -> f (ValidateInput b)
traverse (Environment -> InputWebhook -> m ResolvedWebhook
forall (m :: * -> *).
QErrM m =>
Environment -> InputWebhook -> m ResolvedWebhook
resolveWebhook Environment
env))
  WithDeps (UpdPermInfo b) -> m (WithDeps (UpdPermInfo b))
forall a. a -> m a
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
-> Maybe (ValidateInput ResolvedWebhook)
-> UpdPermInfo b
forall (b :: BackendType).
HashSet (Column b)
-> TableName b
-> AnnBoolExpPartialSQL b
-> Maybe (AnnBoolExpPartialSQL b)
-> PreSetColsPartial b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> UpdPermInfo b
UpdPermInfo HashSet (Column b)
updColsWithoutPreSets TableName b
tn AnnBoolExpPartialSQL b
be ((AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> AnnBoolExpPartialSQL b
forall a b. (a, b) -> a
fst ((AnnBoolExpPartialSQL b, Seq SchemaDependency)
 -> AnnBoolExpPartialSQL b)
-> Maybe (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> Maybe (AnnBoolExpPartialSQL b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AnnBoolExpPartialSQL b, Seq SchemaDependency)
checkExpr) HashMap (Column b) (PartialSQLExp b)
setColsSQL Bool
backendOnly HashSet Text
reqHeaders Maybe (ValidateInput ResolvedWebhook)
resolvedValidateInput, Seq SchemaDependency
deps)
  where
    allUpdCols :: [Column b]
allUpdCols = (StructuredColumnInfo b -> Column b)
-> [StructuredColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
map StructuredColumnInfo b -> Column b
forall (b :: BackendType). StructuredColumnInfo b -> Column b
structuredColumnInfoColumn ([StructuredColumnInfo b] -> [Column b])
-> [StructuredColumnInfo b] -> [Column b]
forall a b. (a -> b) -> a -> b
$ (StructuredColumnInfo b -> Bool)
-> [StructuredColumnInfo b] -> [StructuredColumnInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter (ColumnMutability -> Bool
_cmIsUpdatable (ColumnMutability -> Bool)
-> (StructuredColumnInfo b -> ColumnMutability)
-> StructuredColumnInfo b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredColumnInfo b -> ColumnMutability
forall (b :: BackendType).
StructuredColumnInfo b -> ColumnMutability
structuredColumnInfoMutability) ([StructuredColumnInfo b] -> [StructuredColumnInfo b])
-> [StructuredColumnInfo b] -> [StructuredColumnInfo b]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b) -> [StructuredColumnInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [StructuredColumnInfo 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 r.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b,
    MonadReader r m,
    Has (ScalarTypeParsingContext b) r
  ) =>
  Env.Environment ->
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  DelPerm b ->
  m (WithDeps (DelPermInfo b))
buildDelPermInfo :: forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> DelPerm b
-> m (WithDeps (DelPermInfo b))
buildDelPermInfo Environment
env SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap (DelPerm BoolExp b
fltr Bool
backendOnly Maybe (ValidateInput InputWebhook)
validateInput) = do
  (AnnBoolExpPartialSQL b
be, Seq SchemaDependency
beDeps) <-
    Text
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"filter"
      (m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
 -> m (AnnBoolExpPartialSQL b, Seq SchemaDependency))
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall a b. (a -> b) -> a -> b
$ SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall (m :: * -> *) (b :: BackendType) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
procBoolExp SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap BoolExp b
fltr
  let deps :: Seq SchemaDependency
deps = forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SchemaDependency
mkParentDep @b SourceName
source TableName b
tn SchemaDependency -> Seq SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a -> Seq a
Seq.:<| Seq SchemaDependency
beDeps
      depHeaders :: HashSet Text
depHeaders = BoolExp b -> HashSet Text
forall (b :: BackendType). BoolExp b -> HashSet Text
getDependentHeaders BoolExp b
fltr
  Maybe (ValidateInput ResolvedWebhook)
resolvedValidateInput <- Maybe (ValidateInput InputWebhook)
-> (ValidateInput InputWebhook
    -> m (ValidateInput ResolvedWebhook))
-> m (Maybe (ValidateInput ResolvedWebhook))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (ValidateInput InputWebhook)
validateInput ((InputWebhook -> m ResolvedWebhook)
-> ValidateInput InputWebhook -> m (ValidateInput ResolvedWebhook)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ValidateInput a -> f (ValidateInput b)
traverse (Environment -> InputWebhook -> m ResolvedWebhook
forall (m :: * -> *).
QErrM m =>
Environment -> InputWebhook -> m ResolvedWebhook
resolveWebhook Environment
env))
  WithDeps (DelPermInfo b) -> m (WithDeps (DelPermInfo b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TableName b
-> AnnBoolExpPartialSQL b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> DelPermInfo b
forall (b :: BackendType).
TableName b
-> AnnBoolExpPartialSQL b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> DelPermInfo b
DelPermInfo TableName b
tn AnnBoolExpPartialSQL b
be Bool
backendOnly HashSet Text
depHeaders Maybe (ValidateInput ResolvedWebhook)
resolvedValidateInput, Seq SchemaDependency
deps)

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

instance (Backend b) => FromJSON (SetPermComment b) where
  parseJSON :: Value -> Parser (SetPermComment b)
parseJSON = [Char]
-> (Object -> Parser (SetPermComment b))
-> Value
-> Parser (SetPermComment b)
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"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 a b. Parser (a -> b) -> Parser a -> Parser 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 a b. Parser (a -> b) -> Parser a -> Parser 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 a b. Parser (a -> b) -> Parser a -> Parser 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 a b. Parser (a -> b) -> Parser a -> Parser 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 :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m, BackendMetadata b) =>
SetPermComment b -> m EncJSON
runSetPermComment (SetPermComment SourceName
source TableName b
table RoleName
roleName PermType
permType Maybe Text
comment) = do
  TableInfo b
tableInfo <- 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 a. a -> m a
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) (f :: * -> *).
Functor f =>
(Permissions (InsPermDef b) -> f (Permissions (InsPermDef b)))
-> TableMetadata b -> f (TableMetadata 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 -> *) (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> PermDef b perm -> f (PermDef b perm)
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 a. a -> m a
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) (f :: * -> *).
Functor f =>
(Permissions (SelPermDef b) -> f (Permissions (SelPermDef b)))
-> TableMetadata b -> f (TableMetadata 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 -> *) (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> PermDef b perm -> f (PermDef b perm)
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 a. a -> m a
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) (f :: * -> *).
Functor f =>
(Permissions (UpdPermDef b) -> f (Permissions (UpdPermDef b)))
-> TableMetadata b -> f (TableMetadata 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 -> *) (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> PermDef b perm -> f (PermDef b perm)
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 a. a -> m a
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) (f :: * -> *).
Functor f =>
(Permissions (DelPermDef b) -> f (Permissions (DelPermDef b)))
-> TableMetadata b -> f (TableMetadata 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 -> *) (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> PermDef b perm -> f (PermDef b perm)
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
$ 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
$ 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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg