module Hasura.RQL.DDL.Schema.Cache.Permission
( buildTablePermissions,
orderRoles,
OrderedRoles,
_unOrderedRoles,
mkBooleanPermissionMap,
resolveCheckPermission,
buildLogicalModelPermissions,
)
where
import Data.Aeson
import Data.Environment qualified as Env
import Data.Graph qualified as G
import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.LogicalModel.Metadata (WithLogicalModel (..))
import Hasura.LogicalModel.Types (LogicalModelField (..), LogicalModelName)
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.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.SQL.AnyBackend qualified as AB
import Hasura.Table.Cache
mkBooleanPermissionMap :: (RoleName -> a) -> HashMap RoleName a -> OrderedRoles -> HashMap RoleName a
mkBooleanPermissionMap :: forall a.
(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 b a. (b -> a -> b) -> b -> [a] -> b
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
HashMap.lookup RoleName
roleName HashMap RoleName a
accumulatedPermMap of
Just a
_ -> HashMap RoleName a
accumulatedPermMap
Maybe a
Nothing ->
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
`HashMap.member` HashMap RoleName a
accumulatedPermMap)) (HashSet RoleName -> [RoleName]
forall a. HashSet a -> [a]
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
HashMap.insert RoleName
roleName (RoleName -> a
constructorFn RoleName
roleName) HashMap RoleName a
accumulatedPermMap
else HashMap RoleName a
accumulatedPermMap
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
$c== :: OrderedRoles -> OrderedRoles -> Bool
== :: OrderedRoles -> OrderedRoles -> Bool
$c/= :: OrderedRoles -> OrderedRoles -> Bool
/= :: 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
$cfrom :: forall x. OrderedRoles -> Rep OrderedRoles x
from :: forall x. OrderedRoles -> Rep OrderedRoles x
$cto :: forall x. Rep OrderedRoles x -> OrderedRoles
to :: forall x. Rep OrderedRoles x -> OrderedRoles
Generic)
orderRoles ::
(MonadError QErr m) =>
[Role] ->
m OrderedRoles
orderRoles :: forall (m :: * -> *). MonadError QErr m => [Role] -> m OrderedRoles
orderRoles [Role]
allRoles = do
let graphNodesList :: [(Role, RoleName, [RoleName])]
graphNodesList = [(Role
role, Role -> RoleName
_rRoleName Role
role, HashSet RoleName -> [RoleName]
forall a. HashSet a -> [a]
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
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 a. [a] -> 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
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 a. a -> m a
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 ::
(MonadWriter (Seq CollectItem) m) =>
CheckPermission p ->
RoleName ->
InconsistentRoleEntity ->
m (Maybe p)
resolveCheckPermission :: forall (m :: * -> *) p.
MonadWriter (Seq CollectItem) m =>
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 :: CollectItem
inconsistentObj =
InconsistentMetadata -> CollectItem
CollectInconsistentMetadata
(InconsistentMetadata -> CollectItem)
-> InconsistentMetadata -> CollectItem
forall a b. (a -> b) -> a -> b
$ RoleName -> InconsistentRoleEntity -> InconsistentMetadata
ConflictingInheritedPermission RoleName
roleName InconsistentRoleEntity
inconsistentEntity
Seq CollectItem -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Seq CollectItem -> m ()) -> Seq CollectItem -> m ()
forall a b. (a -> b) -> a -> b
$ CollectItem -> Seq CollectItem
forall a. a -> Seq a
Seq.singleton CollectItem
inconsistentObj
Maybe p -> m (Maybe p)
forall a. a -> m a
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 a. a -> m a
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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe p
forall a. Maybe a
Nothing
resolveCheckTablePermission ::
( MonadWriter (Seq CollectItem) m,
BackendMetadata b
) =>
CheckPermission perm ->
Maybe (RolePermInfo b) ->
(RolePermInfo b -> Maybe perm) ->
RoleName ->
SourceName ->
TableName b ->
PermType ->
m (Maybe perm)
resolveCheckTablePermission :: forall (m :: * -> *) (b :: BackendType) perm.
(MonadWriter (Seq CollectItem) m, BackendMetadata b) =>
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
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 CollectItem) m =>
CheckPermission p
-> RoleName -> InconsistentRoleEntity -> m (Maybe p)
resolveCheckPermission CheckPermission perm
checkPermission RoleName
roleName InconsistentRoleEntity
inconsistentRoleEntity
buildTablePermissions ::
forall b m r.
( MonadError QErr m,
MonadWriter (Seq CollectItem) m,
BackendMetadata b,
GetAggregationPredicatesDeps b,
MonadReader r m,
Has (ScalarTypeParsingContext b) r
) =>
Env.Environment ->
SourceName ->
TableCoreCache b ->
FieldInfoMap (FieldInfo b) ->
TablePermissionInputs b ->
OrderedRoles ->
m (RolePermInfoMap b)
buildTablePermissions :: forall (b :: BackendType) (m :: * -> *) r.
(MonadError QErr m, MonadWriter (Seq CollectItem) m,
BackendMetadata b, GetAggregationPredicatesDeps b, MonadReader r m,
Has (ScalarTypeParsingContext b) r) =>
Environment
-> SourceName
-> TableCoreCache b
-> FieldInfoMap (FieldInfo b)
-> TablePermissionInputs b
-> OrderedRoles
-> m (RolePermInfoMap b)
buildTablePermissions Environment
env SourceName
source TableCoreCache b
tableCache FieldInfoMap (FieldInfo b)
tableFields TablePermissionInputs b
tablePermissions OrderedRoles
orderedRoles = do
let alignedPermissions :: HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
alignedPermissions = TablePermissionInputs b
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
alignPermissions TablePermissionInputs b
tablePermissions
go :: RolePermInfoMap b -> Role -> m (RolePermInfoMap b)
go RolePermInfoMap b
accumulatedRolePermMap (Role RoleName
roleName (ParentRoles HashSet RoleName
parentRoles)) = do
[RolePermInfo b]
parentRolePermissions <-
[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 a. HashSet a -> [a]
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
HashMap.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
$
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 a b. (a -> b) -> [a] -> [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 a. [a] -> 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
accumulatedRolePermission :: Maybe (RolePermInfo b)
accumulatedRolePermission = RoleName -> RolePermInfoMap b -> Maybe (RolePermInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RoleName
roleName RolePermInfoMap b
accumulatedRolePermMap
roleSelectPermission :: Maybe (SelPermInfo b)
roleSelectPermission =
Maybe (SelPermInfo b)
-> Maybe (SelPermInfo b) -> Maybe (SelPermInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (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)
(Maybe (SelPermInfo b) -> Maybe (SelPermInfo b))
-> Maybe (SelPermInfo b) -> Maybe (SelPermInfo b)
forall a b. (a -> b) -> a -> b
$ 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 <- CheckPermission (InsPermInfo b)
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe (InsPermInfo b))
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> m (Maybe (InsPermInfo b))
forall (m :: * -> *) (b :: BackendType) perm.
(MonadWriter (Seq CollectItem) 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 <- CheckPermission (UpdPermInfo b)
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe (UpdPermInfo b))
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> m (Maybe (UpdPermInfo b))
forall (m :: * -> *) (b :: BackendType) perm.
(MonadWriter (Seq CollectItem) 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 <- CheckPermission (DelPermInfo b)
-> Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe (DelPermInfo b))
-> RoleName
-> SourceName
-> TableName b
-> PermType
-> m (Maybe (DelPermInfo b))
forall (m :: * -> *) (b :: BackendType) perm.
(MonadWriter (Seq CollectItem) 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
RolePermInfoMap b -> m (RolePermInfoMap b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RolePermInfoMap b -> m (RolePermInfoMap b))
-> RolePermInfoMap b -> m (RolePermInfoMap b)
forall a b. (a -> b) -> a -> b
$ RoleName
-> RolePermInfo b -> RolePermInfoMap b -> RolePermInfoMap b
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert RoleName
roleName RolePermInfo b
rolePermInfo RolePermInfoMap b
accumulatedRolePermMap
RolePermInfoMap b
metadataRolePermissions <-
HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
-> ((Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
-> m (RolePermInfo b))
-> m (RolePermInfoMap b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
alignedPermissions \(Maybe (PermDef b InsPerm)
insertPermission, Maybe (PermDef b SelPerm)
selectPermission, Maybe (PermDef b UpdPerm)
updatePermission, Maybe (PermDef b DelPerm)
deletePermission) -> do
Maybe (InsPermInfo b)
insert <- Maybe (PermDef b InsPerm) -> m (Maybe (PermInfo InsPerm b))
forall (a :: BackendType -> *).
Maybe (PermDef b a) -> m (Maybe (PermInfo a b))
buildPermission Maybe (PermDef b InsPerm)
insertPermission
Maybe (SelPermInfo b)
select <- Maybe (PermDef b SelPerm) -> m (Maybe (PermInfo SelPerm b))
forall (a :: BackendType -> *).
Maybe (PermDef b a) -> m (Maybe (PermInfo a b))
buildPermission Maybe (PermDef b SelPerm)
selectPermission
Maybe (UpdPermInfo b)
update <- Maybe (PermDef b UpdPerm) -> m (Maybe (PermInfo UpdPerm b))
forall (a :: BackendType -> *).
Maybe (PermDef b a) -> m (Maybe (PermInfo a b))
buildPermission Maybe (PermDef b UpdPerm)
updatePermission
Maybe (DelPermInfo b)
delete <- Maybe (PermDef b DelPerm) -> m (Maybe (PermInfo DelPerm b))
forall (a :: BackendType -> *).
Maybe (PermDef b a) -> m (Maybe (PermInfo a b))
buildPermission Maybe (PermDef b DelPerm)
deletePermission
RolePermInfo b -> m (RolePermInfo b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RolePermInfo b -> m (RolePermInfo b))
-> RolePermInfo b -> m (RolePermInfo b)
forall a b. (a -> b) -> a -> b
$ 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
(RolePermInfoMap b -> Role -> m (RolePermInfoMap b))
-> RolePermInfoMap b -> [Role] -> m (RolePermInfoMap b)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM RolePermInfoMap b -> Role -> m (RolePermInfoMap b)
go RolePermInfoMap b
metadataRolePermissions (OrderedRoles -> [Role]
_unOrderedRoles OrderedRoles
orderedRoles)
where
table :: TableName b
table = TablePermissionInputs b -> TableName b
forall (b :: BackendType). TablePermissionInputs b -> TableName b
_tpiTable TablePermissionInputs b
tablePermissions
mkMap :: [PermDef b e] -> HashMap RoleName (PermDef b e)
mkMap :: forall (e :: BackendType -> *).
[PermDef b e] -> HashMap RoleName (PermDef b e)
mkMap = (PermDef b e -> RoleName)
-> [PermDef b e] -> HashMap RoleName (PermDef b e)
forall k a. 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
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
alignPermissions TablePermissionInputs {[PermDef b UpdPerm]
[PermDef b DelPerm]
[PermDef b SelPerm]
[PermDef b InsPerm]
TableName b
_tpiTable :: forall (b :: BackendType). TablePermissionInputs b -> TableName b
_tpiTable :: TableName b
_tpiInsert :: [PermDef b InsPerm]
_tpiSelect :: [PermDef b SelPerm]
_tpiUpdate :: [PermDef b UpdPerm]
_tpiDelete :: [PermDef b DelPerm]
_tpiInsert :: forall (b :: BackendType).
TablePermissionInputs b -> [InsPermDef b]
_tpiSelect :: forall (b :: BackendType).
TablePermissionInputs b -> [SelPermDef b]
_tpiUpdate :: forall (b :: BackendType).
TablePermissionInputs b -> [UpdPermDef b]
_tpiDelete :: forall (b :: BackendType).
TablePermissionInputs b -> [DelPermDef b]
..} =
let insertsMap :: HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
insertsMap = (\PermDef b InsPerm
a -> (PermDef b InsPerm -> Maybe (PermDef b InsPerm)
forall a. a -> Maybe a
Just PermDef b InsPerm
a, Maybe (PermDef b SelPerm)
forall a. Maybe a
Nothing, Maybe (PermDef b UpdPerm)
forall a. Maybe a
Nothing, Maybe (PermDef b DelPerm)
forall a. Maybe a
Nothing)) (PermDef b InsPerm
-> (Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm)))
-> HashMap RoleName (PermDef b InsPerm)
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
selectsMap = (\PermDef b SelPerm
a -> (Maybe (PermDef b InsPerm)
forall a. Maybe a
Nothing, PermDef b SelPerm -> Maybe (PermDef b SelPerm)
forall a. a -> Maybe a
Just PermDef b SelPerm
a, Maybe (PermDef b UpdPerm)
forall a. Maybe a
Nothing, Maybe (PermDef b DelPerm)
forall a. Maybe a
Nothing)) (PermDef b SelPerm
-> (Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm)))
-> HashMap RoleName (PermDef b SelPerm)
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
updatesMap = (\PermDef b UpdPerm
a -> (Maybe (PermDef b InsPerm)
forall a. Maybe a
Nothing, Maybe (PermDef b SelPerm)
forall a. Maybe a
Nothing, PermDef b UpdPerm -> Maybe (PermDef b UpdPerm)
forall a. a -> Maybe a
Just PermDef b UpdPerm
a, Maybe (PermDef b DelPerm)
forall a. Maybe a
Nothing)) (PermDef b UpdPerm
-> (Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm)))
-> HashMap RoleName (PermDef b UpdPerm)
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
deletesMap = (\PermDef b DelPerm
a -> (Maybe (PermDef b InsPerm)
forall a. Maybe a
Nothing, Maybe (PermDef b SelPerm)
forall a. Maybe a
Nothing, Maybe (PermDef b UpdPerm)
forall a. Maybe a
Nothing, PermDef b DelPerm -> Maybe (PermDef b DelPerm)
forall a. a -> Maybe a
Just PermDef b DelPerm
a)) (PermDef b DelPerm
-> (Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm)))
-> HashMap RoleName (PermDef b DelPerm)
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
unionMap = ((Maybe a, Maybe a, Maybe a, Maybe a)
-> (Maybe a, Maybe a, Maybe a, Maybe a)
-> (Maybe a, Maybe a, Maybe a, Maybe a))
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith \(Maybe a
a, Maybe a
b, Maybe a
c, Maybe a
d) (Maybe a
a', Maybe a
b', Maybe a
c', Maybe a
d') -> (Maybe a
a Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
a', Maybe a
b Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
b', Maybe a
c Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
c', Maybe a
d Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
d')
in HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
insertsMap HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
forall {a} {a} {a} {a}.
HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
`unionMap` HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
selectsMap HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
forall {a} {a} {a} {a}.
HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
`unionMap` HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
updatesMap HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
-> HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
forall {a} {a} {a} {a}.
HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
-> HashMap RoleName (Maybe a, Maybe a, Maybe a, Maybe a)
`unionMap` HashMap
RoleName
(Maybe (PermDef b InsPerm), Maybe (PermDef b SelPerm),
Maybe (PermDef b UpdPerm), Maybe (PermDef b DelPerm))
deletesMap
buildPermission :: Maybe (PermDef b a) -> m (Maybe (PermInfo a b))
buildPermission :: forall (a :: BackendType -> *).
Maybe (PermDef b a) -> m (Maybe (PermInfo a b))
buildPermission Maybe (PermDef b a)
Nothing = Maybe (PermInfo a b) -> m (Maybe (PermInfo a b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (PermInfo a b)
forall a. Maybe a
Nothing
buildPermission (Just PermDef b a
permission) = do
let metadataObject :: MetadataObject
metadataObject = PermDef b a -> MetadataObject
forall (a :: BackendType -> *). PermDef b a -> MetadataObject
mkPermissionMetadataObject PermDef b a
permission
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
permission)
roleName :: RoleName
roleName = PermDef b a -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole PermDef b a
permission
schemaObject :: SchemaObjId
schemaObject =
SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
(AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
(SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
table
(TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ RoleName -> PermType -> TableObjId b
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
MetadataObject
-> ExceptT QErr m (PermInfo a b) -> m (Maybe (PermInfo a b))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject (ExceptT QErr m (PermInfo a b) -> m (Maybe (PermInfo a b)))
-> ExceptT QErr m (PermInfo a b) -> m (Maybe (PermInfo a b))
forall a b. (a -> b) -> a -> b
$ (Text -> Text)
-> ExceptT QErr m (PermInfo a b) -> ExceptT QErr m (PermInfo a b)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (forall (b :: BackendType). Backend b => TableName b -> Text -> Text
addTableContext @b TableName b
table (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addPermContext) do
Bool -> ExceptT QErr m () -> ExceptT QErr 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)
(ExceptT QErr m () -> ExceptT QErr m ())
-> ExceptT QErr m () -> ExceptT QErr m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> ExceptT QErr m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintViolation Text
"cannot define permission for admin role"
(PermInfo a b
info, Seq SchemaDependency
dependencies) <-
TableCoreCacheRT
b (ExceptT QErr m) (PermInfo a b, Seq SchemaDependency)
-> TableCoreCache b
-> ExceptT QErr m (PermInfo a b, Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *) a.
TableCoreCacheRT b m a -> TableCoreCache b -> m a
runTableCoreCacheRT
( Environment
-> SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> RoleName
-> PermDefPermission b a
-> TableCoreCacheRT
b (ExceptT QErr m) (PermInfo a b, Seq SchemaDependency)
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
env
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)
)
TableCoreCache b
tableCache
MetadataObject
-> SchemaObjId -> Seq SchemaDependency -> ExceptT QErr m ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObject Seq SchemaDependency
dependencies
PermInfo a b -> ExceptT QErr m (PermInfo a b)
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PermInfo a b
info
mkPermissionMetadataObject :: PermDef b a -> MetadataObject
mkPermissionMetadataObject :: forall (a :: BackendType -> *). PermDef b a -> MetadataObject
mkPermissionMetadataObject 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
$ 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
$ 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
buildLogicalModelPermissions ::
forall b m r.
( MonadError QErr m,
MonadWriter (Seq CollectItem) m,
BackendMetadata b,
GetAggregationPredicatesDeps b,
MonadReader r m,
Has (ScalarTypeParsingContext b) r
) =>
SourceName ->
TableCoreCache b ->
LogicalModelName ->
InsOrdHashMap (Column b) (LogicalModelField b) ->
InsOrdHashMap RoleName (SelPermDef b) ->
OrderedRoles ->
m (RolePermInfoMap b)
buildLogicalModelPermissions :: forall (b :: BackendType) (m :: * -> *) r.
(MonadError QErr m, MonadWriter (Seq CollectItem) m,
BackendMetadata b, GetAggregationPredicatesDeps b, MonadReader r m,
Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableCoreCache b
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> InsOrdHashMap RoleName (SelPermDef b)
-> OrderedRoles
-> m (RolePermInfoMap b)
buildLogicalModelPermissions SourceName
sourceName TableCoreCache b
tableCache LogicalModelName
logicalModelName InsOrdHashMap (Column b) (LogicalModelField b)
logicalModelFields InsOrdHashMap RoleName (SelPermDef b)
selectPermissions OrderedRoles
orderedRoles = do
let combineRolePermissions :: RolePermInfoMap b -> Role -> m (RolePermInfoMap b)
combineRolePermissions :: RolePermInfoMap b -> Role -> m (RolePermInfoMap b)
combineRolePermissions RolePermInfoMap b
acc (Role RoleName
roleName (ParentRoles HashSet RoleName
parentRoles)) = do
[RolePermInfo b]
parentRolePermissions <-
[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 a. HashSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet RoleName
parentRoles) \RoleName
role ->
RoleName -> RolePermInfoMap b -> Maybe (RolePermInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RoleName
role RolePermInfoMap b
acc
Maybe (RolePermInfo b) -> m (RolePermInfo b) -> m (RolePermInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> m (RolePermInfo b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (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
combinedParentRolePermInfo = (RolePermInfo b -> CombineRolePermInfo b)
-> [RolePermInfo b] -> CombineRolePermInfo b
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RolePermInfo b -> CombineRolePermInfo b
forall (b :: BackendType). RolePermInfo b -> CombineRolePermInfo b
rolePermInfoToCombineRolePermInfo [RolePermInfo b]
parentRolePermissions
selectPermissionsCount :: Int
selectPermissionsCount :: Int
selectPermissionsCount = [SelPermInfo b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((RolePermInfo b -> Maybe (SelPermInfo b))
-> [RolePermInfo b] -> [SelPermInfo b]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe RolePermInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (SelPermInfo b)
_permSel [RolePermInfo b]
parentRolePermissions)
accumulatedRolePermission :: Maybe (RolePermInfo b)
accumulatedRolePermission :: Maybe (RolePermInfo b)
accumulatedRolePermission = RoleName -> RolePermInfoMap b -> Maybe (RolePermInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RoleName
roleName RolePermInfoMap b
acc
roleSelectPermission :: Maybe (SelPermInfo b)
roleSelectPermission :: Maybe (SelPermInfo b)
roleSelectPermission =
Maybe (SelPermInfo b)
-> Maybe (SelPermInfo b) -> Maybe (SelPermInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Maybe (RolePermInfo b)
accumulatedRolePermission Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe (SelPermInfo b))
-> Maybe (SelPermInfo b)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RolePermInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (SelPermInfo b)
_permSel)
(Maybe (SelPermInfo b) -> Maybe (SelPermInfo b))
-> Maybe (SelPermInfo b) -> Maybe (SelPermInfo b)
forall a b. (a -> b) -> a -> b
$ (CombinedSelPermInfo b -> SelPermInfo b)
-> Maybe (CombinedSelPermInfo b) -> Maybe (SelPermInfo b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> CombinedSelPermInfo b -> SelPermInfo b
forall (b :: BackendType).
Backend b =>
Int -> CombinedSelPermInfo b -> SelPermInfo b
combinedSelPermInfoToSelPermInfo Int
selectPermissionsCount)
(Maybe (CombinedSelPermInfo b) -> Maybe (SelPermInfo b))
-> Maybe (CombinedSelPermInfo b) -> Maybe (SelPermInfo b)
forall a b. (a -> b) -> a -> b
$ CombineRolePermInfo b -> Maybe (CombinedSelPermInfo b)
forall (b :: BackendType).
CombineRolePermInfo b -> Maybe (CombinedSelPermInfo b)
crpiSelPerm CombineRolePermInfo b
combinedParentRolePermInfo
rolePermInfo :: RolePermInfo b
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)
forall a. Maybe a
Nothing Maybe (SelPermInfo b)
roleSelectPermission Maybe (UpdPermInfo b)
forall a. Maybe a
Nothing Maybe (DelPermInfo b)
forall a. Maybe a
Nothing
RolePermInfoMap b -> m (RolePermInfoMap b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RoleName
-> RolePermInfo b -> RolePermInfoMap b -> RolePermInfoMap b
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert RoleName
roleName RolePermInfo b
rolePermInfo RolePermInfoMap b
acc)
RolePermInfoMap b
metadataRolePermissions <-
HashMap RoleName (SelPermDef b)
-> (SelPermDef b -> m (RolePermInfo b)) -> m (RolePermInfoMap b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (InsOrdHashMap RoleName (SelPermDef b)
-> HashMap RoleName (SelPermDef b)
forall k v. InsOrdHashMap k v -> HashMap k v
InsOrdHashMap.toHashMap InsOrdHashMap RoleName (SelPermDef b)
selectPermissions) \SelPermDef b
selectPermission -> do
let role :: RoleName
role :: RoleName
role = SelPermDef b -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole SelPermDef b
selectPermission
sourceObjId :: MetadataObjId
sourceObjId :: MetadataObjId
sourceObjId =
SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
sourceName
(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).
LogicalModelName
-> LogicalModelMetadataObjId -> SourceMetadataObjId b
SMOLogicalModelObj @b LogicalModelName
logicalModelName
(LogicalModelMetadataObjId -> SourceMetadataObjId b)
-> LogicalModelMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ RoleName -> PermType -> LogicalModelMetadataObjId
LMMOPerm RoleName
role PermType
PTSelect
metadataObject :: MetadataObject
metadataObject :: MetadataObject
metadataObject =
MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
sourceObjId
(Value -> MetadataObject) -> Value -> MetadataObject
forall a b. (a -> b) -> a -> b
$ WithLogicalModel (SelPermDef b) -> Value
forall a. ToJSON a => a -> Value
toJSON
WithLogicalModel
{ _wlmSource :: SourceName
_wlmSource = SourceName
sourceName,
_wlmName :: LogicalModelName
_wlmName = LogicalModelName
logicalModelName,
_wlmInfo :: SelPermDef b
_wlmInfo = SelPermDef b
selectPermission
}
schemaObject :: SchemaObjId
schemaObject :: SchemaObjId
schemaObject =
SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
(AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
(SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
LogicalModelName -> LogicalModelObjId b -> SourceObjId b
SOILogicalModelObj @b LogicalModelName
logicalModelName
(LogicalModelObjId b -> SourceObjId b)
-> LogicalModelObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ RoleName -> PermType -> LogicalModelObjId b
forall (b :: BackendType).
RoleName -> PermType -> LogicalModelObjId b
LMOPerm RoleName
role PermType
PTSelect
modifyError :: ExceptT QErr m a -> ExceptT QErr m a
modifyError :: forall a. ExceptT QErr m a -> ExceptT QErr m a
modifyError = (Text -> Text) -> ExceptT QErr m a -> ExceptT QErr m a
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr \Text
err ->
LogicalModelName -> Text -> Text
addLogicalModelContext LogicalModelName
logicalModelName
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"in permission 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
": "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
Maybe (SelPermInfo b)
select <- MetadataObject
-> ExceptT QErr m (SelPermInfo b) -> m (Maybe (SelPermInfo b))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject (ExceptT QErr m (SelPermInfo b) -> m (Maybe (SelPermInfo b)))
-> ExceptT QErr m (SelPermInfo b) -> m (Maybe (SelPermInfo b))
forall a b. (a -> b) -> a -> b
$ ExceptT QErr m (SelPermInfo b) -> ExceptT QErr m (SelPermInfo b)
forall a. ExceptT QErr m a -> ExceptT QErr m a
modifyError do
Bool -> ExceptT QErr m () -> ExceptT QErr m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName)
(ExceptT QErr m () -> ExceptT QErr m ())
-> ExceptT QErr m () -> ExceptT QErr m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> ExceptT QErr m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintViolation Text
"cannot define permission for admin role"
(SelPermInfo b
permissionInformation, Seq SchemaDependency
dependencies) <-
(TableCoreCacheRT
b (ExceptT QErr m) (SelPermInfo b, Seq SchemaDependency)
-> TableCoreCache b
-> ExceptT QErr m (SelPermInfo b, Seq SchemaDependency))
-> TableCoreCache b
-> TableCoreCacheRT
b (ExceptT QErr m) (SelPermInfo b, Seq SchemaDependency)
-> ExceptT QErr m (SelPermInfo b, Seq SchemaDependency)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TableCoreCacheRT
b (ExceptT QErr m) (SelPermInfo b, Seq SchemaDependency)
-> TableCoreCache b
-> ExceptT QErr m (SelPermInfo b, Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *) a.
TableCoreCacheRT b m a -> TableCoreCache b -> m a
runTableCoreCacheRT TableCoreCache b
tableCache
(TableCoreCacheRT
b (ExceptT QErr m) (SelPermInfo b, Seq SchemaDependency)
-> ExceptT QErr m (SelPermInfo b, Seq SchemaDependency))
-> TableCoreCacheRT
b (ExceptT QErr m) (SelPermInfo b, Seq SchemaDependency)
-> ExceptT QErr m (SelPermInfo b, Seq SchemaDependency)
forall a b. (a -> b) -> a -> b
$ SourceName
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> PermDefPermission b SelPerm
-> TableCoreCacheRT
b (ExceptT QErr m) (WithDeps (PermInfo SelPerm b))
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)
logicalModelFields
(PermDefPermission b SelPerm
-> TableCoreCacheRT
b (ExceptT QErr m) (WithDeps (PermInfo SelPerm b)))
-> PermDefPermission b SelPerm
-> TableCoreCacheRT
b (ExceptT QErr m) (WithDeps (PermInfo SelPerm b))
forall a b. (a -> b) -> a -> b
$ SelPermDef b -> PermDefPermission b SelPerm
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> PermDefPermission b perm
_pdPermission SelPermDef b
selectPermission
MetadataObject
-> SchemaObjId -> Seq SchemaDependency -> ExceptT QErr m ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObject Seq SchemaDependency
dependencies
SelPermInfo b -> ExceptT QErr m (SelPermInfo b)
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelPermInfo b
permissionInformation
RolePermInfo b -> m (RolePermInfo b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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)
forall a. Maybe a
Nothing Maybe (SelPermInfo b)
select Maybe (UpdPermInfo b)
forall a. Maybe a
Nothing Maybe (DelPermInfo b)
forall a. Maybe a
Nothing)
(RolePermInfoMap b -> Role -> m (RolePermInfoMap b))
-> RolePermInfoMap b -> [Role] -> m (RolePermInfoMap b)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM RolePermInfoMap b -> Role -> m (RolePermInfoMap b)
combineRolePermissions RolePermInfoMap b
metadataRolePermissions (OrderedRoles -> [Role]
_unOrderedRoles OrderedRoles
orderedRoles)