graphql-engine/server/src-lib/Hasura/RemoteSchema/MetadataAPI/Permission.hs
Antoine Leblanc 306162f477 Remove ServerConfigCtx.
### Description

This PR removes `ServerConfigCtx` and `HasServerConfigCtx`. Instead, it favours different approaches:
- when the code was only using one field, it passes that field explicitly (usually `SQLGenCtx` or `CheckFeatureFlag`)
- when the code was using several fields, but in only one function, it inlines
- for the cache build, it introduces `CacheStaticConfig` and `CacheDynamicConfig`, which are subsets of `AppEnv` and `AppContext` respectively

The main goal of this is to help with the modularization of the engine: as `ServerConfigCtx` had fields whose types were imported from several unrelated parts of the engine, using it tied together parts of the engine that should not be aware of one another (such as tying together `Hasura.LogicalModel` and `Hasura.GraphQL.Schema`).

The bulk of this PR is a change to the cache build, as a follow up to #8509: instead of giving the entire `ServerConfigCtx` as a incremental rule argument, we only give the new `CacheDynamicConfig` struct, which has fewer fields. The other required fields, that were coming from the `AppEnv`, are now given via the `HasCacheStaticConfig` constraint, which is a "subset" of `HasAppEnv`.

(Some further work could include moving `StringifyNumbers` out of `GraphQL.Schema.Options`, given how it is used all across the codebase, including in `RQL.DML`.)

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8513
GitOrigin-RevId: 818cbcd71494e3cd946b06adbb02ca328a8a298e
2023-04-04 16:01:42 +00:00

112 lines
3.7 KiB
Haskell

{-# LANGUAGE TemplateHaskell #-}
module Hasura.RemoteSchema.MetadataAPI.Permission
( AddRemoteSchemaPermission (..),
DropRemoteSchemaPermissions (..),
runDropRemoteSchemaPermissions,
runAddRemoteSchemaPermissions,
)
where
import Control.Lens ((^.))
import Data.Aeson.TH qualified as J
import Data.HashMap.Strict qualified as Map
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RemoteSchema.Metadata
import Hasura.RemoteSchema.SchemaCache.Permission
import Hasura.Session
data AddRemoteSchemaPermission = AddRemoteSchemaPermission
{ _arspRemoteSchema :: RemoteSchemaName,
_arspRole :: RoleName,
_arspDefinition :: RemoteSchemaPermissionDefinition,
_arspComment :: Maybe Text
}
deriving (Show, Eq, Generic)
instance NFData AddRemoteSchemaPermission
$(J.deriveJSON hasuraJSON ''AddRemoteSchemaPermission)
data DropRemoteSchemaPermissions = DropRemoteSchemaPermissions
{ _drspRemoteSchema :: RemoteSchemaName,
_drspRole :: RoleName
}
deriving (Show, Eq, Generic)
instance NFData DropRemoteSchemaPermissions
$(J.deriveJSON hasuraJSON ''DropRemoteSchemaPermissions)
runAddRemoteSchemaPermissions ::
( QErrM m,
CacheRWM m,
MetadataM m
) =>
Options.RemoteSchemaPermissions ->
AddRemoteSchemaPermission ->
m EncJSON
runAddRemoteSchemaPermissions remoteSchemaPermsCtx q = do
metadata <- getMetadata
unless (remoteSchemaPermsCtx == Options.EnableRemoteSchemaPermissions) $ do
throw400 ConstraintViolation $
"remote schema permissions can only be added when "
<> "remote schema permissions are enabled in the graphql-engine"
remoteSchemaMap <- scRemoteSchemas <$> askSchemaCache
remoteSchemaCtx <-
onNothing (Map.lookup name remoteSchemaMap) $
throw400 NotExists $
"remote schema " <> name <<> " doesn't exist"
when (doesRemoteSchemaPermissionExist metadata name role) $
throw400 AlreadyExists $
"permissions for role: "
<> role <<> " for remote schema:"
<> name <<> " already exists"
void $ resolveRoleBasedRemoteSchema role name (_rscIntroOriginal remoteSchemaCtx) providedSchemaDoc
buildSchemaCacheFor (MORemoteSchemaPermissions name role) $
MetadataModifier $
metaRemoteSchemas . ix name . rsmPermissions %~ (:) remoteSchemaPermMeta
pure successMsg
where
AddRemoteSchemaPermission name role defn comment = q
remoteSchemaPermMeta = RemoteSchemaPermissionMetadata role defn comment
providedSchemaDoc = _rspdSchema defn
doesRemoteSchemaPermissionExist :: Metadata -> RemoteSchemaName -> RoleName -> Bool
doesRemoteSchemaPermissionExist metadata remoteSchemaName roleName =
any ((== roleName) . _rspmRole) $ metadata ^. (metaRemoteSchemas . ix remoteSchemaName . rsmPermissions)
runDropRemoteSchemaPermissions ::
( QErrM m,
CacheRWM m,
MetadataM m
) =>
DropRemoteSchemaPermissions ->
m EncJSON
runDropRemoteSchemaPermissions (DropRemoteSchemaPermissions name roleName) = do
metadata <- getMetadata
remoteSchemaMap <- scRemoteSchemas <$> askSchemaCache
void $
onNothing (Map.lookup name remoteSchemaMap) $
throw400 NotExists $
"remote schema " <> name <<> " doesn't exist"
unless (doesRemoteSchemaPermissionExist metadata name roleName) $
throw400 NotExists $
"permissions for role: "
<> roleName <<> " for remote schema:"
<> name <<> " doesn't exist"
buildSchemaCacheFor (MORemoteSchemaPermissions name roleName) $
dropRemoteSchemaPermissionInMetadata name roleName
pure successMsg