{-# LANGUAGE Arrows #-}

module Hasura.RQL.DDL.Schema.Cache.Permission
  ( buildTablePermissions,
    mkPermissionMetadataObject,
    mkRemoteSchemaPermissionMetadataObject,
    orderRoles,
    OrderedRoles,
    _unOrderedRoles,
    mkBooleanPermissionMap,
    resolveCheckPermission,
  )
where

import Control.Arrow.Extended
import Control.Arrow.Interpret
import Data.Aeson
import Data.Graph qualified as G
import Data.HashMap.Strict qualified as M
import Data.Proxy
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.Incremental qualified as Inc
import Hasura.Prelude
import Hasura.RQL.DDL.Permission
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
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.RemoteSchema
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.Roles.Internal
  ( CheckPermission (..),
    CombineRolePermInfo (..),
    rolePermInfoToCombineRolePermInfo,
  )
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Session

{- Note: [Inherited roles architecture for read queries]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

1. Schema generation
--------------------

Schema generation for inherited roles is similar to the schema
generation of non-inherited roles. In the case of inherited roles,
we combine the `SelectPermInfo`s of the
inherited role's role set and a new `SelectPermInfo` will be generated
which will be the select permission of the inherited role.

Two `SelPermInfo`s will be combined in the following manner:

1. Columns - The `SelPermInfo` contains a hashset of the columns that are
   accessible to the role. To combine two `SelPermInfo`s, every column of the
   hashset is coupled with the boolean expression (filter) of the `SelPermInfo`
   and a hash map of all the columns is created out of it, this hashmap is
   generated for the `SelPermInfo`s that are going to be combined. These hashmaps
   are then unioned and the values of these hashmaps are `OR`ed. When a column
   is accessible to all the select permissions then the nullability of the column
   is inferred from the DB column otherwise the column is explicitly marked as
   nullable to accomodate cell-value nullification.
2. Scalar computed fields - Scalar computed fields work the same as Columns (#1)
3. Filter / Boolean expression - The filters are combined using a `BoolOr`
4. Limit - Limits are combined by taking the maximum of the two limits
5. Allow Aggregation - Aggregation is allowed, if any of the permissions allow it.
6. Request Headers - Request headers are concatenated

2. SQL generation
-----------------

See note [SQL generation for inherited roles]

3. Introspection
----------------

The columns accessible to an inherited role are explicitly set to
nullable irrespective of the nullability of the DB column to accomodate
cell value nullification.
-}

mkBooleanPermissionMap :: (RoleName -> a) -> HashMap RoleName a -> OrderedRoles -> HashMap RoleName a
mkBooleanPermissionMap :: (RoleName -> a)
-> HashMap RoleName a -> OrderedRoles -> HashMap RoleName a
mkBooleanPermissionMap RoleName -> a
constructorFn HashMap RoleName a
metadataPermissions OrderedRoles
orderedRoles =
  (HashMap RoleName a -> Role -> HashMap RoleName a)
-> HashMap RoleName a -> [Role] -> HashMap RoleName a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HashMap RoleName a -> Role -> HashMap RoleName a
combineBooleanPermission HashMap RoleName a
metadataPermissions ([Role] -> HashMap RoleName a) -> [Role] -> HashMap RoleName a
forall a b. (a -> b) -> a -> b
$ OrderedRoles -> [Role]
_unOrderedRoles OrderedRoles
orderedRoles
  where
    combineBooleanPermission :: HashMap RoleName a -> Role -> HashMap RoleName a
combineBooleanPermission HashMap RoleName a
accumulatedPermMap (Role RoleName
roleName (ParentRoles HashSet RoleName
parentRoles)) =
      case RoleName -> HashMap RoleName a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup RoleName
roleName HashMap RoleName a
accumulatedPermMap of
        -- We check if a permission for the given role exists in the metadata, if it
        -- exists, we use that
        Just a
_ -> HashMap RoleName a
accumulatedPermMap
        -- 2. When the permission doesn't exist, we try to inherit the permission from its parent roles
        -- For boolean permissions, if any of the parent roles have a permission to access an entity,
        -- then the inherited role will also be able to access the entity.
        Maybe a
Nothing ->
          -- see Note [Roles Inheritance]
          let canInheritPermission :: Bool
canInheritPermission = (RoleName -> Bool) -> [RoleName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((RoleName -> HashMap RoleName a -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`M.member` HashMap RoleName a
accumulatedPermMap)) (HashSet RoleName -> [RoleName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet RoleName
parentRoles)
           in if Bool
canInheritPermission
                then RoleName -> a -> HashMap RoleName a -> HashMap RoleName a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert RoleName
roleName (RoleName -> a
constructorFn RoleName
roleName) HashMap RoleName a
accumulatedPermMap
                else HashMap RoleName a
accumulatedPermMap

-- | `OrderedRoles` is a data type to hold topologically sorted roles
--   according to each role's parent roles, see `orderRoles` for more details.
newtype OrderedRoles = OrderedRoles {OrderedRoles -> [Role]
_unOrderedRoles :: [Role]}
  deriving (OrderedRoles -> OrderedRoles -> Bool
(OrderedRoles -> OrderedRoles -> Bool)
-> (OrderedRoles -> OrderedRoles -> Bool) -> Eq OrderedRoles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderedRoles -> OrderedRoles -> Bool
$c/= :: OrderedRoles -> OrderedRoles -> Bool
== :: OrderedRoles -> OrderedRoles -> Bool
$c== :: OrderedRoles -> OrderedRoles -> Bool
Eq, (forall x. OrderedRoles -> Rep OrderedRoles x)
-> (forall x. Rep OrderedRoles x -> OrderedRoles)
-> Generic OrderedRoles
forall x. Rep OrderedRoles x -> OrderedRoles
forall x. OrderedRoles -> Rep OrderedRoles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrderedRoles x -> OrderedRoles
$cfrom :: forall x. OrderedRoles -> Rep OrderedRoles x
Generic)

instance Inc.Cacheable OrderedRoles

-- | 'orderRoles' is used to order the roles, in such a way that given
--   a role R with n parent roles - PR1, PR2 .. PRn, then the 'orderRoles'
--   function will order the roles in such a way that all the parent roles
--   precede the role R. Note that the order of the parent roles itself doesn't
--   matter as long as they precede the roles on which they are dependent on.
--
--   For example, the orderRoles may return `[PR1, PR3, PR2, ... PRn, R]`
--   or `[PR5, PR3, PR1 ... R]`, both of them are correct because all
--   the parent roles precede the inherited role R, assuming the parent roles
--   themselves don't have any parents for the sake of this example.
orderRoles ::
  MonadError QErr m =>
  [Role] ->
  m OrderedRoles
orderRoles :: [Role] -> m OrderedRoles
orderRoles [Role]
allRoles = do
  -- inherited roles can be created from other inherited and non-inherited roles
  -- So, roles can be thought of as a graph where non-inherited roles don't have
  -- any outgoing edges and inherited roles as nodes with edges to its parent roles
  -- However, we can't allow cyclic roles since permissions built by a role is used
  -- by the dependent roles to build their permissions and if cyclic roles were to be
  -- allowed, the permissions building will be stuck in an infinite loop
  let graphNodesList :: [(Role, RoleName, [RoleName])]
graphNodesList = [(Role
role, Role -> RoleName
_rRoleName Role
role, HashSet RoleName -> [RoleName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ParentRoles -> HashSet RoleName
_unParentRoles (ParentRoles -> HashSet RoleName)
-> (Role -> ParentRoles) -> Role -> HashSet RoleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Role -> ParentRoles
_rParentRoles (Role -> HashSet RoleName) -> Role -> HashSet RoleName
forall a b. (a -> b) -> a -> b
$ Role
role)) | Role
role <- [Role]
allRoles]
  let orderedGraphNodes :: [SCC Role]
orderedGraphNodes = [(Role, RoleName, [RoleName])] -> [SCC Role]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
G.stronglyConnComp [(Role, RoleName, [RoleName])]
graphNodesList -- topologically sort the nodes of the graph
      cyclicRoles :: [SCC Role]
cyclicRoles = (SCC Role -> Bool) -> [SCC Role] -> [SCC Role]
forall a. (a -> Bool) -> [a] -> [a]
filter SCC Role -> Bool
forall vertex. SCC vertex -> Bool
checkCycle [SCC Role]
orderedGraphNodes
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SCC Role] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SCC Role]
cyclicRoles) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    -- we're appending the first element of the list at the end, so that the error message will
    -- contain the complete cycle of the roles
    let roleCycles :: [Text]
roleCycles = (SCC Role -> Text) -> [SCC Role] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
forall a. Show a => a -> Text
tshow ([Text] -> Text) -> (SCC Role -> [Text]) -> SCC Role -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Role -> Text) -> [Role] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (RoleName -> Text
roleNameToTxt (RoleName -> Text) -> (Role -> RoleName) -> Role -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Role -> RoleName
_rRoleName) ([Role] -> [Text]) -> (SCC Role -> [Role]) -> SCC Role -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Role] -> [Role]
forall a. [a] -> [a]
appendFirstElementAtEnd ([Role] -> [Role]) -> (SCC Role -> [Role]) -> SCC Role -> [Role]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SCC Role -> [Role]
forall vertex. SCC vertex -> [vertex]
G.flattenSCC) [SCC Role]
cyclicRoles
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
CyclicDependency (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"found cycle(s) in roles: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated [Text]
roleCycles
  let allOrderedRoles :: [Role]
allOrderedRoles = [SCC Role] -> [Role]
forall a. [SCC a] -> [a]
G.flattenSCCs [SCC Role]
orderedGraphNodes
  OrderedRoles -> m OrderedRoles
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrderedRoles -> m OrderedRoles) -> OrderedRoles -> m OrderedRoles
forall a b. (a -> b) -> a -> b
$ [Role] -> OrderedRoles
OrderedRoles [Role]
allOrderedRoles
  where
    checkCycle :: SCC vertex -> Bool
checkCycle = \case
      G.AcyclicSCC vertex
_ -> Bool
False
      G.CyclicSCC [vertex]
_ -> Bool
True

    appendFirstElementAtEnd :: [a] -> [a]
appendFirstElementAtEnd [] = []
    appendFirstElementAtEnd (a
x : [a]
xs) = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]

-- | `resolveCheckPermission` is a helper function which will convert the indermediate
--    type `CheckPermission` to its original type. It will record any metadata inconsistencies, if exists.
resolveCheckPermission ::
  forall m p.
  (MonadWriter (Seq CollectedInfo) m) =>
  CheckPermission p ->
  RoleName ->
  InconsistentRoleEntity ->
  m (Maybe p)
resolveCheckPermission :: CheckPermission p
-> RoleName -> InconsistentRoleEntity -> m (Maybe p)
resolveCheckPermission CheckPermission p
checkPermission RoleName
roleName InconsistentRoleEntity
inconsistentEntity = do
  case CheckPermission p
checkPermission of
    CheckPermission p
CPInconsistent -> do
      let inconsistentObj :: CollectedInfo
inconsistentObj =
            -- check `Conflicts while inheriting permissions` in `rfcs/inherited-roles-improvements.md`
            InconsistentMetadata -> CollectedInfo
CIInconsistency (InconsistentMetadata -> CollectedInfo)
-> InconsistentMetadata -> CollectedInfo
forall a b. (a -> b) -> a -> b
$
              RoleName -> InconsistentRoleEntity -> InconsistentMetadata
ConflictingInheritedPermission RoleName
roleName InconsistentRoleEntity
inconsistentEntity
      Seq CollectedInfo -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Seq CollectedInfo -> m ()) -> Seq CollectedInfo -> m ()
forall a b. (a -> b) -> a -> b
$ CollectedInfo -> Seq CollectedInfo
forall a. a -> Seq a
Seq.singleton CollectedInfo
inconsistentObj
      Maybe p -> m (Maybe p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe p
forall a. Maybe a
Nothing
    CPDefined p
permissionDefn -> Maybe p -> m (Maybe p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe p -> m (Maybe p)) -> Maybe p -> m (Maybe p)
forall a b. (a -> b) -> a -> b
$ p -> Maybe p
forall a. a -> Maybe a
Just p
permissionDefn
    CheckPermission p
CPUndefined -> Maybe p -> m (Maybe p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe p
forall a. Maybe a
Nothing

resolveCheckTablePermission ::
  forall b perm m.
  ( MonadWriter (Seq CollectedInfo) m,
    BackendMetadata b
  ) =>
  CheckPermission perm ->
  Maybe (RolePermInfo b) ->
  (RolePermInfo b -> Maybe perm) ->
  RoleName ->
  SourceName ->
  TableName b ->
  PermType ->
  m (Maybe perm)
resolveCheckTablePermission :: CheckPermission perm
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe perm)
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> m (Maybe perm)
resolveCheckTablePermission CheckPermission perm
inheritedRolePermission Maybe (RolePermInfo b)
accumulatedRolePermInfo RolePermInfo b -> Maybe perm
permAcc RoleName
roleName SourceName
source TableName b
table PermType
permType = do
  -- when for a given entity and role, a permission exists in the metadata, we override the metadata permission
  -- over the inherited permission
  let checkPermission :: CheckPermission perm
checkPermission = CheckPermission perm
-> (perm -> CheckPermission perm)
-> Maybe perm
-> CheckPermission perm
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CheckPermission perm
inheritedRolePermission perm -> CheckPermission perm
forall permissionType.
permissionType -> CheckPermission permissionType
CPDefined (RolePermInfo b -> Maybe perm
permAcc (RolePermInfo b -> Maybe perm)
-> Maybe (RolePermInfo b) -> Maybe perm
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (RolePermInfo b)
accumulatedRolePermInfo)
      inconsistentRoleEntity :: InconsistentRoleEntity
inconsistentRoleEntity = SourceName -> Text -> PermType -> InconsistentRoleEntity
InconsistentTablePermission SourceName
source (TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
table) PermType
permType
  CheckPermission perm
-> RoleName -> InconsistentRoleEntity -> m (Maybe perm)
forall (m :: * -> *) p.
MonadWriter (Seq CollectedInfo) m =>
CheckPermission p
-> RoleName -> InconsistentRoleEntity -> m (Maybe p)
resolveCheckPermission CheckPermission perm
checkPermission RoleName
roleName InconsistentRoleEntity
inconsistentRoleEntity

buildTablePermissions ::
  forall b m arr.
  ( ArrowChoice arr,
    Inc.ArrowDistribute arr,
    Inc.ArrowCache m arr,
    MonadError QErr m,
    ArrowWriter (Seq CollectedInfo) arr,
    BackendMetadata b,
    Inc.Cacheable (Proxy b),
    GetAggregationPredicatesDeps b
  ) =>
  ( Proxy b,
    SourceName,
    Inc.Dependency (TableCoreCache b),
    FieldInfoMap (FieldInfo b),
    TablePermissionInputs b,
    OrderedRoles
  )
    `arr` (RolePermInfoMap b)
buildTablePermissions :: arr
  (Proxy b, SourceName, Dependency (TableCoreCache b),
   FieldInfoMap (FieldInfo b), TablePermissionInputs b, OrderedRoles)
  (RolePermInfoMap b)
buildTablePermissions = arr
  (Proxy b, SourceName, Dependency (TableCoreCache b),
   FieldInfoMap (FieldInfo b), TablePermissionInputs b, OrderedRoles)
  (RolePermInfoMap b)
-> arr
     (Proxy b, SourceName, Dependency (TableCoreCache b),
      FieldInfoMap (FieldInfo b), TablePermissionInputs b, OrderedRoles)
     (RolePermInfoMap b)
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Cacheable a) =>
arr a b -> arr a b
Inc.cache proc (Proxy b
proxy, SourceName
source, Dependency (TableCoreCache b)
tableCache, FieldInfoMap (FieldInfo b)
tableFields, TablePermissionInputs b
tablePermissions, OrderedRoles
orderedRoles) -> do
  let alignedPermissions :: HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
alignedPermissions = TablePermissionInputs b
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
alignPermissions TablePermissionInputs b
tablePermissions
      table :: TableName b
table = TablePermissionInputs b -> TableName b
forall (b :: BackendType). TablePermissionInputs b -> TableName b
_tpiTable TablePermissionInputs b
tablePermissions
  RolePermInfoMap b
metadataRolePermissions <-
    (|
      forall a.
arr
  (a,
   (RoleName,
    (([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm]),
     ())))
  (RolePermInfo b)
-> arr
     (a,
      (HashMap
         RoleName
         ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
          [PermDef b DelPerm]),
       ()))
     (RolePermInfoMap b)
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
        ( \RoleName
_ ([PermDef b InsPerm]
insertPermission, [PermDef b SelPerm]
selectPermission, [PermDef b UpdPerm]
updatePermission, [PermDef b DelPerm]
deletePermission) -> do
            Maybe (InsPermInfo b)
insert <- arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b InsPerm))
  (Maybe (InsPermInfo b))
forall (b :: BackendType) (a :: BackendType -> *)
       (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowWriter (Seq CollectedInfo) arr,
 ArrowCache m arr, Cacheable (a b), Cacheable (Proxy b),
 MonadError QErr m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b a))
  (Maybe (PermInfo a b))
buildPermission -< (Proxy b
proxy, Dependency (TableCoreCache b)
tableCache, SourceName
source, TableName b
table, FieldInfoMap (FieldInfo b)
tableFields, [PermDef b InsPerm] -> Maybe (PermDef b InsPerm)
forall a. [a] -> Maybe a
listToMaybe [PermDef b InsPerm]
insertPermission)
            Maybe (SelPermInfo b)
select <- arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b SelPerm))
  (Maybe (SelPermInfo b))
forall (b :: BackendType) (a :: BackendType -> *)
       (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowWriter (Seq CollectedInfo) arr,
 ArrowCache m arr, Cacheable (a b), Cacheable (Proxy b),
 MonadError QErr m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b a))
  (Maybe (PermInfo a b))
buildPermission -< (Proxy b
proxy, Dependency (TableCoreCache b)
tableCache, SourceName
source, TableName b
table, FieldInfoMap (FieldInfo b)
tableFields, [PermDef b SelPerm] -> Maybe (PermDef b SelPerm)
forall a. [a] -> Maybe a
listToMaybe [PermDef b SelPerm]
selectPermission)
            Maybe (UpdPermInfo b)
update <- arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b UpdPerm))
  (Maybe (UpdPermInfo b))
forall (b :: BackendType) (a :: BackendType -> *)
       (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowWriter (Seq CollectedInfo) arr,
 ArrowCache m arr, Cacheable (a b), Cacheable (Proxy b),
 MonadError QErr m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b a))
  (Maybe (PermInfo a b))
buildPermission -< (Proxy b
proxy, Dependency (TableCoreCache b)
tableCache, SourceName
source, TableName b
table, FieldInfoMap (FieldInfo b)
tableFields, [PermDef b UpdPerm] -> Maybe (PermDef b UpdPerm)
forall a. [a] -> Maybe a
listToMaybe [PermDef b UpdPerm]
updatePermission)
            Maybe (DelPermInfo b)
delete <- arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b DelPerm))
  (Maybe (DelPermInfo b))
forall (b :: BackendType) (a :: BackendType -> *)
       (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowWriter (Seq CollectedInfo) arr,
 ArrowCache m arr, Cacheable (a b), Cacheable (Proxy b),
 MonadError QErr m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b a))
  (Maybe (PermInfo a b))
buildPermission -< (Proxy b
proxy, Dependency (TableCoreCache b)
tableCache, SourceName
source, TableName b
table, FieldInfoMap (FieldInfo b)
tableFields, [PermDef b DelPerm] -> Maybe (PermDef b DelPerm)
forall a. [a] -> Maybe a
listToMaybe [PermDef b DelPerm]
deletePermission)
            arr (RolePermInfo b) (RolePermInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe (InsPermInfo b)
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> Maybe (DelPermInfo b)
-> RolePermInfo b
forall (b :: BackendType).
Maybe (InsPermInfo b)
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> Maybe (DelPermInfo b)
-> RolePermInfo b
RolePermInfo Maybe (InsPermInfo b)
insert Maybe (SelPermInfo b)
select Maybe (UpdPermInfo b)
update Maybe (DelPermInfo b)
delete
        )
      |) HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
alignedPermissions
  (|
    forall a.
arr (a, (RolePermInfoMap b, (Role, ()))) (RolePermInfoMap b)
-> arr (a, (RolePermInfoMap b, ([Role], ()))) (RolePermInfoMap b)
forall (arr :: * -> * -> *) (t :: * -> *) e b a s.
(ArrowChoice arr, Foldable t) =>
arr (e, (b, (a, s))) b -> arr (e, (b, (t a, s))) b
foldlA'
      ( \RolePermInfoMap b
accumulatedRolePermMap (Role RoleName
roleName (ParentRoles HashSet RoleName
parentRoles)) -> do
          [RolePermInfo b]
parentRolePermissions <-
            arr (m [RolePermInfo b]) [RolePermInfo b]
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
              -< [RoleName]
-> (RoleName -> m (RolePermInfo b)) -> m [RolePermInfo b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashSet RoleName -> [RoleName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet RoleName
parentRoles) ((RoleName -> m (RolePermInfo b)) -> m [RolePermInfo b])
-> (RoleName -> m (RolePermInfo b)) -> m [RolePermInfo b]
forall a b. (a -> b) -> a -> b
$ \RoleName
role ->
                Maybe (RolePermInfo b) -> m (RolePermInfo b) -> m (RolePermInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RoleName -> RolePermInfoMap b -> Maybe (RolePermInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup RoleName
role RolePermInfoMap b
accumulatedRolePermMap) (m (RolePermInfo b) -> m (RolePermInfo b))
-> m (RolePermInfo b) -> m (RolePermInfo b)
forall a b. (a -> b) -> a -> b
$
                  Text -> m (RolePermInfo b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m (RolePermInfo b)) -> Text -> m (RolePermInfo b)
forall a b. (a -> b) -> a -> b
$
                    -- this error will ideally never be thrown, but if it's thrown then
                    -- it's possible that the permissions for the role do exist, but it's
                    -- not yet built due to wrong ordering of the roles, check `orderRoles`
                    Text
"buildTablePermissions: table role permissions 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
" not found"
          let combinedParentRolePermInfo :: CombineRolePermInfo b
combinedParentRolePermInfo = [CombineRolePermInfo b] -> CombineRolePermInfo b
forall a. Monoid a => [a] -> a
mconcat ([CombineRolePermInfo b] -> CombineRolePermInfo b)
-> [CombineRolePermInfo b] -> CombineRolePermInfo b
forall a b. (a -> b) -> a -> b
$ (RolePermInfo b -> CombineRolePermInfo b)
-> [RolePermInfo b] -> [CombineRolePermInfo b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RolePermInfo b -> CombineRolePermInfo b
forall (b :: BackendType). RolePermInfo b -> CombineRolePermInfo b
rolePermInfoToCombineRolePermInfo [RolePermInfo b]
parentRolePermissions
              selectPermissionsCount :: Int
selectPermissionsCount = [RolePermInfo b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([RolePermInfo b] -> Int) -> [RolePermInfo b] -> Int
forall a b. (a -> b) -> a -> b
$ (RolePermInfo b -> Bool) -> [RolePermInfo b] -> [RolePermInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (SelPermInfo b) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (SelPermInfo b) -> Bool)
-> (RolePermInfo b -> Maybe (SelPermInfo b))
-> RolePermInfo b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RolePermInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (SelPermInfo b)
_permSel) [RolePermInfo b]
parentRolePermissions
          let accumulatedRolePermission :: Maybe (RolePermInfo b)
accumulatedRolePermission = RoleName -> RolePermInfoMap b -> Maybe (RolePermInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup RoleName
roleName RolePermInfoMap b
accumulatedRolePermMap
          let roleSelectPermission :: Maybe (SelPermInfo b)
roleSelectPermission =
                case (RolePermInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (SelPermInfo b)
_permSel (RolePermInfo b -> Maybe (SelPermInfo b))
-> Maybe (RolePermInfo b) -> Maybe (SelPermInfo b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (RolePermInfo b)
accumulatedRolePermission) of
                  Just SelPermInfo b
metadataSelectPerm -> SelPermInfo b -> Maybe (SelPermInfo b)
forall a. a -> Maybe a
Just SelPermInfo b
metadataSelectPerm
                  Maybe (SelPermInfo b)
Nothing -> Int -> CombinedSelPermInfo b -> SelPermInfo b
forall (b :: BackendType).
Backend b =>
Int -> CombinedSelPermInfo b -> SelPermInfo b
combinedSelPermInfoToSelPermInfo Int
selectPermissionsCount (CombinedSelPermInfo b -> SelPermInfo b)
-> Maybe (CombinedSelPermInfo b) -> Maybe (SelPermInfo b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CombineRolePermInfo b -> Maybe (CombinedSelPermInfo b)
forall (b :: BackendType).
CombineRolePermInfo b -> Maybe (CombinedSelPermInfo b)
crpiSelPerm CombineRolePermInfo b
combinedParentRolePermInfo)
          Maybe (InsPermInfo b)
roleInsertPermission <- arr
  (Writer (Seq CollectedInfo) (Maybe (InsPermInfo b)))
  (Maybe (InsPermInfo b))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< CheckPermission (InsPermInfo b)
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe (InsPermInfo b))
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> Writer (Seq CollectedInfo) (Maybe (InsPermInfo b))
forall (b :: BackendType) perm (m :: * -> *).
(MonadWriter (Seq CollectedInfo) m, BackendMetadata b) =>
CheckPermission perm
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe perm)
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> m (Maybe perm)
resolveCheckTablePermission (CombineRolePermInfo b -> CheckPermission (InsPermInfo b)
forall (b :: BackendType).
CombineRolePermInfo b -> CheckPermission (InsPermInfo b)
crpiInsPerm CombineRolePermInfo b
combinedParentRolePermInfo) Maybe (RolePermInfo b)
accumulatedRolePermission RolePermInfo b -> Maybe (InsPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (InsPermInfo b)
_permIns RoleName
roleName SourceName
source TableName b
table PermType
PTInsert
          Maybe (UpdPermInfo b)
roleUpdatePermission <- arr
  (Writer (Seq CollectedInfo) (Maybe (UpdPermInfo b)))
  (Maybe (UpdPermInfo b))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< CheckPermission (UpdPermInfo b)
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe (UpdPermInfo b))
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> Writer (Seq CollectedInfo) (Maybe (UpdPermInfo b))
forall (b :: BackendType) perm (m :: * -> *).
(MonadWriter (Seq CollectedInfo) m, BackendMetadata b) =>
CheckPermission perm
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe perm)
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> m (Maybe perm)
resolveCheckTablePermission (CombineRolePermInfo b -> CheckPermission (UpdPermInfo b)
forall (b :: BackendType).
CombineRolePermInfo b -> CheckPermission (UpdPermInfo b)
crpiUpdPerm CombineRolePermInfo b
combinedParentRolePermInfo) Maybe (RolePermInfo b)
accumulatedRolePermission RolePermInfo b -> Maybe (UpdPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (UpdPermInfo b)
_permUpd RoleName
roleName SourceName
source TableName b
table PermType
PTUpdate
          Maybe (DelPermInfo b)
roleDeletePermission <- arr
  (Writer (Seq CollectedInfo) (Maybe (DelPermInfo b)))
  (Maybe (DelPermInfo b))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< CheckPermission (DelPermInfo b)
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe (DelPermInfo b))
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> Writer (Seq CollectedInfo) (Maybe (DelPermInfo b))
forall (b :: BackendType) perm (m :: * -> *).
(MonadWriter (Seq CollectedInfo) m, BackendMetadata b) =>
CheckPermission perm
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe perm)
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> m (Maybe perm)
resolveCheckTablePermission (CombineRolePermInfo b -> CheckPermission (DelPermInfo b)
forall (b :: BackendType).
CombineRolePermInfo b -> CheckPermission (DelPermInfo b)
crpiDelPerm CombineRolePermInfo b
combinedParentRolePermInfo) Maybe (RolePermInfo b)
accumulatedRolePermission RolePermInfo b -> Maybe (DelPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (DelPermInfo b)
_permDel RoleName
roleName SourceName
source TableName b
table PermType
PTDelete
          let rolePermInfo :: RolePermInfo b
rolePermInfo = Maybe (InsPermInfo b)
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> Maybe (DelPermInfo b)
-> RolePermInfo b
forall (b :: BackendType).
Maybe (InsPermInfo b)
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> Maybe (DelPermInfo b)
-> RolePermInfo b
RolePermInfo Maybe (InsPermInfo b)
roleInsertPermission Maybe (SelPermInfo b)
roleSelectPermission Maybe (UpdPermInfo b)
roleUpdatePermission Maybe (DelPermInfo b)
roleDeletePermission
          arr (RolePermInfoMap b) (RolePermInfoMap b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< RoleName
-> RolePermInfo b -> RolePermInfoMap b -> RolePermInfoMap b
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert RoleName
roleName RolePermInfo b
rolePermInfo RolePermInfoMap b
accumulatedRolePermMap
      )
    |) RolePermInfoMap b
metadataRolePermissions (OrderedRoles -> [Role]
_unOrderedRoles OrderedRoles
orderedRoles)
  where
    mkMap :: [PermDef b e] -> HashMap RoleName (PermDef b e)
    mkMap :: [PermDef b e] -> HashMap RoleName (PermDef b e)
mkMap = (PermDef b e -> RoleName)
-> [PermDef b e] -> HashMap RoleName (PermDef b e)
forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> HashMap k a
mapFromL PermDef b e -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole

    alignPermissions :: TablePermissionInputs b
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
alignPermissions TablePermissionInputs {[PermDef b UpdPerm]
[PermDef b DelPerm]
[PermDef b SelPerm]
[PermDef b InsPerm]
TableName b
_tpiDelete :: forall (b :: BackendType).
TablePermissionInputs b -> [DelPermDef b]
_tpiUpdate :: forall (b :: BackendType).
TablePermissionInputs b -> [UpdPermDef b]
_tpiSelect :: forall (b :: BackendType).
TablePermissionInputs b -> [SelPermDef b]
_tpiInsert :: forall (b :: BackendType).
TablePermissionInputs b -> [InsPermDef b]
_tpiDelete :: [PermDef b DelPerm]
_tpiUpdate :: [PermDef b UpdPerm]
_tpiSelect :: [PermDef b SelPerm]
_tpiInsert :: [PermDef b InsPerm]
_tpiTable :: TableName b
_tpiTable :: forall (b :: BackendType). TablePermissionInputs b -> TableName b
..} =
      let insertsMap :: HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
insertsMap = (PermDef b InsPerm
 -> ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
     [PermDef b DelPerm]))
-> HashMap RoleName (PermDef b InsPerm)
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map (\PermDef b InsPerm
a -> ([PermDef b InsPerm
a], [], [], [])) ([PermDef b InsPerm] -> HashMap RoleName (PermDef b InsPerm)
forall (e :: BackendType -> *).
[PermDef b e] -> HashMap RoleName (PermDef b e)
mkMap [PermDef b InsPerm]
_tpiInsert)
          selectsMap :: HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
selectsMap = (PermDef b SelPerm
 -> ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
     [PermDef b DelPerm]))
-> HashMap RoleName (PermDef b SelPerm)
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map (\PermDef b SelPerm
a -> ([], [PermDef b SelPerm
a], [], [])) ([PermDef b SelPerm] -> HashMap RoleName (PermDef b SelPerm)
forall (e :: BackendType -> *).
[PermDef b e] -> HashMap RoleName (PermDef b e)
mkMap [PermDef b SelPerm]
_tpiSelect)
          updatesMap :: HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
updatesMap = (PermDef b UpdPerm
 -> ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
     [PermDef b DelPerm]))
-> HashMap RoleName (PermDef b UpdPerm)
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map (\PermDef b UpdPerm
a -> ([], [], [PermDef b UpdPerm
a], [])) ([PermDef b UpdPerm] -> HashMap RoleName (PermDef b UpdPerm)
forall (e :: BackendType -> *).
[PermDef b e] -> HashMap RoleName (PermDef b e)
mkMap [PermDef b UpdPerm]
_tpiUpdate)
          deletesMap :: HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
deletesMap = (PermDef b DelPerm
 -> ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
     [PermDef b DelPerm]))
-> HashMap RoleName (PermDef b DelPerm)
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map (\PermDef b DelPerm
a -> ([], [], [], [PermDef b DelPerm
a])) ([PermDef b DelPerm] -> HashMap RoleName (PermDef b DelPerm)
forall (e :: BackendType -> *).
[PermDef b e] -> HashMap RoleName (PermDef b e)
mkMap [PermDef b DelPerm]
_tpiDelete)
          unionMap :: HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
unionMap = (([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
  [PermDef b DelPerm])
 -> ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
     [PermDef b DelPerm])
 -> ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
     [PermDef b DelPerm]))
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
M.unionWith ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
 [PermDef b DelPerm])
-> ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
    [PermDef b DelPerm])
-> ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
    [PermDef b DelPerm])
forall a. Semigroup a => a -> a -> a
(<>)
       in HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
insertsMap HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
`unionMap` HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
selectsMap HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
`unionMap` HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
updatesMap HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
-> HashMap
     RoleName
     ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
      [PermDef b DelPerm])
`unionMap` HashMap
  RoleName
  ([PermDef b InsPerm], [PermDef b SelPerm], [PermDef b UpdPerm],
   [PermDef b DelPerm])
deletesMap

mkPermissionMetadataObject ::
  forall b a.
  (BackendMetadata b) =>
  SourceName ->
  TableName b ->
  PermDef b a ->
  MetadataObject
mkPermissionMetadataObject :: SourceName -> TableName b -> PermDef b a -> MetadataObject
mkPermissionMetadataObject SourceName
source TableName b
table PermDef b a
permDef =
  let permType :: PermType
permType = 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
permDef)
      objectId :: MetadataObjId
objectId =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$
          SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$
            TableName b -> TableMetadataObjId -> SourceMetadataObjId b
forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
table (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$
              RoleName -> PermType -> TableMetadataObjId
MTOPerm (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permDef) PermType
permType
      definition :: Value
definition = WithTable b (PermDef b a) -> Value
forall a. ToJSON a => a -> Value
toJSON (WithTable b (PermDef b a) -> Value)
-> WithTable b (PermDef b a) -> Value
forall a b. (a -> b) -> a -> b
$ SourceName
-> TableName b -> PermDef b a -> WithTable b (PermDef b a)
forall (b :: BackendType) a.
SourceName -> TableName b -> a -> WithTable b a
WithTable @b SourceName
source TableName b
table PermDef b a
permDef
   in MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
objectId Value
definition

mkRemoteSchemaPermissionMetadataObject ::
  AddRemoteSchemaPermission ->
  MetadataObject
mkRemoteSchemaPermissionMetadataObject :: AddRemoteSchemaPermission -> MetadataObject
mkRemoteSchemaPermissionMetadataObject (AddRemoteSchemaPermission RemoteSchemaName
rsName RoleName
roleName RemoteSchemaPermissionDefinition
defn Maybe Text
_) =
  let objectId :: MetadataObjId
objectId = RemoteSchemaName -> RoleName -> MetadataObjId
MORemoteSchemaPermissions RemoteSchemaName
rsName RoleName
roleName
   in MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
objectId (Value -> MetadataObject) -> Value -> MetadataObject
forall a b. (a -> b) -> a -> b
$ RemoteSchemaPermissionDefinition -> Value
forall a. ToJSON a => a -> Value
toJSON RemoteSchemaPermissionDefinition
defn

withPermission ::
  forall bknd a b c s arr.
  (ArrowChoice arr, ArrowWriter (Seq CollectedInfo) arr, BackendMetadata bknd) =>
  WriterA (Seq SchemaDependency) (ErrorA QErr arr) (a, s) b ->
  ( a,
    ((SourceName, TableName bknd, PermDef bknd c, Proxy bknd), s)
  )
    `arr` (Maybe b)
withPermission :: WriterA (Seq SchemaDependency) (ErrorA QErr arr) (a, s) b
-> arr
     (a, ((SourceName, TableName bknd, PermDef bknd c, Proxy bknd), s))
     (Maybe b)
withPermission WriterA (Seq SchemaDependency) (ErrorA QErr arr) (a, s) b
f = proc (a
e, ((SourceName
source, TableName bknd
table, PermDef bknd c
permDef, Proxy bknd
_proxy), s
s)) -> do
  let metadataObject :: MetadataObject
metadataObject = SourceName -> TableName bknd -> PermDef bknd c -> MetadataObject
forall (b :: BackendType) (a :: BackendType -> *).
BackendMetadata b =>
SourceName -> TableName b -> PermDef b a -> MetadataObject
mkPermissionMetadataObject @bknd SourceName
source TableName bknd
table PermDef bknd c
permDef
      permType :: PermType
permType = PermDefPermission bknd c -> PermType
forall (b :: BackendType) (a :: BackendType -> *).
PermDefPermission b a -> PermType
reflectPermDefPermission (PermDef bknd c -> PermDefPermission bknd c
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> PermDefPermission b perm
_pdPermission PermDef bknd c
permDef)
      roleName :: RoleName
roleName = PermDef bknd c -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef bknd c
permDef
      schemaObject :: SchemaObjId
schemaObject =
        SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$
          SourceObjId bknd -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceObjId bknd -> AnyBackend SourceObjId)
-> SourceObjId bknd -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$
            TableName bknd -> TableObjId bknd -> SourceObjId bknd
forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @bknd TableName bknd
table (TableObjId bknd -> SourceObjId bknd)
-> TableObjId bknd -> SourceObjId bknd
forall a b. (a -> b) -> a -> b
$
              RoleName -> PermType -> TableObjId bknd
forall (b :: BackendType). RoleName -> PermType -> TableObjId b
TOPerm RoleName
roleName PermType
permType
      addPermContext :: Text -> Text
addPermContext Text
err = Text
"in permission for role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
  (|
    forall a.
ErrorA QErr arr (a, ()) b
-> arr (a, (MetadataObject, ())) (Maybe b)
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
      ( (|
          forall a.
WriterA (Seq SchemaDependency) (ErrorA QErr arr) (a, ()) b
-> ErrorA QErr arr (a, (MetadataObject, (SchemaObjId, ()))) b
forall (arr :: * -> * -> *) e s a.
ArrowWriter (Seq CollectedInfo) arr =>
WriterA (Seq SchemaDependency) arr (e, s) a
-> arr (e, (MetadataObject, (SchemaObjId, s))) a
withRecordDependencies
            ( (|
                forall a.
WriterA (Seq SchemaDependency) (ErrorA QErr arr) (a, ()) b
-> WriterA
     (Seq SchemaDependency) (ErrorA QErr arr) (a, (Text -> Text, ())) b
forall (arr :: * -> * -> *) e s a.
ArrowError QErr arr =>
arr (e, s) a -> arr (e, (Text -> Text, s)) a
modifyErrA
                  (WriterA (Seq SchemaDependency) (ErrorA QErr arr) (a, s) b
f -< (a
e, s
s))
              |) (TableName bknd -> Text -> Text
forall (b :: BackendType). Backend b => TableName b -> Text -> Text
addTableContext @bknd TableName bknd
table (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addPermContext)
            )
        |) MetadataObject
metadataObject SchemaObjId
schemaObject
      )
    |) MetadataObject
metadataObject

buildPermission ::
  forall b a arr m.
  ( ArrowChoice arr,
    ArrowWriter (Seq CollectedInfo) arr,
    Inc.ArrowCache m arr,
    Inc.Cacheable (a b),
    Inc.Cacheable (Proxy b),
    MonadError QErr m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b
  ) =>
  ( Proxy b,
    Inc.Dependency (TableCoreCache b),
    SourceName,
    TableName b,
    FieldInfoMap (FieldInfo b),
    Maybe (PermDef b a)
  )
    `arr` Maybe (PermInfo a b)
buildPermission :: arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b a))
  (Maybe (PermInfo a b))
buildPermission = arr
  (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
   FieldInfoMap (FieldInfo b), Maybe (PermDef b a))
  (Maybe (PermInfo a b))
-> arr
     (Proxy b, Dependency (TableCoreCache b), SourceName, TableName b,
      FieldInfoMap (FieldInfo b), Maybe (PermDef b a))
     (Maybe (PermInfo a b))
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Cacheable a) =>
arr a b -> arr a b
Inc.cache proc (Proxy b
proxy, Dependency (TableCoreCache b)
tableCache, SourceName
source, TableName b
table, FieldInfoMap (FieldInfo b)
tableFields, Maybe (PermDef b a)
maybePermission) ->
  do
    (|
      forall a.
arr (a, (PermDef b a, ())) (Maybe (PermInfo a b))
-> arr
     (a, (Maybe (PermDef b a), ())) (Maybe (Maybe (PermInfo a b)))
forall (arr :: * -> * -> *) (t :: * -> *) e a s b.
(ArrowChoice arr, Traversable t) =>
arr (e, (a, s)) b -> arr (e, (t a, s)) (t b)
traverseA
        ( \PermDef b a
permission ->
            (|
              forall a.
WriterA
  (Seq SchemaDependency) (ErrorA QErr arr) (a, ()) (PermInfo a b)
-> arr
     (a, ((SourceName, TableName b, PermDef b a, Proxy b), ()))
     (Maybe (PermInfo a b))
forall (bknd :: BackendType) a b (c :: BackendType -> *) s
       (arr :: * -> * -> *).
(ArrowChoice arr, ArrowWriter (Seq CollectedInfo) arr,
 BackendMetadata bknd) =>
WriterA (Seq SchemaDependency) (ErrorA QErr arr) (a, s) b
-> arr
     (a, ((SourceName, TableName bknd, PermDef bknd c, Proxy bknd), s))
     (Maybe b)
withPermission
                ( do
                    WriterA (Seq SchemaDependency) (ErrorA QErr arr) (m ()) ()
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA
                      -<
                        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permission 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
ConstraintViolation Text
"cannot define permission for admin role"
                    (PermInfo a b
info, [SchemaDependency]
dependencies) <-
                      WriterA
  (Seq SchemaDependency)
  (ErrorA QErr arr)
  (Either QErr (PermInfo a b, [SchemaDependency]))
  (PermInfo a b, [SchemaDependency])
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA WriterA
  (Seq SchemaDependency)
  (ErrorA QErr arr)
  (Either QErr (PermInfo a b, [SchemaDependency]))
  (PermInfo a b, [SchemaDependency])
-> WriterA
     (Seq SchemaDependency)
     (ErrorA QErr arr)
     (DependT m (Either QErr (PermInfo a b, [SchemaDependency])))
     (Either QErr (PermInfo a b, [SchemaDependency]))
-> WriterA
     (Seq SchemaDependency)
     (ErrorA QErr arr)
     (DependT m (Either QErr (PermInfo a b, [SchemaDependency])))
     (PermInfo a b, [SchemaDependency])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< WriterA
  (Seq SchemaDependency)
  (ErrorA QErr arr)
  (DependT m (Either QErr (PermInfo a b, [SchemaDependency])))
  (Either QErr (PermInfo a b, [SchemaDependency]))
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowCache m arr =>
arr (DependT m a) a
Inc.bindDepend
                        -<
                          ExceptT QErr (DependT m) (PermInfo a b, [SchemaDependency])
-> DependT m (Either QErr (PermInfo a b, [SchemaDependency]))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr (DependT m) (PermInfo a b, [SchemaDependency])
 -> DependT m (Either QErr (PermInfo a b, [SchemaDependency])))
-> ExceptT QErr (DependT m) (PermInfo a b, [SchemaDependency])
-> DependT m (Either QErr (PermInfo a b, [SchemaDependency]))
forall a b. (a -> b) -> a -> b
$
                            TableCoreCacheRT
  b (ExceptT QErr (DependT m)) (PermInfo a b, [SchemaDependency])
-> (SourceName, Dependency (TableCoreCache b))
-> ExceptT QErr (DependT m) (PermInfo a b, [SchemaDependency])
forall (b :: BackendType) (m :: * -> *) a.
TableCoreCacheRT b m a
-> (SourceName, Dependency (TableCoreCache b)) -> m a
runTableCoreCacheRT
                              ( SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> RoleName
-> PermDefPermission b a
-> TableCoreCacheRT
     b (ExceptT QErr (DependT m)) (PermInfo a b, [SchemaDependency])
forall (b :: BackendType) (m :: * -> *) (perm :: BackendType -> *).
(BackendMetadata b, QErrM m, TableCoreInfoRM b m,
 GetAggregationPredicatesDeps b) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> RoleName
-> PermDefPermission b perm
-> m (WithDeps (PermInfo perm b))
buildPermInfo
                                  SourceName
source
                                  TableName b
table
                                  FieldInfoMap (FieldInfo b)
tableFields
                                  (PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permission)
                                  (PermDef b a -> PermDefPermission b a
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> PermDefPermission b perm
_pdPermission PermDef b a
permission)
                              )
                              (SourceName
source, Dependency (TableCoreCache b)
tableCache)
                    WriterA
  (Seq SchemaDependency) (ErrorA QErr arr) (Seq SchemaDependency) ()
forall w (arr :: * -> * -> *). ArrowWriter w arr => arr w ()
tellA -< [SchemaDependency] -> Seq SchemaDependency
forall a. [a] -> Seq a
Seq.fromList [SchemaDependency]
dependencies
                    WriterA
  (Seq SchemaDependency)
  (ErrorA QErr arr)
  (PermInfo a b)
  (PermInfo a b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< PermInfo a b
info
                )
            |) (SourceName
source, TableName b
table, PermDef b a
permission, Proxy b
proxy)
        )
      |) Maybe (PermDef b a)
maybePermission
    forall a.
arr (a, ()) (Maybe (Maybe (PermInfo a b)))
-> arr
     (a, (Maybe (Maybe (PermInfo a b)), ())) (Maybe (PermInfo a b))
-> arr (a, ()) (Maybe (PermInfo a b))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (\Maybe (Maybe (PermInfo a b))
info -> Maybe (Maybe (PermInfo a b)) -> Maybe (PermInfo a b)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe (PermInfo a b))
info >- arr (Maybe (PermInfo a b)) (Maybe (PermInfo a b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)