module Hasura.RQL.DDL.InheritedRoles
  ( runAddInheritedRole,
    runDropInheritedRole,
    dropInheritedRoleInMetadata,
    resolveInheritedRole,
  )
where

import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashSet qualified as Set
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build

runAddInheritedRole ::
  ( MonadError QErr m,
    CacheRWM m,
    MetadataM m
  ) =>
  InheritedRole ->
  m EncJSON
runAddInheritedRole :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m) =>
InheritedRole -> m EncJSON
runAddInheritedRole addInheritedRoleQ :: InheritedRole
addInheritedRoleQ@(Role RoleName
inheritedRoleName (ParentRoles HashSet RoleName
parentRoles)) = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RoleName
inheritedRoleName RoleName -> HashSet RoleName -> Bool
forall a. Eq a => a -> HashSet a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HashSet RoleName
parentRoles)
    (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
InvalidParams Text
"an inherited role name cannot be in the role combination"
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (RoleName -> MetadataObjId
MOInheritedRole RoleName
inheritedRoleName)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (InheritedRoles -> Identity InheritedRoles)
-> Metadata -> Identity Metadata
Lens' Metadata InheritedRoles
metaInheritedRoles
    ((InheritedRoles -> Identity InheritedRoles)
 -> Metadata -> Identity Metadata)
-> (InheritedRoles -> InheritedRoles) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName -> InheritedRole -> InheritedRoles -> InheritedRoles
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert RoleName
inheritedRoleName InheritedRole
addInheritedRoleQ
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

dropInheritedRoleInMetadata :: RoleName -> MetadataModifier
dropInheritedRoleInMetadata :: RoleName -> MetadataModifier
dropInheritedRoleInMetadata RoleName
roleName =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (InheritedRoles -> Identity InheritedRoles)
-> Metadata -> Identity Metadata
Lens' Metadata InheritedRoles
metaInheritedRoles ((InheritedRoles -> Identity InheritedRoles)
 -> Metadata -> Identity Metadata)
-> (InheritedRoles -> InheritedRoles) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName -> InheritedRoles -> InheritedRoles
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RoleName
roleName

runDropInheritedRole ::
  (MonadError QErr m, CacheRWM m, MetadataM m) =>
  DropInheritedRole ->
  m EncJSON
runDropInheritedRole :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m) =>
DropInheritedRole -> m EncJSON
runDropInheritedRole (DropInheritedRole RoleName
roleName) = do
  InheritedRoles
inheritedRolesMetadata <- Metadata -> InheritedRoles
_metaInheritedRoles (Metadata -> InheritedRoles) -> m Metadata -> m InheritedRoles
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RoleName
roleName RoleName -> InheritedRoles -> Bool
forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
`InsOrdHashMap.member` InheritedRoles
inheritedRolesMetadata)
    (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
NotExists
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ RoleName
roleName
    RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" inherited role doesn't exist"
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (RoleName -> MetadataObjId
MOInheritedRole RoleName
roleName) (RoleName -> MetadataModifier
dropInheritedRoleInMetadata RoleName
roleName)
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
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, Seq SchemaDependency)
resolveInheritedRole :: forall (m :: * -> *).
MonadError QErr m =>
HashSet RoleName
-> InheritedRole -> m (InheritedRole, Seq SchemaDependency)
resolveInheritedRole HashSet RoleName
allRoles (Role RoleName
roleName (ParentRoles HashSet RoleName
parentRoles)) = do
  let missingParentRoles :: HashSet RoleName
missingParentRoles = (RoleName -> Bool) -> HashSet RoleName -> HashSet RoleName
forall a. (a -> Bool) -> HashSet a -> HashSet a
Set.filter (RoleName -> HashSet RoleName -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` HashSet RoleName
allRoles) HashSet RoleName
parentRoles
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet RoleName -> Bool
forall a. HashSet a -> Bool
Set.null HashSet RoleName
missingParentRoles)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ let errMessage :: Text -> Text
errMessage Text
roles =
            Text
"the following parent role(s) are not found: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
roles
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" which are required to construct the inherited role: "
              Text -> RoleName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RoleName
roleName
       in Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMessage (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HashSet Text -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated (HashSet Text -> Text) -> HashSet Text -> Text
forall a b. (a -> b) -> a -> b
$ (RoleName -> Text) -> HashSet RoleName -> HashSet Text
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
Set.map RoleName -> Text
roleNameToTxt HashSet RoleName
missingParentRoles
  let schemaDependencies :: Seq SchemaDependency
schemaDependencies =
        (RoleName -> SchemaDependency)
-> Seq RoleName -> Seq SchemaDependency
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RoleName
parentRole -> SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency (RoleName -> SchemaObjId
SORole RoleName
parentRole) DependencyReason
DRParentRole) ([RoleName] -> Seq RoleName
forall a. [a] -> Seq a
Seq.fromList (HashSet RoleName -> [RoleName]
forall a. HashSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet RoleName
parentRoles))
  (InheritedRole, Seq SchemaDependency)
-> m (InheritedRole, Seq SchemaDependency)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((InheritedRole, Seq SchemaDependency)
 -> m (InheritedRole, Seq SchemaDependency))
-> (InheritedRole, Seq SchemaDependency)
-> m (InheritedRole, Seq SchemaDependency)
forall a b. (a -> b) -> a -> b
$ (RoleName -> ParentRoles -> InheritedRole
Role RoleName
roleName (ParentRoles -> InheritedRole) -> ParentRoles -> InheritedRole
forall a b. (a -> b) -> a -> b
$ HashSet RoleName -> ParentRoles
ParentRoles HashSet RoleName
parentRoles, Seq SchemaDependency
schemaDependencies)