graphql-engine/server/src-lib/Hasura/RQL/DDL/InheritedRoles.hs
Karthikeyan Chinnakonda 64e2201179 server: enable inherited roles by default
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2325
Co-authored-by: Nicolas Beaussart <7281023+beaussan@users.noreply.github.com>
GitOrigin-RevId: 8ad6fe25a3788892128c1d56b8fa0e8feed2caca
2021-10-05 12:29:32 +00:00

68 lines
2.5 KiB
Haskell

module Hasura.RQL.DDL.InheritedRoles
( runAddInheritedRole,
runDropInheritedRole,
dropInheritedRoleInMetadata,
resolveInheritedRole,
)
where
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashSet qualified as Set
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.Types
import Hasura.Session
runAddInheritedRole ::
( MonadError QErr m,
CacheRWM m,
MetadataM m
) =>
InheritedRole ->
m EncJSON
runAddInheritedRole addInheritedRoleQ@(Role inheritedRoleName (ParentRoles parentRoles)) = do
when (inheritedRoleName `elem` parentRoles) $
throw400 InvalidParams "an inherited role name cannot be in the role combination"
buildSchemaCacheFor (MOInheritedRole inheritedRoleName) $
MetadataModifier $
metaInheritedRoles %~ OMap.insert inheritedRoleName addInheritedRoleQ
pure successMsg
dropInheritedRoleInMetadata :: RoleName -> MetadataModifier
dropInheritedRoleInMetadata roleName =
MetadataModifier $ metaInheritedRoles %~ OMap.delete roleName
runDropInheritedRole ::
(MonadError QErr m, CacheRWM m, MetadataM m) =>
DropInheritedRole ->
m EncJSON
runDropInheritedRole (DropInheritedRole roleName) = do
inheritedRolesMetadata <- _metaInheritedRoles <$> getMetadata
unless (roleName `OMap.member` inheritedRolesMetadata) $
throw400 NotExists $ roleName <<> " inherited role doesn't exist"
buildSchemaCacheFor (MOInheritedRole roleName) (dropInheritedRoleInMetadata roleName)
pure successMsg
-- | `resolveInheritedRole` resolves an inherited role by checking if
-- all the parent roles of an inherited role exists and report
-- the dependencies of the inherited role which will be the list
-- of the parent roles
resolveInheritedRole ::
MonadError QErr m =>
HashSet RoleName ->
InheritedRole ->
m (Role, [SchemaDependency])
resolveInheritedRole allRoles (Role roleName (ParentRoles parentRoles)) = do
let missingParentRoles = Set.filter (`notElem` allRoles) parentRoles
unless (Set.null missingParentRoles) $
let errMessage roles =
"the following parent role(s) are not found: "
<> roles
<> " which are required to construct the inherited role: " <>> roleName
in throw400 NotExists $ errMessage $ commaSeparated $ Set.map roleNameToTxt missingParentRoles
let schemaDependencies =
map (\parentRole -> SchemaDependency (SORole parentRole) DRParentRole) $ toList parentRoles
pure $ (Role roleName $ ParentRoles parentRoles, schemaDependencies)