mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 09:22:43 +03:00
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
This commit is contained in:
parent
794690f30c
commit
306162f477
@ -881,6 +881,7 @@ library
|
||||
, Hasura.RQL.DDL.Schema
|
||||
, Hasura.RQL.DDL.Schema.Cache
|
||||
, Hasura.RQL.DDL.Schema.Cache.Common
|
||||
, Hasura.RQL.DDL.Schema.Cache.Config
|
||||
, Hasura.RQL.DDL.Schema.Cache.Dependencies
|
||||
, Hasura.RQL.DDL.Schema.Cache.Fields
|
||||
, Hasura.RQL.DDL.Schema.Cache.Permission
|
||||
|
@ -122,6 +122,7 @@ import Hasura.RQL.DDL.ApiLimit (MonadGetApiTimeLimit (..))
|
||||
import Hasura.RQL.DDL.EventTrigger (MonadEventLogCleanup (..))
|
||||
import Hasura.RQL.DDL.Schema.Cache
|
||||
import Hasura.RQL.DDL.Schema.Cache.Common
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.DDL.Schema.Catalog
|
||||
import Hasura.RQL.Types.Allowlist
|
||||
import Hasura.RQL.Types.Backend
|
||||
@ -500,21 +501,18 @@ initialiseAppContext ::
|
||||
AppInit ->
|
||||
m (AppStateRef Hasura)
|
||||
initialiseAppContext env serveOptions@ServeOptions {..} AppInit {..} = do
|
||||
AppEnv {..} <- askAppEnv
|
||||
appEnv@AppEnv {..} <- askAppEnv
|
||||
let Loggers _ logger pgLogger = appEnvLoggers
|
||||
sqlGenCtx = initSQLGenCtx soExperimentalFeatures soStringifyNum soDangerousBooleanCollapse
|
||||
serverConfigCtx =
|
||||
ServerConfigCtx
|
||||
cacheStaticConfig = buildCacheStaticConfig appEnv
|
||||
cacheDynamicConfig =
|
||||
CacheDynamicConfig
|
||||
soInferFunctionPermissions
|
||||
soEnableRemoteSchemaPermissions
|
||||
sqlGenCtx
|
||||
soEnableMaintenanceMode
|
||||
soExperimentalFeatures
|
||||
soEventingMode
|
||||
soReadOnlyMode
|
||||
soDefaultNamingConvention
|
||||
soMetadataDefaults
|
||||
(CheckFeatureFlag $ checkFeatureFlag env)
|
||||
soApolloFederationStatus
|
||||
|
||||
-- Create the schema cache
|
||||
@ -522,10 +520,11 @@ initialiseAppContext env serveOptions@ServeOptions {..} AppInit {..} = do
|
||||
buildFirstSchemaCache
|
||||
env
|
||||
logger
|
||||
serverConfigCtx
|
||||
(mkPgSourceResolver pgLogger)
|
||||
mkMSSQLSourceResolver
|
||||
aiMetadataWithResourceVersion
|
||||
cacheStaticConfig
|
||||
cacheDynamicConfig
|
||||
appEnvManager
|
||||
|
||||
-- Build the RebuildableAppContext.
|
||||
@ -589,26 +588,28 @@ buildFirstSchemaCache ::
|
||||
(MonadIO m) =>
|
||||
Env.Environment ->
|
||||
Logger Hasura ->
|
||||
ServerConfigCtx ->
|
||||
SourceResolver ('Postgres 'Vanilla) ->
|
||||
SourceResolver ('MSSQL) ->
|
||||
MetadataWithResourceVersion ->
|
||||
CacheStaticConfig ->
|
||||
CacheDynamicConfig ->
|
||||
HTTP.Manager ->
|
||||
m RebuildableSchemaCache
|
||||
buildFirstSchemaCache
|
||||
env
|
||||
logger
|
||||
serverConfigCtx
|
||||
pgSourceResolver
|
||||
mssqlSourceResolver
|
||||
metadataWithVersion
|
||||
cacheStaticConfig
|
||||
cacheDynamicConfig
|
||||
httpManager = do
|
||||
let cacheBuildParams = CacheBuildParams httpManager pgSourceResolver mssqlSourceResolver
|
||||
let cacheBuildParams = CacheBuildParams httpManager pgSourceResolver mssqlSourceResolver cacheStaticConfig
|
||||
buildReason = CatalogSync
|
||||
result <-
|
||||
runExceptT $
|
||||
runCacheBuild cacheBuildParams $
|
||||
buildRebuildableSchemaCacheWithReason buildReason logger env metadataWithVersion serverConfigCtx
|
||||
buildRebuildableSchemaCacheWithReason buildReason logger env metadataWithVersion cacheDynamicConfig
|
||||
result `onLeft` \err -> do
|
||||
-- TODO: we used to bundle the first schema cache build with the catalog
|
||||
-- migration, using the same error handler for both, meaning that an
|
||||
@ -665,6 +666,14 @@ runAppM c (AppM a) = ignoreTraceT $ runReaderT a c
|
||||
instance HasAppEnv AppM where
|
||||
askAppEnv = ask
|
||||
|
||||
instance HasFeatureFlagChecker AppM where
|
||||
checkFlag f = AppM do
|
||||
CheckFeatureFlag runCheckFeatureFlag <- asks appEnvCheckFeatureFlag
|
||||
liftIO $ runCheckFeatureFlag f
|
||||
|
||||
instance HasCacheStaticConfig AppM where
|
||||
askCacheStaticConfig = buildCacheStaticConfig <$> askAppEnv
|
||||
|
||||
instance MonadTrace AppM where
|
||||
newTraceWith c p n (AppM a) = AppM $ newTraceWith c p n a
|
||||
newSpanWith i n (AppM a) = AppM $ newSpanWith i n a
|
||||
@ -879,6 +888,8 @@ runHGEServer ::
|
||||
UserAuthentication m,
|
||||
HttpLog m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
HasFeatureFlagChecker m,
|
||||
ConsoleRenderer m,
|
||||
MonadVersionAPIWithExtraData m,
|
||||
MonadMetadataApiAuthorization m,
|
||||
@ -971,6 +982,8 @@ mkHGEServer ::
|
||||
UserAuthentication m,
|
||||
HttpLog m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
HasFeatureFlagChecker m,
|
||||
ConsoleRenderer m,
|
||||
MonadVersionAPIWithExtraData m,
|
||||
MonadMetadataApiAuthorization m,
|
||||
|
@ -13,10 +13,11 @@ module Hasura.App.State
|
||||
-- * init functions
|
||||
buildRebuildableAppContext,
|
||||
rebuildRebuildableAppContext,
|
||||
initSQLGenCtx,
|
||||
|
||||
-- * server config
|
||||
buildServerConfigCtx,
|
||||
-- * subsets
|
||||
initSQLGenCtx,
|
||||
buildCacheStaticConfig,
|
||||
buildCacheDynamicConfig,
|
||||
)
|
||||
where
|
||||
|
||||
@ -36,6 +37,7 @@ import Hasura.GraphQL.Schema.Options qualified as Options
|
||||
import Hasura.Incremental qualified as Inc
|
||||
import Hasura.Logging qualified as L
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.Metadata
|
||||
import Hasura.RQL.Types.SchemaCache (MetadataResourceVersion)
|
||||
@ -300,6 +302,9 @@ buildAppContextRule = proc (ServeOptions {..}, env, _keys) -> do
|
||||
| otherwise -> InternalErrorsDisabled
|
||||
returnA -< responseInternalErrorsConfig
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- subsets
|
||||
|
||||
initSQLGenCtx :: HashSet ExperimentalFeature -> Options.StringifyNumbers -> Options.DangerouslyCollapseBooleans -> SQLGenCtx
|
||||
initSQLGenCtx experimentalFeatures stringifyNum dangerousBooleanCollapse =
|
||||
let optimizePermissionFilters
|
||||
@ -311,26 +316,23 @@ initSQLGenCtx experimentalFeatures stringifyNum dangerousBooleanCollapse =
|
||||
| otherwise = Options.DisableBigQueryStringNumericInput
|
||||
in SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters bigqueryStringNumericInput
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- server config
|
||||
|
||||
-- | We are trying to slowly get rid of 'HasServerConfigCtx' (and consequently
|
||||
-- of 'ServercConfigtx') in favour of smaller / more specific ad-hoc
|
||||
-- types. However, in the meantime, it is often required to builda
|
||||
-- 'ServerConfigCtx' at the boundary between parts of the code that use it and
|
||||
-- part of the code that use the new 'AppEnv' and 'AppContext'.
|
||||
buildServerConfigCtx :: AppEnv -> AppContext -> ServerConfigCtx
|
||||
buildServerConfigCtx AppEnv {..} AppContext {..} =
|
||||
ServerConfigCtx
|
||||
{ _sccFunctionPermsCtx = acFunctionPermsCtx,
|
||||
_sccRemoteSchemaPermsCtx = acRemoteSchemaPermsCtx,
|
||||
_sccSQLGenCtx = acSQLGenCtx,
|
||||
_sccMaintenanceMode = appEnvEnableMaintenanceMode,
|
||||
_sccExperimentalFeatures = acExperimentalFeatures,
|
||||
_sccEventingMode = appEnvEventingMode,
|
||||
_sccReadOnlyMode = appEnvEnableReadOnlyMode,
|
||||
_sccDefaultNamingConvention = acDefaultNamingConvention,
|
||||
_sccMetadataDefaults = acMetadataDefaults,
|
||||
_sccCheckFeatureFlag = appEnvCheckFeatureFlag,
|
||||
_sccApolloFederationStatus = acApolloFederationStatus
|
||||
buildCacheStaticConfig :: AppEnv -> CacheStaticConfig
|
||||
buildCacheStaticConfig AppEnv {..} =
|
||||
CacheStaticConfig
|
||||
{ _cscMaintenanceMode = appEnvEnableMaintenanceMode,
|
||||
_cscEventingMode = appEnvEventingMode,
|
||||
_cscReadOnlyMode = appEnvEnableReadOnlyMode,
|
||||
_cscCheckFeatureFlag = appEnvCheckFeatureFlag
|
||||
}
|
||||
|
||||
buildCacheDynamicConfig :: AppContext -> CacheDynamicConfig
|
||||
buildCacheDynamicConfig AppContext {..} =
|
||||
CacheDynamicConfig
|
||||
{ _cdcFunctionPermsCtx = acFunctionPermsCtx,
|
||||
_cdcRemoteSchemaPermsCtx = acRemoteSchemaPermsCtx,
|
||||
_cdcSQLGenCtx = acSQLGenCtx,
|
||||
_cdcExperimentalFeatures = acExperimentalFeatures,
|
||||
_cdcDefaultNamingConvention = acDefaultNamingConvention,
|
||||
_cdcMetadataDefaults = acMetadataDefaults,
|
||||
_cdcApolloFederationStatus = acApolloFederationStatus
|
||||
}
|
||||
|
@ -214,7 +214,7 @@ dropDanglingSQLTrigger sourceConfig triggerName table ops =
|
||||
|
||||
createTableEventTrigger ::
|
||||
MonadIO m =>
|
||||
ServerConfigCtx ->
|
||||
SQLGenCtx ->
|
||||
MSSQLSourceConfig ->
|
||||
TableName ->
|
||||
[ColumnInfo 'MSSQL] ->
|
||||
@ -223,7 +223,7 @@ createTableEventTrigger ::
|
||||
TriggerOpsDef 'MSSQL ->
|
||||
Maybe (PrimaryKey 'MSSQL (ColumnInfo 'MSSQL)) ->
|
||||
m (Either QErr ())
|
||||
createTableEventTrigger _serverConfigCtx sourceConfig table columns triggerName triggerOnReplication opsDefinition primaryKeyMaybe = do
|
||||
createTableEventTrigger _sqlGen sourceConfig table columns triggerName triggerOnReplication opsDefinition primaryKeyMaybe = do
|
||||
liftIO $
|
||||
runMSSQLSourceWriteTx sourceConfig $ do
|
||||
mkAllTriggersQ triggerName table triggerOnReplication columns opsDefinition primaryKeyMaybe
|
||||
@ -233,7 +233,7 @@ createMissingSQLTriggers ::
|
||||
MonadError QErr m,
|
||||
MonadBaseControl IO m
|
||||
) =>
|
||||
ServerConfigCtx ->
|
||||
SQLGenCtx ->
|
||||
MSSQLSourceConfig ->
|
||||
TableName ->
|
||||
([ColumnInfo 'MSSQL], Maybe (PrimaryKey 'MSSQL (ColumnInfo 'MSSQL))) ->
|
||||
|
@ -205,7 +205,7 @@ createMissingSQLTriggers ::
|
||||
MonadBaseControl IO m,
|
||||
Backend ('Postgres pgKind)
|
||||
) =>
|
||||
ServerConfigCtx ->
|
||||
SQLGenCtx ->
|
||||
PGSourceConfig ->
|
||||
TableName ('Postgres pgKind) ->
|
||||
([(ColumnInfo ('Postgres pgKind))], Maybe (PrimaryKey ('Postgres pgKind) (ColumnInfo ('Postgres pgKind)))) ->
|
||||
@ -241,7 +241,7 @@ createMissingSQLTriggers serverConfigCtx sourceConfig table (allCols, _) trigger
|
||||
|
||||
createTableEventTrigger ::
|
||||
(Backend ('Postgres pgKind), MonadIO m, MonadBaseControl IO m) =>
|
||||
ServerConfigCtx ->
|
||||
SQLGenCtx ->
|
||||
PGSourceConfig ->
|
||||
QualifiedTable ->
|
||||
[ColumnInfo ('Postgres pgKind)] ->
|
||||
@ -674,7 +674,7 @@ pgIdenTrigger op = QualifiedTriggerName . pgFmtIdentifier . unQualifiedTriggerNa
|
||||
-- | Define the pgSQL trigger functions on database events.
|
||||
mkTriggerFunctionQ ::
|
||||
forall pgKind m.
|
||||
(Backend ('Postgres pgKind), MonadTx m, MonadReader ServerConfigCtx m) =>
|
||||
(Backend ('Postgres pgKind), MonadTx m, MonadReader SQLGenCtx m) =>
|
||||
TriggerName ->
|
||||
QualifiedTable ->
|
||||
[ColumnInfo ('Postgres pgKind)] ->
|
||||
@ -682,7 +682,7 @@ mkTriggerFunctionQ ::
|
||||
SubscribeOpSpec ('Postgres pgKind) ->
|
||||
m QualifiedTriggerName
|
||||
mkTriggerFunctionQ triggerName (QualifiedObject schema table) allCols op (SubscribeOpSpec listenColumns deliveryColumns') = do
|
||||
strfyNum <- stringifyNum . _sccSQLGenCtx <$> ask
|
||||
strfyNum <- asks stringifyNum
|
||||
let dbQualifiedTriggerName = pgIdenTrigger op triggerName
|
||||
() <-
|
||||
liftTx $
|
||||
@ -795,7 +795,7 @@ checkIfFunctionExistsQ triggerName op = do
|
||||
|
||||
mkTrigger ::
|
||||
forall pgKind m.
|
||||
(Backend ('Postgres pgKind), MonadTx m, MonadReader ServerConfigCtx m) =>
|
||||
(Backend ('Postgres pgKind), MonadTx m, MonadReader SQLGenCtx m) =>
|
||||
TriggerName ->
|
||||
QualifiedTable ->
|
||||
TriggerOnReplication ->
|
||||
@ -830,7 +830,7 @@ mkTrigger triggerName table triggerOnReplication allCols op subOpSpec = do
|
||||
|
||||
mkAllTriggersQ ::
|
||||
forall pgKind m.
|
||||
(Backend ('Postgres pgKind), MonadTx m, MonadReader ServerConfigCtx m) =>
|
||||
(Backend ('Postgres pgKind), MonadTx m, MonadReader SQLGenCtx m) =>
|
||||
TriggerName ->
|
||||
QualifiedTable ->
|
||||
TriggerOnReplication ->
|
||||
|
@ -59,7 +59,6 @@ import Hasura.RQL.Types.Source
|
||||
import Hasura.RQL.Types.Table
|
||||
import Hasura.SQL.AnyBackend qualified as AB
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Server.Utils (quoteRegex)
|
||||
import Hasura.Session
|
||||
import Hasura.Tracing qualified as Tracing
|
||||
@ -207,7 +206,6 @@ runRunSQL ::
|
||||
FetchTableMetadata pgKind,
|
||||
FetchFunctionMetadata pgKind,
|
||||
CacheRWM m,
|
||||
HasServerConfigCtx m,
|
||||
MetadataM m,
|
||||
MonadBaseControl IO m,
|
||||
MonadError QErr m,
|
||||
@ -215,9 +213,10 @@ runRunSQL ::
|
||||
Tracing.MonadTrace m,
|
||||
UserInfoM m
|
||||
) =>
|
||||
SQLGenCtx ->
|
||||
RunSQL ->
|
||||
m EncJSON
|
||||
runRunSQL q@RunSQL {..} = do
|
||||
runRunSQL sqlGen q@RunSQL {..} = do
|
||||
sourceConfig <- askSourceConfig @('Postgres pgKind) rSource
|
||||
traceCtx <- Tracing.currentContext
|
||||
userInfo <- askUserInfo
|
||||
@ -225,7 +224,7 @@ runRunSQL q@RunSQL {..} = do
|
||||
if (isSchemaCacheBuildRequiredRunSQL q)
|
||||
then do
|
||||
-- see Note [Checking metadata consistency in run_sql]
|
||||
withMetadataCheck @pgKind rSource rCascade rTxAccessMode $
|
||||
withMetadataCheck @pgKind sqlGen rSource rCascade rTxAccessMode $
|
||||
withTraceContext traceCtx $
|
||||
withUserInfo userInfo $
|
||||
execRawSQL rSql
|
||||
@ -250,18 +249,18 @@ withMetadataCheck ::
|
||||
FetchTableMetadata pgKind,
|
||||
FetchFunctionMetadata pgKind,
|
||||
CacheRWM m,
|
||||
HasServerConfigCtx m,
|
||||
MetadataM m,
|
||||
MonadBaseControl IO m,
|
||||
MonadError QErr m,
|
||||
MonadIO m
|
||||
) =>
|
||||
SQLGenCtx ->
|
||||
SourceName ->
|
||||
Bool ->
|
||||
PG.TxAccess ->
|
||||
PG.TxET QErr m a ->
|
||||
m a
|
||||
withMetadataCheck source cascade txAccess runSQLQuery = do
|
||||
withMetadataCheck sqlGen source cascade txAccess runSQLQuery = do
|
||||
SourceInfo _ tableCache functionCache _logicalModels _customReturnTypes sourceConfig _ _ <- askSourceInfo @('Postgres pgKind) source
|
||||
|
||||
-- Run SQL query and metadata checker in a transaction
|
||||
@ -281,14 +280,14 @@ withMetadataCheck source cascade txAccess runSQLQuery = do
|
||||
recreateEventTriggers :: PGSourceConfig -> SchemaCache -> m ()
|
||||
recreateEventTriggers sourceConfig schemaCache = do
|
||||
let tables = fromMaybe mempty $ unsafeTableCache @('Postgres pgKind) source $ scSources schemaCache
|
||||
serverConfigCtx <- askServerConfigCtx
|
||||
liftEitherM $
|
||||
runPgSourceWriteTx sourceConfig RunSQLQuery $
|
||||
forM_ (M.elems tables) $ \(TableInfo coreInfo _ eventTriggers _) -> do
|
||||
let table = _tciName coreInfo
|
||||
columns = getCols $ _tciFieldInfoMap coreInfo
|
||||
forM_ (M.toList eventTriggers) $ \(triggerName, EventTriggerInfo {etiOpsDef, etiTriggerOnReplication}) -> do
|
||||
flip runReaderT serverConfigCtx $ mkAllTriggersQ triggerName table etiTriggerOnReplication columns etiOpsDef
|
||||
flip runReaderT sqlGen $
|
||||
mkAllTriggersQ triggerName table etiTriggerOnReplication columns etiOpsDef
|
||||
|
||||
-- | @'runTxWithMetadataCheck source sourceConfig txAccess tableCache functionCache cascadeDependencies tx' checks for
|
||||
-- changes in GraphQL Engine metadata when a @'tx' is executed on the database alters Postgres
|
||||
|
@ -42,8 +42,8 @@ import Hasura.RQL.Types.Permission (PermDef (_pdRole), SelPerm)
|
||||
import Hasura.RQL.Types.SchemaCache.Build
|
||||
import Hasura.SQL.AnyBackend qualified as AB
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.Server.Init.FeatureFlag as FF
|
||||
import Hasura.Server.Types (HasServerConfigCtx (..), ServerConfigCtx (..))
|
||||
import Hasura.Server.Init.FeatureFlag (HasFeatureFlagChecker (..))
|
||||
import Hasura.Server.Init.FeatureFlag qualified as FF
|
||||
import Hasura.Session (RoleName)
|
||||
|
||||
-- | Default implementation of the 'track_custom_return_type' request payload.
|
||||
@ -122,8 +122,7 @@ runGetCustomReturnType ::
|
||||
forall b m.
|
||||
( BackendMetadata b,
|
||||
MetadataM m,
|
||||
HasServerConfigCtx m,
|
||||
MonadIO m,
|
||||
HasFeatureFlagChecker m,
|
||||
MonadError QErr m
|
||||
) =>
|
||||
GetCustomReturnType b ->
|
||||
@ -151,8 +150,7 @@ runTrackCustomReturnType ::
|
||||
CacheRWM m,
|
||||
MetadataM m,
|
||||
MonadError QErr m,
|
||||
HasServerConfigCtx m,
|
||||
MonadIO m
|
||||
HasFeatureFlagChecker m
|
||||
) =>
|
||||
TrackCustomReturnType b ->
|
||||
m EncJSON
|
||||
@ -273,7 +271,7 @@ instance
|
||||
|
||||
runCreateSelectCustomReturnTypePermission ::
|
||||
forall b m.
|
||||
(Backend b, CacheRWM m, MetadataM m, MonadError QErr m, MonadIO m, HasServerConfigCtx m) =>
|
||||
(Backend b, CacheRWM m, MetadataM m, MonadError QErr m, HasFeatureFlagChecker m) =>
|
||||
CreateCustomReturnTypePermission SelPerm b ->
|
||||
m EncJSON
|
||||
runCreateSelectCustomReturnTypePermission CreateCustomReturnTypePermission {..} = do
|
||||
@ -312,7 +310,7 @@ instance FromJSON (DropCustomReturnTypePermission b) where
|
||||
|
||||
runDropSelectCustomReturnTypePermission ::
|
||||
forall b m.
|
||||
(Backend b, CacheRWM m, MetadataM m, MonadError QErr m, MonadIO m, HasServerConfigCtx m) =>
|
||||
(Backend b, CacheRWM m, MetadataM m, MonadError QErr m, HasFeatureFlagChecker m) =>
|
||||
DropCustomReturnTypePermission b ->
|
||||
m EncJSON
|
||||
runDropSelectCustomReturnTypePermission DropCustomReturnTypePermission {..} = do
|
||||
@ -340,14 +338,10 @@ dropCustomReturnTypeInMetadata source name = do
|
||||
%~ OMap.delete name
|
||||
|
||||
-- | check feature flag is enabled before carrying out any actions
|
||||
throwIfFeatureDisabled :: (HasServerConfigCtx m, MonadIO m, MonadError QErr m) => m ()
|
||||
throwIfFeatureDisabled :: (HasFeatureFlagChecker m, MonadError QErr m) => m ()
|
||||
throwIfFeatureDisabled = do
|
||||
configCtx <- askServerConfigCtx
|
||||
let CheckFeatureFlag runCheckFeatureFlag = _sccCheckFeatureFlag configCtx
|
||||
|
||||
enableCustomReturnTypes <- liftIO (runCheckFeatureFlag FF.logicalModelInterface)
|
||||
|
||||
unless enableCustomReturnTypes (throw500 "CustomReturnTypes is disabled!")
|
||||
enableCustomReturnTypes <- checkFlag FF.logicalModelInterface
|
||||
unless enableCustomReturnTypes $ throw500 "CustomReturnTypes is disabled!"
|
||||
|
||||
-- | Check whether a custom return type with the given root field name exists for
|
||||
-- the given source.
|
||||
|
@ -97,7 +97,11 @@ buildGQLContext ::
|
||||
( MonadError QErr m,
|
||||
MonadIO m
|
||||
) =>
|
||||
ServerConfigCtx ->
|
||||
Options.InferFunctionPermissions ->
|
||||
Options.RemoteSchemaPermissions ->
|
||||
HashSet ExperimentalFeature ->
|
||||
SQLGenCtx ->
|
||||
ApolloFederationStatus ->
|
||||
SourceCache ->
|
||||
HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject) ->
|
||||
ActionCache ->
|
||||
@ -114,66 +118,75 @@ buildGQLContext ::
|
||||
GQLContext
|
||||
)
|
||||
)
|
||||
buildGQLContext ServerConfigCtx {..} sources allRemoteSchemas allActions customTypes = do
|
||||
let remoteSchemasRoles = concatMap (Map.keys . _rscPermissions . fst . snd) $ Map.toList allRemoteSchemas
|
||||
actionRoles =
|
||||
Set.insert adminRoleName $
|
||||
Set.fromList (allActionInfos ^.. folded . aiPermissions . to Map.keys . folded)
|
||||
<> Set.fromList (bool mempty remoteSchemasRoles $ _sccRemoteSchemaPermsCtx == Options.EnableRemoteSchemaPermissions)
|
||||
allActionInfos = Map.elems allActions
|
||||
allTableRoles = Set.fromList $ getTableRoles =<< Map.elems sources
|
||||
allCustomReturnTypeRoles = Set.fromList $ getCustomReturnTypeRoles =<< Map.elems sources
|
||||
allRoles = actionRoles <> allTableRoles <> allCustomReturnTypeRoles
|
||||
buildGQLContext
|
||||
functionPermissions
|
||||
remoteSchemaPermissions
|
||||
experimentalFeatures
|
||||
sqlGen
|
||||
apolloFederationStatus
|
||||
sources
|
||||
allRemoteSchemas
|
||||
allActions
|
||||
customTypes = do
|
||||
let remoteSchemasRoles = concatMap (Map.keys . _rscPermissions . fst . snd) $ Map.toList allRemoteSchemas
|
||||
actionRoles =
|
||||
Set.insert adminRoleName $
|
||||
Set.fromList (allActionInfos ^.. folded . aiPermissions . to Map.keys . folded)
|
||||
<> Set.fromList (bool mempty remoteSchemasRoles $ remoteSchemaPermissions == Options.EnableRemoteSchemaPermissions)
|
||||
allActionInfos = Map.elems allActions
|
||||
allTableRoles = Set.fromList $ getTableRoles =<< Map.elems sources
|
||||
allCustomReturnTypeRoles = Set.fromList $ getCustomReturnTypeRoles =<< Map.elems sources
|
||||
allRoles = actionRoles <> allTableRoles <> allCustomReturnTypeRoles
|
||||
|
||||
contexts <-
|
||||
-- Buld role contexts in parallel. We'd prefer deterministic parallelism
|
||||
-- but that isn't really acheivable (see mono #3829). NOTE: the admin role
|
||||
-- will still be a bottleneck here, even on huge_schema which has many
|
||||
-- roles.
|
||||
fmap Map.fromList $
|
||||
forConcurrentlyEIO 10 (Set.toList allRoles) $ \role -> do
|
||||
(role,)
|
||||
<$> concurrentlyEIO
|
||||
( buildRoleContext
|
||||
(_sccSQLGenCtx, _sccFunctionPermsCtx)
|
||||
sources
|
||||
allRemoteSchemas
|
||||
allActionInfos
|
||||
customTypes
|
||||
role
|
||||
_sccRemoteSchemaPermsCtx
|
||||
_sccExperimentalFeatures
|
||||
_sccApolloFederationStatus
|
||||
)
|
||||
( buildRelayRoleContext
|
||||
(_sccSQLGenCtx, _sccFunctionPermsCtx)
|
||||
sources
|
||||
allActionInfos
|
||||
customTypes
|
||||
role
|
||||
_sccExperimentalFeatures
|
||||
)
|
||||
let hasuraContexts = fst <$> contexts
|
||||
relayContexts = snd <$> contexts
|
||||
contexts <-
|
||||
-- Buld role contexts in parallel. We'd prefer deterministic parallelism
|
||||
-- but that isn't really acheivable (see mono #3829). NOTE: the admin role
|
||||
-- will still be a bottleneck here, even on huge_schema which has many
|
||||
-- roles.
|
||||
fmap Map.fromList $
|
||||
forConcurrentlyEIO 10 (Set.toList allRoles) $ \role -> do
|
||||
(role,)
|
||||
<$> concurrentlyEIO
|
||||
( buildRoleContext
|
||||
(sqlGen, functionPermissions)
|
||||
sources
|
||||
allRemoteSchemas
|
||||
allActionInfos
|
||||
customTypes
|
||||
role
|
||||
remoteSchemaPermissions
|
||||
experimentalFeatures
|
||||
apolloFederationStatus
|
||||
)
|
||||
( buildRelayRoleContext
|
||||
(sqlGen, functionPermissions)
|
||||
sources
|
||||
allActionInfos
|
||||
customTypes
|
||||
role
|
||||
experimentalFeatures
|
||||
)
|
||||
let hasuraContexts = fst <$> contexts
|
||||
relayContexts = snd <$> contexts
|
||||
|
||||
adminIntrospection <-
|
||||
case Map.lookup adminRoleName hasuraContexts of
|
||||
Just (_context, _errors, introspection) -> pure introspection
|
||||
Nothing -> throw500 "buildGQLContext failed to build for the admin role"
|
||||
(unauthenticated, unauthenticatedRemotesErrors) <- unauthenticatedContext allRemoteSchemas _sccRemoteSchemaPermsCtx
|
||||
pure
|
||||
( ( adminIntrospection,
|
||||
view _1 <$> hasuraContexts,
|
||||
unauthenticated,
|
||||
Set.unions $ unauthenticatedRemotesErrors : (view _2 <$> Map.elems hasuraContexts)
|
||||
),
|
||||
( relayContexts,
|
||||
-- Currently, remote schemas are exposed through Relay, but ONLY through
|
||||
-- the unauthenticated role. This is probably an oversight. See
|
||||
-- hasura/graphql-engine-mono#3883.
|
||||
unauthenticated
|
||||
adminIntrospection <-
|
||||
case Map.lookup adminRoleName hasuraContexts of
|
||||
Just (_context, _errors, introspection) -> pure introspection
|
||||
Nothing -> throw500 "buildGQLContext failed to build for the admin role"
|
||||
(unauthenticated, unauthenticatedRemotesErrors) <- unauthenticatedContext allRemoteSchemas remoteSchemaPermissions
|
||||
pure
|
||||
( ( adminIntrospection,
|
||||
view _1 <$> hasuraContexts,
|
||||
unauthenticated,
|
||||
Set.unions $ unauthenticatedRemotesErrors : (view _2 <$> Map.elems hasuraContexts)
|
||||
),
|
||||
( relayContexts,
|
||||
-- Currently, remote schemas are exposed through Relay, but ONLY through
|
||||
-- the unauthenticated role. This is probably an oversight. See
|
||||
-- hasura/graphql-engine-mono#3883.
|
||||
unauthenticated
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
buildSchemaOptions ::
|
||||
(SQLGenCtx, Options.InferFunctionPermissions) ->
|
||||
|
@ -37,8 +37,8 @@ import Hasura.RQL.Types.SchemaCache.Build
|
||||
import Hasura.SQL.AnyBackend qualified as AB
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.SQL.Tag
|
||||
import Hasura.Server.Init.FeatureFlag as FF
|
||||
import Hasura.Server.Types (HasServerConfigCtx (..), ServerConfigCtx (..))
|
||||
import Hasura.Server.Init.FeatureFlag (HasFeatureFlagChecker (..))
|
||||
import Hasura.Server.Init.FeatureFlag qualified as FF
|
||||
|
||||
-- | Default implementation of the 'track_logical_model' request payload.
|
||||
data TrackLogicalModel (b :: BackendType) = TrackLogicalModel
|
||||
@ -90,9 +90,9 @@ deriving via
|
||||
logicalModelTrackToMetadata ::
|
||||
forall b m.
|
||||
( BackendMetadata b,
|
||||
MetadataM m,
|
||||
MonadError QErr m,
|
||||
MonadIO m,
|
||||
MonadError QErr m
|
||||
MetadataM m
|
||||
) =>
|
||||
Env.Environment ->
|
||||
SourceConnConfiguration b ->
|
||||
@ -145,8 +145,7 @@ runGetLogicalModel ::
|
||||
forall b m.
|
||||
( BackendMetadata b,
|
||||
MetadataM m,
|
||||
HasServerConfigCtx m,
|
||||
MonadIO m,
|
||||
HasFeatureFlagChecker m,
|
||||
MonadError QErr m
|
||||
) =>
|
||||
GetLogicalModel b ->
|
||||
@ -167,11 +166,11 @@ runGetLogicalModel q = do
|
||||
runTrackLogicalModel ::
|
||||
forall b m.
|
||||
( BackendMetadata b,
|
||||
MonadError QErr m,
|
||||
MonadIO m,
|
||||
CacheRWM m,
|
||||
MetadataM m,
|
||||
MonadError QErr m,
|
||||
HasServerConfigCtx m,
|
||||
MonadIO m
|
||||
HasFeatureFlagChecker m
|
||||
) =>
|
||||
Env.Environment ->
|
||||
TrackLogicalModel b ->
|
||||
@ -273,13 +272,9 @@ dropLogicalModelInMetadata source rootFieldName = do
|
||||
%~ OMap.delete rootFieldName
|
||||
|
||||
-- | check feature flag is enabled before carrying out any actions
|
||||
throwIfFeatureDisabled :: (HasServerConfigCtx m, MonadIO m, MonadError QErr m) => m ()
|
||||
throwIfFeatureDisabled :: (HasFeatureFlagChecker m, MonadError QErr m) => m ()
|
||||
throwIfFeatureDisabled = do
|
||||
configCtx <- askServerConfigCtx
|
||||
let CheckFeatureFlag runCheckFeatureFlag = _sccCheckFeatureFlag configCtx
|
||||
|
||||
enableLogicalModels <- liftIO (runCheckFeatureFlag FF.logicalModelInterface)
|
||||
|
||||
enableLogicalModels <- checkFlag FF.logicalModelInterface
|
||||
unless enableLogicalModels (throw500 "LogicalModels is disabled!")
|
||||
|
||||
-- | Check whether a logical model with the given root field name exists for
|
||||
|
@ -9,7 +9,6 @@ where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Aeson (FromJSON, (.:), (.=))
|
||||
import Data.Aeson qualified as Aeson
|
||||
import Data.HashMap.Strict qualified as HashMap
|
||||
@ -31,13 +30,12 @@ instance FromJSON GetFeatureFlag where
|
||||
|
||||
runGetFeatureFlag ::
|
||||
( MonadError Error.QErr m,
|
||||
Types.HasServerConfigCtx m,
|
||||
MonadIO m
|
||||
) =>
|
||||
Types.CheckFeatureFlag ->
|
||||
GetFeatureFlag ->
|
||||
m EncJSON
|
||||
runGetFeatureFlag GetFeatureFlag {..} = do
|
||||
Types.CheckFeatureFlag getFeatureFlag <- Types._sccCheckFeatureFlag <$> Types.askServerConfigCtx
|
||||
runGetFeatureFlag (Types.CheckFeatureFlag getFeatureFlag) GetFeatureFlag {..} = do
|
||||
let flagM = HashMap.lookup gfgIdentifier $ FeatureFlag.getFeatureFlags $ FeatureFlag.featureFlags
|
||||
case flagM of
|
||||
Nothing -> Error.throw400 Error.NotFound $ "Feature Flag '" <> gfgIdentifier <> "' not found"
|
||||
|
@ -61,6 +61,7 @@ import Hasura.RQL.DDL.InheritedRoles (resolveInheritedRole)
|
||||
import Hasura.RQL.DDL.RemoteRelationship (CreateRemoteSchemaRemoteRelationship (..), PartiallyResolvedSource (..), buildRemoteFieldInfo, getRemoteSchemaEntityJoinColumns)
|
||||
import Hasura.RQL.DDL.ScheduledTrigger
|
||||
import Hasura.RQL.DDL.Schema.Cache.Common
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.DDL.Schema.Cache.Dependencies
|
||||
import Hasura.RQL.DDL.Schema.Cache.Fields
|
||||
import Hasura.RQL.DDL.Schema.Cache.Permission
|
||||
@ -147,7 +148,7 @@ buildRebuildableSchemaCache ::
|
||||
Logger Hasura ->
|
||||
Env.Environment ->
|
||||
MetadataWithResourceVersion ->
|
||||
ServerConfigCtx ->
|
||||
CacheDynamicConfig ->
|
||||
CacheBuild RebuildableSchemaCache
|
||||
buildRebuildableSchemaCache =
|
||||
buildRebuildableSchemaCacheWithReason CatalogSync
|
||||
@ -157,12 +158,12 @@ buildRebuildableSchemaCacheWithReason ::
|
||||
Logger Hasura ->
|
||||
Env.Environment ->
|
||||
MetadataWithResourceVersion ->
|
||||
ServerConfigCtx ->
|
||||
CacheDynamicConfig ->
|
||||
CacheBuild RebuildableSchemaCache
|
||||
buildRebuildableSchemaCacheWithReason reason logger env metadataWithVersion serverConfigCtx = do
|
||||
buildRebuildableSchemaCacheWithReason reason logger env metadataWithVersion dynamicConfig = do
|
||||
result <-
|
||||
flip runReaderT reason $
|
||||
Inc.build (buildSchemaCacheRule logger env) (metadataWithVersion, serverConfigCtx, initialInvalidationKeys, Nothing)
|
||||
Inc.build (buildSchemaCacheRule logger env) (metadataWithVersion, dynamicConfig, initialInvalidationKeys, Nothing)
|
||||
|
||||
pure $ RebuildableSchemaCache (Inc.result result) initialInvalidationKeys (Inc.rebuildRule result)
|
||||
|
||||
@ -172,11 +173,11 @@ newtype CacheRWT m a
|
||||
-- (which added Control.Monad.Trans.Writer.CPS) are leaky, and we don’t have
|
||||
-- that yet.
|
||||
--
|
||||
-- The use of 'ReaderT ServerConfigCtx' is only here to avoid manually
|
||||
-- passing the 'ServerConfigCtx' to every function that builds the cache. It
|
||||
-- The use of 'ReaderT CacheDynamicConfig' is only here to avoid manually
|
||||
-- passing the 'CacheDynamicConfig' to every function that builds the cache. It
|
||||
-- should ultimately be reduced to 'AppContext', or even better a relevant
|
||||
-- subset thereof.
|
||||
CacheRWT (ReaderT ServerConfigCtx (StateT (RebuildableSchemaCache, CacheInvalidations) m) a)
|
||||
CacheRWT (ReaderT CacheDynamicConfig (StateT (RebuildableSchemaCache, CacheInvalidations) m) a)
|
||||
deriving newtype
|
||||
( Functor,
|
||||
Applicative,
|
||||
@ -188,13 +189,11 @@ newtype CacheRWT m a
|
||||
Tracing.MonadTrace,
|
||||
MonadBase b,
|
||||
MonadBaseControl b,
|
||||
ProvidesNetwork
|
||||
ProvidesNetwork,
|
||||
FF.HasFeatureFlagChecker
|
||||
)
|
||||
deriving anyclass (MonadQueryTags)
|
||||
|
||||
instance Monad m => HasServerConfigCtx (CacheRWT m) where
|
||||
askServerConfigCtx = CacheRWT ask
|
||||
|
||||
instance MonadReader r m => MonadReader r (CacheRWT m) where
|
||||
ask = lift ask
|
||||
local f (CacheRWT m) = CacheRWT $ mapReaderT (local f) m
|
||||
@ -209,7 +208,7 @@ instance (MonadGetApiTimeLimit m) => MonadGetApiTimeLimit (CacheRWT m) where
|
||||
|
||||
runCacheRWT ::
|
||||
Monad m =>
|
||||
ServerConfigCtx ->
|
||||
CacheDynamicConfig ->
|
||||
RebuildableSchemaCache ->
|
||||
CacheRWT m a ->
|
||||
m (a, RebuildableSchemaCache, CacheInvalidations)
|
||||
@ -228,19 +227,20 @@ instance
|
||||
( MonadIO m,
|
||||
MonadError QErr m,
|
||||
ProvidesNetwork m,
|
||||
MonadResolveSource m
|
||||
MonadResolveSource m,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
CacheRWM (CacheRWT m)
|
||||
where
|
||||
buildSchemaCacheWithOptions buildReason invalidations metadata = CacheRWT do
|
||||
serverConfigCtx <- ask
|
||||
dynamicConfig <- ask
|
||||
(RebuildableSchemaCache lastBuiltSC invalidationKeys rule, oldInvalidations) <- get
|
||||
let metadataWithVersion = MetadataWithResourceVersion metadata $ scMetadataResourceVersion lastBuiltSC
|
||||
newInvalidationKeys = invalidateKeys invalidations invalidationKeys
|
||||
result <-
|
||||
runCacheBuildM $
|
||||
flip runReaderT buildReason $
|
||||
Inc.build rule (metadataWithVersion, serverConfigCtx, newInvalidationKeys, Nothing)
|
||||
Inc.build rule (metadataWithVersion, dynamicConfig, newInvalidationKeys, Nothing)
|
||||
let schemaCache = Inc.result result
|
||||
prunedInvalidationKeys = pruneInvalidationKeys schemaCache newInvalidationKeys
|
||||
!newCache = RebuildableSchemaCache schemaCache prunedInvalidationKeys (Inc.rebuildRule result)
|
||||
@ -335,19 +335,20 @@ buildSchemaCacheRule ::
|
||||
MonadError QErr m,
|
||||
MonadReader BuildReason m,
|
||||
ProvidesNetwork m,
|
||||
MonadResolveSource m
|
||||
MonadResolveSource m,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
Logger Hasura ->
|
||||
Env.Environment ->
|
||||
(MetadataWithResourceVersion, ServerConfigCtx, InvalidationKeys, Maybe StoredIntrospection) `arr` SchemaCache
|
||||
buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDefaults resourceVersion, serverConfigCtx, invalidationKeys, storedIntrospection) -> do
|
||||
(MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys, Maybe StoredIntrospection) `arr` SchemaCache
|
||||
buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDefaults resourceVersion, dynamicConfig, invalidationKeys, storedIntrospection) -> do
|
||||
invalidationKeysDep <- Inc.newDependency -< invalidationKeys
|
||||
let metadataDefaults = _sccMetadataDefaults serverConfigCtx
|
||||
let metadataDefaults = _cdcMetadataDefaults dynamicConfig
|
||||
metadata@Metadata {..} = overrideMetadataDefaults metadataNoDefaults metadataDefaults
|
||||
metadataDep <- Inc.newDependency -< metadata
|
||||
|
||||
(inconsistentObjects, (resolvedOutputs, dependencyInconsistentObjects, resolvedDependencies), ((adminIntrospection, gqlContext, gqlContextUnauth, inconsistentRemoteSchemas), (relayContext, relayContextUnauth))) <-
|
||||
Inc.cache buildOutputsAndSchema -< (metadataDep, serverConfigCtx, invalidationKeysDep, storedIntrospection)
|
||||
Inc.cache buildOutputsAndSchema -< (metadataDep, dynamicConfig, invalidationKeysDep, storedIntrospection)
|
||||
|
||||
let (resolvedEndpoints, endpointCollectedInfo) = runIdentity $ runWriterT $ buildRESTEndpoints _metaQueryCollections (OMap.elems _metaRestEndpoints)
|
||||
(cronTriggersMap, cronTriggersCollectedInfo) = runIdentity $ runWriterT $ buildCronTriggers (OMap.elems _metaCronTriggers)
|
||||
@ -442,15 +443,19 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
}
|
||||
where
|
||||
-- See Note [Avoiding GraphQL schema rebuilds when changing irrelevant Metadata]
|
||||
buildOutputsAndSchema = proc (metadataDep, serverConfigCtx, invalidationKeysDep, storedIntrospection) -> do
|
||||
(outputs, collectedInfo) <- runWriterA buildAndCollectInfo -< (serverConfigCtx, metadataDep, invalidationKeysDep, storedIntrospection)
|
||||
buildOutputsAndSchema = proc (metadataDep, dynamicConfig, invalidationKeysDep, storedIntrospection) -> do
|
||||
(outputs, collectedInfo) <- runWriterA buildAndCollectInfo -< (dynamicConfig, metadataDep, invalidationKeysDep, storedIntrospection)
|
||||
let (inconsistentObjects, unresolvedDependencies) = partitionEithers $ toList collectedInfo
|
||||
out2@(resolvedOutputs, _dependencyInconsistentObjects, _resolvedDependencies) <- resolveDependencies -< (outputs, unresolvedDependencies)
|
||||
out3 <-
|
||||
bindA
|
||||
-< do
|
||||
buildGQLContext
|
||||
serverConfigCtx
|
||||
(_cdcFunctionPermsCtx dynamicConfig)
|
||||
(_cdcRemoteSchemaPermsCtx dynamicConfig)
|
||||
(_cdcExperimentalFeatures dynamicConfig)
|
||||
(_cdcSQLGenCtx dynamicConfig)
|
||||
(_cdcApolloFederationStatus dynamicConfig)
|
||||
(_boSources resolvedOutputs)
|
||||
(_boRemoteSchemas resolvedOutputs)
|
||||
(_boActions resolvedOutputs)
|
||||
@ -484,7 +489,8 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr,
|
||||
MonadIO m,
|
||||
MonadBaseControl IO m,
|
||||
ProvidesNetwork m
|
||||
ProvidesNetwork m,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
(Inc.Dependency (BackendMap BackendInvalidationKeysWrapper), [AB.AnyBackend BackendConfigWrapper]) `arr` BackendCache
|
||||
resolveBackendCache = proc (backendInvalidationMap, backendConfigs) -> do
|
||||
@ -586,17 +592,19 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
MonadIO m,
|
||||
BackendMetadata b,
|
||||
MonadError QErr m,
|
||||
MonadBaseControl IO m
|
||||
MonadBaseControl IO m,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
(Proxy b, ServerConfigCtx, Bool, SourceConfig b) `arr` (RecreateEventTriggers, SourceCatalogMigrationState)
|
||||
initCatalogIfNeeded = Inc.cache proc (Proxy, serverConfigCtx, atleastOneTrigger, sourceConfig) -> do
|
||||
(Proxy b, Bool, SourceConfig b) `arr` (RecreateEventTriggers, SourceCatalogMigrationState)
|
||||
initCatalogIfNeeded = Inc.cache proc (Proxy, atleastOneTrigger, sourceConfig) -> do
|
||||
bindA
|
||||
-< do
|
||||
if atleastOneTrigger
|
||||
then do
|
||||
let maintenanceMode = _sccMaintenanceMode serverConfigCtx
|
||||
eventingMode = _sccEventingMode serverConfigCtx
|
||||
readOnlyMode = _sccReadOnlyMode serverConfigCtx
|
||||
cacheStaticConfig <- askCacheStaticConfig
|
||||
let maintenanceMode = _cscMaintenanceMode cacheStaticConfig
|
||||
eventingMode = _cscEventingMode cacheStaticConfig
|
||||
readOnlyMode = _cscReadOnlyMode cacheStaticConfig
|
||||
|
||||
if
|
||||
-- when safe mode is enabled, don't perform any migrations
|
||||
@ -632,9 +640,10 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
MonadError QErr m,
|
||||
MonadIO m,
|
||||
BackendMetadata b,
|
||||
GetAggregationPredicatesDeps b
|
||||
GetAggregationPredicatesDeps b,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
( ServerConfigCtx,
|
||||
( CacheDynamicConfig,
|
||||
HashMap SourceName (AB.AnyBackend PartiallyResolvedSource),
|
||||
SourceMetadata b,
|
||||
SourceConfig b,
|
||||
@ -646,7 +655,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
OrderedRoles
|
||||
)
|
||||
`arr` (SourceInfo b)
|
||||
buildSource = proc (serverConfigCtx, allSources, sourceMetadata, sourceConfig, tablesRawInfo, eventTriggerInfoMaps, _dbTables, dbFunctions, remoteSchemaMap, orderedRoles) -> do
|
||||
buildSource = proc (dynamicConfig, allSources, sourceMetadata, sourceConfig, tablesRawInfo, eventTriggerInfoMaps, _dbTables, dbFunctions, remoteSchemaMap, orderedRoles) -> do
|
||||
let SourceMetadata sourceName _backendKind tables functions logicalModels customReturnTypes _ queryTagsConfig sourceCustomization _healthCheckConfig = sourceMetadata
|
||||
tablesMetadata = OMap.elems tables
|
||||
(_, nonColumnInputs, permissions) = unzip3 $ map mkTableInputs tablesMetadata
|
||||
@ -683,8 +692,8 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
|
||||
-- not forcing the evaluation here results in a measurable negative impact
|
||||
-- on memory residency as measured by our benchmark
|
||||
let !defaultNC = _sccDefaultNamingConvention serverConfigCtx
|
||||
!isNamingConventionEnabled = EFNamingConventions `elem` (_sccExperimentalFeatures serverConfigCtx)
|
||||
let !defaultNC = _cdcDefaultNamingConvention dynamicConfig
|
||||
!isNamingConventionEnabled = EFNamingConventions `elem` (_cdcExperimentalFeatures dynamicConfig)
|
||||
!namingConv <-
|
||||
bindA
|
||||
-<
|
||||
@ -732,7 +741,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
areLogicalModelsEnabled <-
|
||||
bindA
|
||||
-< do
|
||||
let CheckFeatureFlag checkFeatureFlag = _sccCheckFeatureFlag serverConfigCtx
|
||||
CheckFeatureFlag checkFeatureFlag <- _cscCheckFeatureFlag <$> askCacheStaticConfig
|
||||
liftIO @m $ checkFeatureFlag FF.logicalModelInterface
|
||||
|
||||
let mkCustomReturnTypeMetadataObject :: CustomReturnTypeMetadata b -> MetadataObject
|
||||
@ -821,10 +830,11 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
MonadReader BuildReason m,
|
||||
MonadBaseControl IO m,
|
||||
ProvidesNetwork m,
|
||||
MonadResolveSource m
|
||||
MonadResolveSource m,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
(ServerConfigCtx, Inc.Dependency Metadata, Inc.Dependency InvalidationKeys, Maybe StoredIntrospection) `arr` BuildOutputs
|
||||
buildAndCollectInfo = proc (serverConfigCtx, metadataDep, invalidationKeys, storedIntrospection) -> do
|
||||
(CacheDynamicConfig, Inc.Dependency Metadata, Inc.Dependency InvalidationKeys, Maybe StoredIntrospection) `arr` BuildOutputs
|
||||
buildAndCollectInfo = proc (dynamicConfig, metadataDep, invalidationKeys, storedIntrospection) -> do
|
||||
sources <- Inc.dependOn -< Inc.selectD #_metaSources metadataDep
|
||||
remoteSchemas <- Inc.dependOn -< Inc.selectD #_metaRemoteSchemas metadataDep
|
||||
customTypes <- Inc.dependOn -< Inc.selectD #_metaCustomTypes metadataDep
|
||||
@ -860,8 +870,8 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
let remoteSchemaInvalidationKeys = Inc.selectD #_ikRemoteSchemas invalidationKeys
|
||||
remoteSchemaMap <- buildRemoteSchemas env -< ((remoteSchemaInvalidationKeys, orderedRoles, fmap encJToLBS . siRemotes <$> storedIntrospection), OMap.elems remoteSchemas)
|
||||
let remoteSchemaCtxMap = M.map fst remoteSchemaMap
|
||||
!defaultNC = _sccDefaultNamingConvention serverConfigCtx
|
||||
!isNamingConventionEnabled = EFNamingConventions `elem` (_sccExperimentalFeatures serverConfigCtx)
|
||||
!defaultNC = _cdcDefaultNamingConvention dynamicConfig
|
||||
!isNamingConventionEnabled = EFNamingConventions `elem` (_cdcExperimentalFeatures dynamicConfig)
|
||||
|
||||
let backendInvalidationKeys = Inc.selectD #_ikBackends invalidationKeys
|
||||
backendCache <- resolveBackendCache -< (backendInvalidationKeys, BackendMap.elems backendConfigs)
|
||||
@ -875,7 +885,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
Inc.keyed
|
||||
( \_ exists ->
|
||||
AB.dispatchAnyBackendArrow @BackendMetadata @BackendEventTrigger
|
||||
( proc (backendInfoAndSourceMetadata :: BackendInfoAndSourceMetadata b, (serverConfigCtx, invalidationKeys, storedIntrospection, defaultNC, isNamingConventionEnabled)) -> do
|
||||
( proc (backendInfoAndSourceMetadata :: BackendInfoAndSourceMetadata b, (dynamicConfig, invalidationKeys, storedIntrospection, defaultNC, isNamingConventionEnabled)) -> do
|
||||
let sourceMetadata = _bcasmSourceMetadata backendInfoAndSourceMetadata
|
||||
sourceName = _smName sourceMetadata
|
||||
sourceInvalidationsKeys = Inc.selectD #_ikSources invalidationKeys
|
||||
@ -904,7 +914,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
eventTriggers = map (_tmTable &&& OMap.elems . _tmEventTriggers) tablesMetadata
|
||||
numEventTriggers = sum $ map (length . snd) eventTriggers
|
||||
|
||||
(recreateEventTriggers, sourceCatalogMigrationState) <- initCatalogIfNeeded -< (Proxy :: Proxy b, serverConfigCtx, numEventTriggers > 0, sourceConfig)
|
||||
(recreateEventTriggers, sourceCatalogMigrationState) <- initCatalogIfNeeded -< (Proxy :: Proxy b, numEventTriggers > 0, sourceConfig)
|
||||
|
||||
bindA -< unLogger logger (sourceName, sourceCatalogMigrationState)
|
||||
|
||||
@ -915,7 +925,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
(|
|
||||
Inc.keyed
|
||||
( \_ (tableCoreInfo, (_, eventTriggerConfs)) ->
|
||||
buildTableEventTriggers -< (serverConfigCtx, sourceName, sourceConfig, tableCoreInfo, eventTriggerConfs, metadataInvalidationKey, recreateEventTriggers)
|
||||
buildTableEventTriggers -< (dynamicConfig, sourceName, sourceConfig, tableCoreInfo, eventTriggerConfs, metadataInvalidationKey, recreateEventTriggers)
|
||||
)
|
||||
|) (tablesCoreInfo `alignTableMap` mapFromL fst eventTriggers)
|
||||
|
||||
@ -926,7 +936,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
PartiallyResolvedSource sourceMetadata sourceConfig source tablesCoreInfo eventTriggerInfoMaps
|
||||
)
|
||||
-<
|
||||
(exists, (serverConfigCtx, invalidationKeys, storedIntrospection, defaultNC, isNamingConventionEnabled))
|
||||
(exists, (dynamicConfig, invalidationKeys, storedIntrospection, defaultNC, isNamingConventionEnabled))
|
||||
)
|
||||
|) (M.fromList $ OMap.toList backendInfoAndSourceMetadata)
|
||||
let partiallyResolvedSources = catMaybes partiallyResolvedSourcesMaybes
|
||||
@ -946,7 +956,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
AB.dispatchAnyBackendArrow @BackendMetadata @GetAggregationPredicatesDeps
|
||||
( proc
|
||||
( partiallyResolvedSource :: PartiallyResolvedSource b,
|
||||
(serverConfigCtx, allResolvedSources, remoteSchemaCtxMap, orderedRoles)
|
||||
(dynamicConfig, allResolvedSources, remoteSchemaCtxMap, orderedRoles)
|
||||
)
|
||||
-> do
|
||||
let PartiallyResolvedSource sourceMetadata sourceConfig introspection tablesInfo eventTriggers = partiallyResolvedSource
|
||||
@ -954,7 +964,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
so <-
|
||||
Inc.cache buildSource
|
||||
-<
|
||||
( serverConfigCtx,
|
||||
( dynamicConfig,
|
||||
allResolvedSources,
|
||||
sourceMetadata,
|
||||
sourceConfig,
|
||||
@ -969,7 +979,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
)
|
||||
-<
|
||||
( exists,
|
||||
(serverConfigCtx, partiallyResolvedSources, remoteSchemaCtxMap, orderedRoles)
|
||||
(dynamicConfig, partiallyResolvedSources, remoteSchemaCtxMap, orderedRoles)
|
||||
)
|
||||
)
|
||||
|) partiallyResolvedSources
|
||||
@ -1098,7 +1108,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
mkEventTriggerMetadataObject ::
|
||||
forall b a c.
|
||||
Backend b =>
|
||||
(ServerConfigCtx, a, SourceName, c, TableName b, RecreateEventTriggers, EventTriggerConf b) ->
|
||||
(CacheDynamicConfig, a, SourceName, c, TableName b, RecreateEventTriggers, EventTriggerConf b) ->
|
||||
MetadataObject
|
||||
mkEventTriggerMetadataObject (_, _, source, _, table, _, eventTriggerConf) =
|
||||
let objectId =
|
||||
@ -1133,9 +1143,10 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
MonadBaseControl IO m,
|
||||
MonadReader BuildReason m,
|
||||
BackendMetadata b,
|
||||
BackendEventTrigger b
|
||||
BackendEventTrigger b,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
( ServerConfigCtx,
|
||||
( CacheDynamicConfig,
|
||||
SourceName,
|
||||
SourceConfig b,
|
||||
TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
|
||||
@ -1144,15 +1155,15 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
RecreateEventTriggers
|
||||
)
|
||||
`arr` (EventTriggerInfoMap b)
|
||||
buildTableEventTriggers = proc (serverConfigCtx, sourceName, sourceConfig, tableInfo, eventTriggerConfs, metadataInvalidationKey, migrationRecreateEventTriggers) ->
|
||||
buildTableEventTriggers = proc (dynamicConfig, sourceName, sourceConfig, tableInfo, eventTriggerConfs, metadataInvalidationKey, migrationRecreateEventTriggers) ->
|
||||
buildInfoMap (etcName . (^. _7)) (mkEventTriggerMetadataObject @b) buildEventTrigger
|
||||
-<
|
||||
(tableInfo, map (serverConfigCtx,metadataInvalidationKey,sourceName,sourceConfig,_tciName tableInfo,migrationRecreateEventTriggers,) eventTriggerConfs)
|
||||
(tableInfo, map (dynamicConfig,metadataInvalidationKey,sourceName,sourceConfig,_tciName tableInfo,migrationRecreateEventTriggers,) eventTriggerConfs)
|
||||
where
|
||||
buildEventTrigger = proc (tableInfo, (serverConfigCtx, metadataInvalidationKey, source, sourceConfig, table, migrationRecreateEventTriggers, eventTriggerConf)) -> do
|
||||
buildEventTrigger = proc (tableInfo, (dynamicConfig, metadataInvalidationKey, source, sourceConfig, table, migrationRecreateEventTriggers, eventTriggerConf)) -> do
|
||||
let triggerName = etcName eventTriggerConf
|
||||
triggerOnReplication = etcTriggerOnReplication eventTriggerConf
|
||||
metadataObject = mkEventTriggerMetadataObject @b (serverConfigCtx, metadataInvalidationKey, source, sourceConfig, table, migrationRecreateEventTriggers, eventTriggerConf)
|
||||
metadataObject = mkEventTriggerMetadataObject @b (dynamicConfig, metadataInvalidationKey, source, sourceConfig, table, migrationRecreateEventTriggers, eventTriggerConf)
|
||||
schemaObjectId =
|
||||
SOSourceObj source $
|
||||
AB.mkAnyBackend $
|
||||
@ -1169,13 +1180,14 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
withRecordInconsistency
|
||||
( do
|
||||
(info, dependencies) <- bindErrorA -< modifyErr (addTableContext @b table . addTriggerContext) $ buildEventTriggerInfo @b env source table eventTriggerConf
|
||||
staticConfig <- bindA -< askCacheStaticConfig
|
||||
let isCatalogUpdate =
|
||||
case buildReason of
|
||||
CatalogUpdate _ -> True
|
||||
CatalogSync -> False
|
||||
tableColumns = M.elems $ _tciFieldInfoMap tableInfo
|
||||
if ( _sccMaintenanceMode serverConfigCtx == MaintenanceModeDisabled
|
||||
&& _sccReadOnlyMode serverConfigCtx == ReadOnlyModeDisabled
|
||||
if ( _cscMaintenanceMode staticConfig == MaintenanceModeDisabled
|
||||
&& _cscReadOnlyMode staticConfig == ReadOnlyModeDisabled
|
||||
)
|
||||
then do
|
||||
bindA
|
||||
@ -1187,7 +1199,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
liftEitherM $
|
||||
createTableEventTrigger
|
||||
@b
|
||||
serverConfigCtx
|
||||
(_cdcSQLGenCtx dynamicConfig)
|
||||
sourceConfig
|
||||
table
|
||||
tableColumns
|
||||
@ -1199,7 +1211,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
then do
|
||||
recreateTriggerIfNeeded
|
||||
-<
|
||||
( serverConfigCtx,
|
||||
( dynamicConfig,
|
||||
table,
|
||||
tableColumns,
|
||||
triggerName,
|
||||
@ -1214,7 +1226,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
bindA
|
||||
-<
|
||||
createMissingSQLTriggers
|
||||
serverConfigCtx
|
||||
(_cdcSQLGenCtx dynamicConfig)
|
||||
sourceConfig
|
||||
table
|
||||
(tableColumns, _tciPrimaryKey tableInfo)
|
||||
@ -1234,7 +1246,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
-- computation will not be done again.
|
||||
Inc.cache
|
||||
proc
|
||||
( serverConfigCtx,
|
||||
( dynamicConfig,
|
||||
tableName,
|
||||
tableColumns,
|
||||
triggerName,
|
||||
@ -1248,7 +1260,7 @@ buildSchemaCacheRule logger env = proc (MetadataWithResourceVersion metadataNoDe
|
||||
-< do
|
||||
liftEitherM $
|
||||
createTableEventTrigger @b
|
||||
serverConfigCtx
|
||||
(_cdcSQLGenCtx dynamicConfig)
|
||||
sourceConfig
|
||||
tableName
|
||||
tableColumns
|
||||
|
@ -59,6 +59,7 @@ import Hasura.CustomReturnType.Types (CustomReturnTypeName)
|
||||
import Hasura.EncJSON
|
||||
import Hasura.Incremental qualified as Inc
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.Types.Backend
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
@ -79,7 +80,6 @@ import Hasura.SQL.AnyBackend
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.SQL.BackendMap (BackendMap)
|
||||
import Hasura.SQL.BackendMap qualified as BackendMap
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Services
|
||||
import Hasura.Session
|
||||
import Network.HTTP.Client.Transformable qualified as HTTP
|
||||
@ -257,7 +257,8 @@ $(makeLenses ''BuildOutputs)
|
||||
data CacheBuildParams = CacheBuildParams
|
||||
{ _cbpManager :: HTTP.Manager,
|
||||
_cbpPGSourceResolver :: SourceResolver ('Postgres 'Vanilla),
|
||||
_cbpMSSQLSourceResolver :: SourceResolver 'MSSQL
|
||||
_cbpMSSQLSourceResolver :: SourceResolver 'MSSQL,
|
||||
_cbpStaticConfig :: CacheStaticConfig
|
||||
}
|
||||
|
||||
-- | The monad in which @'RebuildableSchemaCache' is being run
|
||||
@ -273,6 +274,9 @@ newtype CacheBuild a = CacheBuild (ReaderT CacheBuildParams (ExceptT QErr IO) a)
|
||||
MonadBaseControl IO
|
||||
)
|
||||
|
||||
instance HasCacheStaticConfig CacheBuild where
|
||||
askCacheStaticConfig = asks _cbpStaticConfig
|
||||
|
||||
instance ProvidesNetwork CacheBuild where
|
||||
askHTTPManager = asks _cbpManager
|
||||
|
||||
@ -294,7 +298,8 @@ runCacheBuildM ::
|
||||
( MonadIO m,
|
||||
MonadError QErr m,
|
||||
MonadResolveSource m,
|
||||
ProvidesNetwork m
|
||||
ProvidesNetwork m,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
CacheBuild a ->
|
||||
m a
|
||||
@ -304,12 +309,13 @@ runCacheBuildM m = do
|
||||
<$> askHTTPManager
|
||||
<*> getPGSourceResolver
|
||||
<*> getMSSQLSourceResolver
|
||||
<*> askCacheStaticConfig
|
||||
runCacheBuild params m
|
||||
|
||||
data RebuildableSchemaCache = RebuildableSchemaCache
|
||||
{ lastBuiltSchemaCache :: SchemaCache,
|
||||
_rscInvalidationMap :: InvalidationKeys,
|
||||
_rscRebuild :: Inc.Rule (ReaderT BuildReason CacheBuild) (MetadataWithResourceVersion, ServerConfigCtx, InvalidationKeys, Maybe StoredIntrospection) SchemaCache
|
||||
_rscRebuild :: Inc.Rule (ReaderT BuildReason CacheBuild) (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys, Maybe StoredIntrospection) SchemaCache
|
||||
}
|
||||
|
||||
bindErrorA ::
|
||||
|
70
server/src-lib/Hasura/RQL/DDL/Schema/Cache/Config.hs
Normal file
70
server/src-lib/Hasura/RQL/DDL/Schema/Cache/Config.hs
Normal file
@ -0,0 +1,70 @@
|
||||
module Hasura.RQL.DDL.Schema.Cache.Config
|
||||
( -- * static config
|
||||
CacheStaticConfig (..),
|
||||
HasCacheStaticConfig (..),
|
||||
|
||||
-- * dynamic config
|
||||
CacheDynamicConfig (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Hasura.GraphQL.Schema.NamingCase (NamingCase)
|
||||
import Hasura.GraphQL.Schema.Options qualified as Options
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.Types.Common (SQLGenCtx)
|
||||
import Hasura.RQL.Types.Metadata (MetadataDefaults)
|
||||
import Hasura.Server.Types
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- static config
|
||||
|
||||
-- | This type aggregates all of the "static" configuration of the cache build.
|
||||
--
|
||||
-- Static arguments are the ones that will not change during the execution of
|
||||
-- the engine. They are a subset of the environment of the engine (see 'AppEnv'
|
||||
-- and Note [Hasura Application State] for more information).
|
||||
--
|
||||
-- While 'AppEnv' has access to the union of *all* the static configuration of
|
||||
-- the engine, more specific parts of the code should avoid relying directly on
|
||||
-- it to avoid being tied to unrelated parts of the codebase. (See FIXME).
|
||||
data CacheStaticConfig = CacheStaticConfig
|
||||
{ _cscMaintenanceMode :: MaintenanceMode (),
|
||||
_cscEventingMode :: EventingMode,
|
||||
_cscReadOnlyMode :: ReadOnlyMode,
|
||||
_cscCheckFeatureFlag :: CheckFeatureFlag
|
||||
}
|
||||
|
||||
class Monad m => HasCacheStaticConfig m where
|
||||
askCacheStaticConfig :: m CacheStaticConfig
|
||||
|
||||
instance HasCacheStaticConfig m => HasCacheStaticConfig (ReaderT r m) where
|
||||
askCacheStaticConfig = lift askCacheStaticConfig
|
||||
|
||||
instance HasCacheStaticConfig m => HasCacheStaticConfig (ExceptT e m) where
|
||||
askCacheStaticConfig = lift askCacheStaticConfig
|
||||
|
||||
instance HasCacheStaticConfig m => HasCacheStaticConfig (StateT s m) where
|
||||
askCacheStaticConfig = lift askCacheStaticConfig
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- dynamic config
|
||||
|
||||
-- | This type aggregates all of the "dynamic" configuration of the cache build.
|
||||
--
|
||||
-- Dynamic arguments are the ones that might change during the execution of the
|
||||
-- engine. They are a subset of the 'AppContext' (see
|
||||
-- Note [Hasura Application State] for more information).
|
||||
--
|
||||
-- While 'AppContext' has access to the union of *all* the dynamic configuration
|
||||
-- of the engine, more specific parts of the code should avoid relying directly
|
||||
-- on it to avoid being tied to unrelated parts of the codebase. (See FIXME).
|
||||
data CacheDynamicConfig = CacheDynamicConfig
|
||||
{ _cdcFunctionPermsCtx :: Options.InferFunctionPermissions,
|
||||
_cdcRemoteSchemaPermsCtx :: Options.RemoteSchemaPermissions,
|
||||
_cdcSQLGenCtx :: SQLGenCtx,
|
||||
_cdcExperimentalFeatures :: HashSet ExperimentalFeature,
|
||||
_cdcDefaultNamingConvention :: NamingCase,
|
||||
_cdcMetadataDefaults :: MetadataDefaults,
|
||||
_cdcApolloFederationStatus :: ApolloFederationStatus
|
||||
}
|
||||
deriving (Eq)
|
@ -29,7 +29,6 @@ import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.Metadata
|
||||
import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Session
|
||||
import Hasura.Tracing qualified as Tracing
|
||||
|
||||
@ -109,17 +108,17 @@ runDelete ::
|
||||
( QErrM m,
|
||||
UserInfoM m,
|
||||
CacheRM m,
|
||||
HasServerConfigCtx m,
|
||||
MonadIO m,
|
||||
Tracing.MonadTrace m,
|
||||
MonadBaseControl IO m,
|
||||
MetadataM m
|
||||
) =>
|
||||
SQLGenCtx ->
|
||||
DeleteQuery ->
|
||||
m EncJSON
|
||||
runDelete q = do
|
||||
runDelete sqlGen q = do
|
||||
sourceConfig <- askSourceConfig @('Postgres 'Vanilla) (doSource q)
|
||||
strfyNum <- stringifyNum . _sccSQLGenCtx <$> askServerConfigCtx
|
||||
let strfyNum = stringifyNum sqlGen
|
||||
userInfo <- askUserInfo
|
||||
validateDeleteQ q
|
||||
>>= runTxWithCtx (_pscExecCtx sourceConfig) (Tx PG.ReadWrite Nothing) LegacyRQLQuery
|
||||
|
@ -29,7 +29,6 @@ import Hasura.RQL.Types.Metadata
|
||||
import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.RQL.Types.Table
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Session
|
||||
import Hasura.Tracing qualified as Tracing
|
||||
|
||||
@ -243,19 +242,19 @@ runInsert ::
|
||||
( QErrM m,
|
||||
UserInfoM m,
|
||||
CacheRM m,
|
||||
HasServerConfigCtx m,
|
||||
MonadIO m,
|
||||
Tracing.MonadTrace m,
|
||||
MonadBaseControl IO m,
|
||||
MetadataM m
|
||||
) =>
|
||||
SQLGenCtx ->
|
||||
InsertQuery ->
|
||||
m EncJSON
|
||||
runInsert q = do
|
||||
runInsert sqlGen q = do
|
||||
sourceConfig <- askSourceConfig @('Postgres 'Vanilla) (iqSource q)
|
||||
userInfo <- askUserInfo
|
||||
res <- convInsQ q
|
||||
strfyNum <- stringifyNum . _sccSQLGenCtx <$> askServerConfigCtx
|
||||
let strfyNum = stringifyNum sqlGen
|
||||
runTxWithCtx (_pscExecCtx sourceConfig) (Tx PG.ReadWrite Nothing) LegacyRQLQuery $
|
||||
flip runReaderT emptyQueryTagsComment $
|
||||
execInsertQuery strfyNum Nothing userInfo res
|
||||
|
@ -55,7 +55,6 @@ import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.RQL.Types.Table
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Session
|
||||
|
||||
newtype DMLP1T m a = DMLP1T {unDMLP1T :: StateT (DS.Seq PG.PrepArg) m a}
|
||||
@ -69,8 +68,7 @@ newtype DMLP1T m a = DMLP1T {unDMLP1T :: StateT (DS.Seq PG.PrepArg) m a}
|
||||
TableCoreInfoRM b,
|
||||
TableInfoRM b,
|
||||
CacheRM,
|
||||
UserInfoM,
|
||||
HasServerConfigCtx
|
||||
UserInfoM
|
||||
)
|
||||
|
||||
runDMLP1T :: DMLP1T m a -> m (a, DS.Seq PG.PrepArg)
|
||||
|
@ -31,7 +31,6 @@ import Hasura.RQL.Types.Relationships.Local
|
||||
import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.RQL.Types.Table
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Session
|
||||
import Hasura.Tracing qualified as Tracing
|
||||
|
||||
@ -174,9 +173,9 @@ convOrderByElem sessVarBldr (flds, spi) = \case
|
||||
convSelectQ ::
|
||||
( UserInfoM m,
|
||||
QErrM m,
|
||||
TableInfoRM ('Postgres 'Vanilla) m,
|
||||
HasServerConfigCtx m
|
||||
TableInfoRM ('Postgres 'Vanilla) m
|
||||
) =>
|
||||
SQLGenCtx ->
|
||||
TableName ('Postgres 'Vanilla) ->
|
||||
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) -> -- Table information of current table
|
||||
SelPermInfo ('Postgres 'Vanilla) -> -- Additional select permission info
|
||||
@ -184,7 +183,7 @@ convSelectQ ::
|
||||
SessionVariableBuilder m ->
|
||||
ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
|
||||
m (AnnSimpleSelect ('Postgres 'Vanilla))
|
||||
convSelectQ table fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do
|
||||
convSelectQ sqlGen table fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do
|
||||
-- Convert where clause
|
||||
wClause <- forM (sqWhere selQ) $ \boolExp ->
|
||||
withPathK "where" $
|
||||
@ -200,6 +199,7 @@ convSelectQ table fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do
|
||||
(ECRel relName mAlias relSelQ) -> do
|
||||
annRel <-
|
||||
convExtRel
|
||||
sqlGen
|
||||
fieldInfoMap
|
||||
relName
|
||||
mAlias
|
||||
@ -230,8 +230,7 @@ convSelectQ table fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do
|
||||
let tabFrom = FromTable table
|
||||
tabPerm = TablePerm resolvedSelFltr mPermLimit
|
||||
tabArgs = SelectArgs wClause annOrdByM mQueryLimit (fromIntegral <$> mQueryOffset) Nothing
|
||||
|
||||
strfyNum <- stringifyNum . _sccSQLGenCtx <$> askServerConfigCtx
|
||||
strfyNum = stringifyNum sqlGen
|
||||
pure $ AnnSelectG annFlds tabFrom tabPerm tabArgs strfyNum Nothing
|
||||
where
|
||||
mQueryOffset = sqOffset selQ
|
||||
@ -254,9 +253,9 @@ convExtSimple fieldInfoMap selPermInfo pgCol = do
|
||||
convExtRel ::
|
||||
( UserInfoM m,
|
||||
QErrM m,
|
||||
TableInfoRM ('Postgres 'Vanilla) m,
|
||||
HasServerConfigCtx m
|
||||
TableInfoRM ('Postgres 'Vanilla) m
|
||||
) =>
|
||||
SQLGenCtx ->
|
||||
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
|
||||
RelName ->
|
||||
Maybe RelName ->
|
||||
@ -264,14 +263,14 @@ convExtRel ::
|
||||
SessionVariableBuilder m ->
|
||||
ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
|
||||
m (Either (ObjectRelationSelect ('Postgres 'Vanilla)) (ArraySelect ('Postgres 'Vanilla)))
|
||||
convExtRel fieldInfoMap relName mAlias selQ sessVarBldr prepValBldr = do
|
||||
convExtRel sqlGen fieldInfoMap relName mAlias selQ sessVarBldr prepValBldr = do
|
||||
-- Point to the name key
|
||||
relInfo <-
|
||||
withPathK "name" $
|
||||
askRelType fieldInfoMap relName pgWhenRelErr
|
||||
let (RelInfo _ relTy colMapping relTab _ _) = relInfo
|
||||
(relCIM, relSPI) <- fetchRelDet relName relTab
|
||||
annSel <- convSelectQ relTab relCIM relSPI selQ sessVarBldr prepValBldr
|
||||
annSel <- convSelectQ sqlGen relTab relCIM relSPI selQ sessVarBldr prepValBldr
|
||||
case relTy of
|
||||
ObjRel -> do
|
||||
when misused $ throw400 UnexpectedPayload objRelMisuseMsg
|
||||
@ -304,20 +303,20 @@ convExtRel fieldInfoMap relName mAlias selQ sessVarBldr prepValBldr = do
|
||||
convSelectQuery ::
|
||||
( UserInfoM m,
|
||||
QErrM m,
|
||||
TableInfoRM ('Postgres 'Vanilla) m,
|
||||
HasServerConfigCtx m
|
||||
TableInfoRM ('Postgres 'Vanilla) m
|
||||
) =>
|
||||
SQLGenCtx ->
|
||||
SessionVariableBuilder m ->
|
||||
ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
|
||||
SelectQuery ->
|
||||
m (AnnSimpleSelect ('Postgres 'Vanilla))
|
||||
convSelectQuery sessVarBldr prepArgBuilder (DMLQuery _ qt selQ) = do
|
||||
convSelectQuery sqlGen sessVarBldr prepArgBuilder (DMLQuery _ qt selQ) = do
|
||||
tabInfo <- withPathK "table" $ askTableInfoSource qt
|
||||
selPermInfo <- askSelPermInfo tabInfo
|
||||
let fieldInfo = _tciFieldInfoMap $ _tiCoreInfo tabInfo
|
||||
extSelQ <- resolveStar fieldInfo selPermInfo selQ
|
||||
validateHeaders $ spiRequiredHeaders selPermInfo
|
||||
convSelectQ qt fieldInfo selPermInfo extSelQ sessVarBldr prepArgBuilder
|
||||
convSelectQ sqlGen qt fieldInfo selPermInfo extSelQ sessVarBldr prepArgBuilder
|
||||
|
||||
selectP2 :: JsonAggSelect -> (AnnSimpleSelect ('Postgres 'Vanilla), DS.Seq PG.PrepArg) -> PG.TxE QErr EncJSON
|
||||
selectP2 jsonAggSelect (sel, p) =
|
||||
@ -330,15 +329,16 @@ selectP2 jsonAggSelect (sel, p) =
|
||||
mkSQLSelect jsonAggSelect sel
|
||||
|
||||
phaseOne ::
|
||||
(QErrM m, UserInfoM m, CacheRM m, HasServerConfigCtx m) =>
|
||||
(QErrM m, UserInfoM m, CacheRM m) =>
|
||||
SQLGenCtx ->
|
||||
SelectQuery ->
|
||||
m (AnnSimpleSelect ('Postgres 'Vanilla), DS.Seq PG.PrepArg)
|
||||
phaseOne query = do
|
||||
phaseOne sqlGen query = do
|
||||
let sourceName = getSourceDMLQuery query
|
||||
tableCache :: TableCache ('Postgres 'Vanilla) <- fold <$> askTableCache sourceName
|
||||
flip runTableCacheRT tableCache $
|
||||
runDMLP1T $
|
||||
convSelectQuery sessVarFromCurrentSetting (valueParserWithCollectableType binRHSBuilder) query
|
||||
convSelectQuery sqlGen sessVarFromCurrentSetting (valueParserWithCollectableType binRHSBuilder) query
|
||||
|
||||
phaseTwo :: (MonadTx m) => (AnnSimpleSelect ('Postgres 'Vanilla), DS.Seq PG.PrepArg) -> m EncJSON
|
||||
phaseTwo =
|
||||
@ -348,14 +348,14 @@ runSelect ::
|
||||
( QErrM m,
|
||||
UserInfoM m,
|
||||
CacheRM m,
|
||||
HasServerConfigCtx m,
|
||||
MonadIO m,
|
||||
MonadBaseControl IO m,
|
||||
Tracing.MonadTrace m,
|
||||
MetadataM m
|
||||
) =>
|
||||
SQLGenCtx ->
|
||||
SelectQuery ->
|
||||
m EncJSON
|
||||
runSelect q = do
|
||||
runSelect sqlGen q = do
|
||||
sourceConfig <- askSourceConfig @('Postgres 'Vanilla) (getSourceDMLQuery q)
|
||||
phaseOne q >>= runTxWithCtx (_pscExecCtx sourceConfig) (Tx PG.ReadOnly Nothing) LegacyRQLQuery . phaseTwo
|
||||
phaseOne sqlGen q >>= runTxWithCtx (_pscExecCtx sourceConfig) (Tx PG.ReadOnly Nothing) LegacyRQLQuery . phaseTwo
|
||||
|
@ -34,7 +34,6 @@ import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.RQL.Types.Table
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Session
|
||||
import Hasura.Tracing qualified as Tracing
|
||||
|
||||
@ -224,18 +223,18 @@ runUpdate ::
|
||||
( QErrM m,
|
||||
UserInfoM m,
|
||||
CacheRM m,
|
||||
HasServerConfigCtx m,
|
||||
MonadBaseControl IO m,
|
||||
MonadIO m,
|
||||
Tracing.MonadTrace m,
|
||||
MetadataM m
|
||||
) =>
|
||||
SQLGenCtx ->
|
||||
UpdateQuery ->
|
||||
m EncJSON
|
||||
runUpdate q = do
|
||||
runUpdate sqlGen q = do
|
||||
sourceConfig <- askSourceConfig @('Postgres 'Vanilla) (uqSource q)
|
||||
userInfo <- askUserInfo
|
||||
strfyNum <- stringifyNum . _sccSQLGenCtx <$> askServerConfigCtx
|
||||
let strfyNum = stringifyNum sqlGen
|
||||
validateUpdateQuery q
|
||||
>>= runTxWithCtx (_pscExecCtx sourceConfig) (Tx PG.ReadWrite Nothing) LegacyRQLQuery
|
||||
. flip runReaderT emptyQueryTagsComment
|
||||
|
@ -19,7 +19,7 @@ import Hasura.RQL.Types.Eventing
|
||||
import Hasura.RQL.Types.Source
|
||||
import Hasura.RQL.Types.Table (PrimaryKey)
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.Server.Types (MaintenanceMode, ServerConfigCtx)
|
||||
import Hasura.Server.Types (MaintenanceMode)
|
||||
import Hasura.Session (UserInfo)
|
||||
import Hasura.Tracing qualified as Tracing
|
||||
|
||||
@ -188,7 +188,7 @@ class Backend b => BackendEventTrigger (b :: BackendType) where
|
||||
-- exist then it will create it.
|
||||
createMissingSQLTriggers ::
|
||||
(MonadIO m, MonadError QErr m, MonadBaseControl IO m, Backend b) =>
|
||||
ServerConfigCtx ->
|
||||
SQLGenCtx ->
|
||||
SourceConfig b ->
|
||||
TableName b ->
|
||||
([ColumnInfo b], Maybe (PrimaryKey b (ColumnInfo b))) ->
|
||||
@ -199,7 +199,7 @@ class Backend b => BackendEventTrigger (b :: BackendType) where
|
||||
|
||||
createTableEventTrigger ::
|
||||
(MonadBaseControl IO m, MonadIO m, MonadError QErr m) =>
|
||||
ServerConfigCtx ->
|
||||
SQLGenCtx ->
|
||||
SourceConfig b ->
|
||||
TableName b ->
|
||||
[ColumnInfo b] ->
|
||||
|
@ -161,7 +161,6 @@ import Hasura.SQL.Backend
|
||||
import Hasura.SQL.BackendMap (BackendMap)
|
||||
import Hasura.SQL.BackendMap qualified as BackendMap
|
||||
import Hasura.SQL.Tag (HasTag (backendTag), reify)
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Session
|
||||
import Hasura.Tracing (TraceT)
|
||||
import Language.GraphQL.Draft.Syntax qualified as G
|
||||
@ -651,7 +650,7 @@ instance (TableInfoRM b m) => TableInfoRM b (TraceT m) where
|
||||
|
||||
newtype TableCacheRT b m a = TableCacheRT {runTableCacheRT :: TableCache b -> m a}
|
||||
deriving
|
||||
(Functor, Applicative, Monad, MonadIO, MonadError e, MonadState s, MonadWriter w, Postgres.MonadTx, UserInfoM, HasServerConfigCtx)
|
||||
(Functor, Applicative, Monad, MonadIO, MonadError e, MonadState s, MonadWriter w, Postgres.MonadTx, UserInfoM)
|
||||
via (ReaderT (TableCache b) m)
|
||||
deriving (MonadTrans) via (ReaderT (TableCache b))
|
||||
|
||||
|
@ -59,7 +59,7 @@ import Hasura.RQL.Types.Metadata.Object
|
||||
import Hasura.RQL.Types.QueryCollection
|
||||
import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.RemoteSchema.Metadata (RemoteSchemaName)
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Server.Init.FeatureFlag (HasFeatureFlagChecker)
|
||||
import Hasura.Services.Network
|
||||
import Hasura.Session
|
||||
import Hasura.Tracing (TraceT)
|
||||
@ -239,7 +239,8 @@ newtype MetadataT m a = MetadataT {unMetadataT :: StateT Metadata m a}
|
||||
Tracing.MonadTrace,
|
||||
MonadBase b,
|
||||
MonadBaseControl b,
|
||||
ProvidesNetwork
|
||||
ProvidesNetwork,
|
||||
HasFeatureFlagChecker
|
||||
)
|
||||
deriving anyclass (MonadQueryTags)
|
||||
|
||||
@ -250,9 +251,6 @@ instance (Monad m) => MetadataM (MetadataT m) where
|
||||
instance (UserInfoM m) => UserInfoM (MetadataT m) where
|
||||
askUserInfo = lift askUserInfo
|
||||
|
||||
instance HasServerConfigCtx m => HasServerConfigCtx (MetadataT m) where
|
||||
askServerConfigCtx = lift askServerConfigCtx
|
||||
|
||||
-- | @runMetadataT@ puts a stateful metadata in scope. @MetadataDefaults@ is
|
||||
-- provided so that it can be considered from the --metadataDefaults arguments.
|
||||
runMetadataT :: Metadata -> MetadataDefaults -> MetadataT m a -> m (a, Metadata)
|
||||
|
@ -23,7 +23,6 @@ import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.RQL.Types.SchemaCache.Build
|
||||
import Hasura.RemoteSchema.Metadata
|
||||
import Hasura.RemoteSchema.SchemaCache.Permission
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Session
|
||||
|
||||
data AddRemoteSchemaPermission = AddRemoteSchemaPermission
|
||||
@ -51,14 +50,13 @@ $(J.deriveJSON hasuraJSON ''DropRemoteSchemaPermissions)
|
||||
runAddRemoteSchemaPermissions ::
|
||||
( QErrM m,
|
||||
CacheRWM m,
|
||||
HasServerConfigCtx m,
|
||||
MetadataM m
|
||||
) =>
|
||||
Options.RemoteSchemaPermissions ->
|
||||
AddRemoteSchemaPermission ->
|
||||
m EncJSON
|
||||
runAddRemoteSchemaPermissions q = do
|
||||
runAddRemoteSchemaPermissions remoteSchemaPermsCtx q = do
|
||||
metadata <- getMetadata
|
||||
remoteSchemaPermsCtx <- _sccRemoteSchemaPermsCtx <$> askServerConfigCtx
|
||||
unless (remoteSchemaPermsCtx == Options.EnableRemoteSchemaPermissions) $ do
|
||||
throw400 ConstraintViolation $
|
||||
"remote schema permissions can only be added when "
|
||||
|
@ -23,6 +23,7 @@ import Hasura.Base.Error
|
||||
import Hasura.CustomReturnType.API qualified as CustomReturnType
|
||||
import Hasura.EncJSON
|
||||
import Hasura.Function.API qualified as Functions
|
||||
import Hasura.GraphQL.Schema.Options qualified as Options
|
||||
import Hasura.Logging qualified as L
|
||||
import Hasura.LogicalModel.API qualified as LogicalModels
|
||||
import Hasura.Metadata.Class
|
||||
@ -50,6 +51,7 @@ import Hasura.RQL.DDL.Relationship.Suggest
|
||||
import Hasura.RQL.DDL.RemoteRelationship
|
||||
import Hasura.RQL.DDL.ScheduledTrigger
|
||||
import Hasura.RQL.DDL.Schema
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.DDL.Schema.Source
|
||||
import Hasura.RQL.DDL.SourceKinds
|
||||
import Hasura.RQL.DDL.Webhook.Transform.Validation
|
||||
@ -79,6 +81,7 @@ import Hasura.SQL.AnyBackend
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.Server.API.Backend
|
||||
import Hasura.Server.API.Instances ()
|
||||
import Hasura.Server.Init.FeatureFlag (HasFeatureFlagChecker)
|
||||
import Hasura.Server.Logging (SchemaSyncLog (..), SchemaSyncThreadType (TTMetadataApi))
|
||||
import Hasura.Server.Types
|
||||
import Hasura.Server.Utils (APIVersion (..))
|
||||
@ -388,6 +391,8 @@ runMetadataQuery ::
|
||||
MonadError QErr m,
|
||||
MonadBaseControl IO m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
HasFeatureFlagChecker m,
|
||||
Tracing.MonadTrace m,
|
||||
MonadMetadataStorage m,
|
||||
MonadResolveSource m,
|
||||
@ -401,7 +406,7 @@ runMetadataQuery ::
|
||||
RQLMetadata ->
|
||||
m (EncJSON, RebuildableSchemaCache)
|
||||
runMetadataQuery appContext schemaCache RQLMetadata {..} = do
|
||||
appEnv@AppEnv {..} <- askAppEnv
|
||||
AppEnv {..} <- askAppEnv
|
||||
let logger = _lsLogger appEnvLoggers
|
||||
MetadataWithResourceVersion metadata currentResourceVersion <- Tracing.newSpan "fetchMetadata" $ liftEitherM fetchMetadata
|
||||
let exportsMetadata = \case
|
||||
@ -427,13 +432,18 @@ runMetadataQuery appContext schemaCache RQLMetadata {..} = do
|
||||
if (exportsMetadata _rqlMetadata || queryModifiesMetadata _rqlMetadata)
|
||||
then emptyMetadataDefaults
|
||||
else acMetadataDefaults appContext
|
||||
serverConfigCtx = buildServerConfigCtx appEnv appContext
|
||||
dynamicConfig = buildCacheDynamicConfig appContext
|
||||
((r, modMetadata), modSchemaCache, cacheInvalidations) <-
|
||||
runMetadataQueryM (acEnvironment appContext) currentResourceVersion _rqlMetadata
|
||||
runMetadataQueryM
|
||||
(acEnvironment appContext)
|
||||
appEnvCheckFeatureFlag
|
||||
(acRemoteSchemaPermsCtx appContext)
|
||||
currentResourceVersion
|
||||
_rqlMetadata
|
||||
-- TODO: remove this straight runReaderT that provides no actual new info
|
||||
& flip runReaderT logger
|
||||
& runMetadataT metadata metadataDefaults
|
||||
& runCacheRWT serverConfigCtx schemaCache
|
||||
& runCacheRWT dynamicConfig schemaCache
|
||||
-- set modified metadata in storage
|
||||
if queryModifiesMetadata _rqlMetadata
|
||||
then case (appEnvEnableMaintenanceMode, appEnvEnableReadOnlyMode) of
|
||||
@ -464,7 +474,7 @@ runMetadataQuery appContext schemaCache RQLMetadata {..} = do
|
||||
(_, modSchemaCache', _) <-
|
||||
Tracing.newSpan "setMetadataResourceVersionInSchemaCache" $
|
||||
setMetadataResourceVersionInSchemaCache newResourceVersion
|
||||
& runCacheRWT serverConfigCtx modSchemaCache
|
||||
& runCacheRWT dynamicConfig modSchemaCache
|
||||
|
||||
pure (r, modSchemaCache')
|
||||
(MaintenanceModeEnabled (), ReadOnlyModeDisabled) ->
|
||||
@ -607,25 +617,27 @@ runMetadataQueryM ::
|
||||
UserInfoM m,
|
||||
MetadataM m,
|
||||
MonadMetadataStorage m,
|
||||
HasServerConfigCtx m,
|
||||
MonadReader r m,
|
||||
Has (L.Logger L.Hasura) r,
|
||||
MonadError QErr m,
|
||||
MonadEventLogCleanup m,
|
||||
ProvidesHasuraServices m,
|
||||
MonadGetApiTimeLimit m
|
||||
MonadGetApiTimeLimit m,
|
||||
HasFeatureFlagChecker m
|
||||
) =>
|
||||
Env.Environment ->
|
||||
CheckFeatureFlag ->
|
||||
Options.RemoteSchemaPermissions ->
|
||||
MetadataResourceVersion ->
|
||||
RQLMetadataRequest ->
|
||||
m EncJSON
|
||||
runMetadataQueryM env currentResourceVersion =
|
||||
runMetadataQueryM env checkFeatureFlag remoteSchemaPerms currentResourceVersion =
|
||||
withPathK "args" . \case
|
||||
-- NOTE: This is a good place to install tracing, since it's involved in
|
||||
-- the recursive case via "bulk":
|
||||
RMV1 q ->
|
||||
Tracing.newSpan ("v1 " <> T.pack (constrName q)) $
|
||||
runMetadataQueryV1M env currentResourceVersion q
|
||||
runMetadataQueryV1M env checkFeatureFlag remoteSchemaPerms currentResourceVersion q
|
||||
RMV2 q ->
|
||||
Tracing.newSpan ("v2 " <> T.pack (constrName q)) $
|
||||
runMetadataQueryV2M currentResourceVersion q
|
||||
@ -639,19 +651,21 @@ runMetadataQueryV1M ::
|
||||
UserInfoM m,
|
||||
MetadataM m,
|
||||
MonadMetadataStorage m,
|
||||
HasServerConfigCtx m,
|
||||
MonadReader r m,
|
||||
Has (L.Logger L.Hasura) r,
|
||||
MonadError QErr m,
|
||||
MonadEventLogCleanup m,
|
||||
ProvidesHasuraServices m,
|
||||
MonadGetApiTimeLimit m
|
||||
MonadGetApiTimeLimit m,
|
||||
HasFeatureFlagChecker m
|
||||
) =>
|
||||
Env.Environment ->
|
||||
CheckFeatureFlag ->
|
||||
Options.RemoteSchemaPermissions ->
|
||||
MetadataResourceVersion ->
|
||||
RQLMetadataV1 ->
|
||||
m EncJSON
|
||||
runMetadataQueryV1M env currentResourceVersion = \case
|
||||
runMetadataQueryV1M env checkFeatureFlag remoteSchemaPerms currentResourceVersion = \case
|
||||
RMAddSource q -> dispatchMetadata (runAddSource env) q
|
||||
RMDropSource q -> runDropSource q
|
||||
RMRenameSource q -> runRenameSource q
|
||||
@ -718,7 +732,7 @@ runMetadataQueryV1M env currentResourceVersion = \case
|
||||
RMRemoveRemoteSchema q -> runRemoveRemoteSchema q
|
||||
RMReloadRemoteSchema q -> runReloadRemoteSchema q
|
||||
RMIntrospectRemoteSchema q -> runIntrospectRemoteSchema q
|
||||
RMAddRemoteSchemaPermissions q -> runAddRemoteSchemaPermissions q
|
||||
RMAddRemoteSchemaPermissions q -> runAddRemoteSchemaPermissions remoteSchemaPerms q
|
||||
RMDropRemoteSchemaPermissions q -> runDropRemoteSchemaPermissions q
|
||||
RMCreateRemoteSchemaRemoteRelationship q -> runCreateRemoteSchemaRemoteRelationship q
|
||||
RMUpdateRemoteSchemaRemoteRelationship q -> runUpdateRemoteSchemaRemoteRelationship q
|
||||
@ -790,8 +804,8 @@ runMetadataQueryV1M env currentResourceVersion = \case
|
||||
RMSetQueryTagsConfig q -> runSetQueryTagsConfig q
|
||||
RMSetOpenTelemetryConfig q -> runSetOpenTelemetryConfig q
|
||||
RMSetOpenTelemetryStatus q -> runSetOpenTelemetryStatus q
|
||||
RMGetFeatureFlag q -> runGetFeatureFlag q
|
||||
RMBulk q -> encJFromList <$> indexedMapM (runMetadataQueryM env currentResourceVersion) q
|
||||
RMGetFeatureFlag q -> runGetFeatureFlag checkFeatureFlag q
|
||||
RMBulk q -> encJFromList <$> indexedMapM (runMetadataQueryM env checkFeatureFlag remoteSchemaPerms currentResourceVersion) q
|
||||
where
|
||||
dispatch ::
|
||||
(forall b. Backend b => i b -> a) ->
|
||||
|
@ -38,6 +38,7 @@ import Hasura.RQL.DDL.Relationship.Rename
|
||||
import Hasura.RQL.DDL.RemoteRelationship
|
||||
import Hasura.RQL.DDL.ScheduledTrigger
|
||||
import Hasura.RQL.DDL.Schema
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.DML.Count
|
||||
import Hasura.RQL.DML.Delete
|
||||
import Hasura.RQL.DML.Insert
|
||||
@ -180,6 +181,7 @@ runQuery ::
|
||||
( MonadIO m,
|
||||
MonadError QErr m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
Tracing.MonadTrace m,
|
||||
MonadBaseControl IO m,
|
||||
MonadMetadataStorage m,
|
||||
@ -195,7 +197,7 @@ runQuery ::
|
||||
RQLQuery ->
|
||||
m (EncJSON, RebuildableSchemaCache)
|
||||
runQuery appContext sc query = do
|
||||
appEnv@AppEnv {..} <- askAppEnv
|
||||
AppEnv {..} <- askAppEnv
|
||||
let logger = _lsLogger appEnvLoggers
|
||||
when ((appEnvEnableReadOnlyMode == ReadOnlyModeEnabled) && queryModifiesUserDB query) $
|
||||
throw400 NotSupported "Cannot run write queries when read-only mode is enabled"
|
||||
@ -207,15 +209,15 @@ runQuery appContext sc query = do
|
||||
if (exportsMetadata query)
|
||||
then emptyMetadataDefaults
|
||||
else acMetadataDefaults appContext
|
||||
serverConfigCtx = buildServerConfigCtx appEnv appContext
|
||||
dynamicConfig = buildCacheDynamicConfig appContext
|
||||
|
||||
MetadataWithResourceVersion metadata currentResourceVersion <- liftEitherM fetchMetadata
|
||||
((result, updatedMetadata), updatedCache, invalidations) <-
|
||||
runQueryM (acEnvironment appContext) query
|
||||
runQueryM (acEnvironment appContext) (acSQLGenCtx appContext) query
|
||||
-- TODO: remove this straight runReaderT that provides no actual new info
|
||||
& flip runReaderT logger
|
||||
& runMetadataT metadata metadataDefaults
|
||||
& runCacheRWT serverConfigCtx sc
|
||||
& runCacheRWT dynamicConfig sc
|
||||
when (queryModifiesSchemaCache query) $ do
|
||||
case appEnvEnableMaintenanceMode of
|
||||
MaintenanceModeDisabled -> do
|
||||
@ -391,7 +393,6 @@ runQueryM ::
|
||||
UserInfoM m,
|
||||
MonadBaseControl IO m,
|
||||
MonadIO m,
|
||||
HasServerConfigCtx m,
|
||||
Tracing.MonadTrace m,
|
||||
MetadataM m,
|
||||
MonadMetadataStorage m,
|
||||
@ -404,9 +405,10 @@ runQueryM ::
|
||||
MonadGetApiTimeLimit m
|
||||
) =>
|
||||
Env.Environment ->
|
||||
SQLGenCtx ->
|
||||
RQLQuery ->
|
||||
m EncJSON
|
||||
runQueryM env rq = withPathK "args" $ case rq of
|
||||
runQueryM env sqlGen rq = withPathK "args" $ case rq of
|
||||
RQV1 q -> runQueryV1M q
|
||||
RQV2 q -> runQueryV2M q
|
||||
where
|
||||
@ -436,10 +438,10 @@ runQueryM env rq = withPathK "args" $ case rq of
|
||||
RQSetPermissionComment q -> runSetPermComment q
|
||||
RQGetInconsistentMetadata q -> runGetInconsistentMetadata q
|
||||
RQDropInconsistentMetadata q -> runDropInconsistentMetadata q
|
||||
RQInsert q -> runInsert q
|
||||
RQSelect q -> runSelect q
|
||||
RQUpdate q -> runUpdate q
|
||||
RQDelete q -> runDelete q
|
||||
RQInsert q -> runInsert sqlGen q
|
||||
RQSelect q -> runSelect sqlGen q
|
||||
RQUpdate q -> runUpdate sqlGen q
|
||||
RQDelete q -> runDelete sqlGen q
|
||||
RQCount q -> runCount q
|
||||
RQAddRemoteSchema q -> runAddRemoteSchema env q
|
||||
RQUpdateRemoteSchema q -> runUpdateRemoteSchema env q
|
||||
@ -475,9 +477,9 @@ runQueryM env rq = withPathK "args" $ case rq of
|
||||
RQCreateRestEndpoint q -> runCreateEndpoint q
|
||||
RQDropRestEndpoint q -> runDropEndpoint q
|
||||
RQDumpInternalState q -> runDumpInternalState q
|
||||
RQRunSql q -> runRunSQL @'Vanilla q
|
||||
RQRunSql q -> runRunSQL @'Vanilla sqlGen q
|
||||
RQSetCustomTypes q -> runSetCustomTypes q
|
||||
RQBulk qs -> encJFromList <$> indexedMapM (runQueryM env) qs
|
||||
RQBulk qs -> encJFromList <$> indexedMapM (runQueryM env sqlGen) qs
|
||||
|
||||
runQueryV2M = \case
|
||||
RQV2TrackTable q -> runTrackTableV2Q q
|
||||
|
@ -13,7 +13,6 @@ import Control.Lens (preview, _Right)
|
||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (Parser)
|
||||
import Data.Environment qualified as Env
|
||||
import Data.Text qualified as T
|
||||
import GHC.Generics.Extended (constrName)
|
||||
import Hasura.App.State
|
||||
@ -29,6 +28,7 @@ import Hasura.Metadata.Class
|
||||
import Hasura.Prelude
|
||||
import Hasura.QueryTags
|
||||
import Hasura.RQL.DDL.Schema
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.DML.Count
|
||||
import Hasura.RQL.DML.Delete
|
||||
import Hasura.RQL.DML.Insert
|
||||
@ -41,6 +41,7 @@ import Hasura.RQL.DML.Types
|
||||
UpdateQuery,
|
||||
)
|
||||
import Hasura.RQL.DML.Update
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.Metadata
|
||||
import Hasura.RQL.Types.SchemaCache (MetadataWithResourceVersion (MetadataWithResourceVersion))
|
||||
import Hasura.RQL.Types.SchemaCache.Build
|
||||
@ -107,6 +108,7 @@ runQuery ::
|
||||
MonadBaseControl IO m,
|
||||
MonadError QErr m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
Tracing.MonadTrace m,
|
||||
MonadMetadataStorage m,
|
||||
MonadResolveSource m,
|
||||
@ -119,17 +121,17 @@ runQuery ::
|
||||
RQLQuery ->
|
||||
m (EncJSON, RebuildableSchemaCache)
|
||||
runQuery appContext schemaCache rqlQuery = do
|
||||
appEnv@AppEnv {..} <- askAppEnv
|
||||
AppEnv {..} <- askAppEnv
|
||||
when ((appEnvEnableReadOnlyMode == ReadOnlyModeEnabled) && queryModifiesUserDB rqlQuery) $
|
||||
throw400 NotSupported "Cannot run write queries when read-only mode is enabled"
|
||||
|
||||
let serverConfigCtx = buildServerConfigCtx appEnv appContext
|
||||
let dynamicConfig = buildCacheDynamicConfig appContext
|
||||
MetadataWithResourceVersion metadata currentResourceVersion <- Tracing.newSpan "fetchMetadata" $ liftEitherM fetchMetadata
|
||||
((result, updatedMetadata), updatedCache, invalidations) <-
|
||||
runQueryM (acEnvironment appContext) rqlQuery
|
||||
runQueryM (acSQLGenCtx appContext) rqlQuery
|
||||
-- We can use defaults here unconditionally, since there is no MD export function in V2Query
|
||||
& runMetadataT metadata (acMetadataDefaults appContext)
|
||||
& runCacheRWT serverConfigCtx schemaCache
|
||||
& runCacheRWT dynamicConfig schemaCache
|
||||
when (queryModifiesSchema rqlQuery) $ do
|
||||
case appEnvEnableMaintenanceMode of
|
||||
MaintenanceModeDisabled -> do
|
||||
@ -170,33 +172,32 @@ runQueryM ::
|
||||
MonadBaseControl IO m,
|
||||
UserInfoM m,
|
||||
CacheRWM m,
|
||||
HasServerConfigCtx m,
|
||||
Tracing.MonadTrace m,
|
||||
MetadataM m,
|
||||
MonadQueryTags m
|
||||
) =>
|
||||
Env.Environment ->
|
||||
SQLGenCtx ->
|
||||
RQLQuery ->
|
||||
m EncJSON
|
||||
runQueryM env rq = Tracing.newSpan (T.pack $ constrName rq) $ case rq of
|
||||
RQInsert q -> runInsert q
|
||||
RQSelect q -> runSelect q
|
||||
RQUpdate q -> runUpdate q
|
||||
RQDelete q -> runDelete q
|
||||
runQueryM sqlGen rq = Tracing.newSpan (T.pack $ constrName rq) $ case rq of
|
||||
RQInsert q -> runInsert sqlGen q
|
||||
RQSelect q -> runSelect sqlGen q
|
||||
RQUpdate q -> runUpdate sqlGen q
|
||||
RQDelete q -> runDelete sqlGen q
|
||||
RQCount q -> runCount q
|
||||
RQRunSql q -> Postgres.runRunSQL @'Vanilla q
|
||||
RQRunSql q -> Postgres.runRunSQL @'Vanilla sqlGen q
|
||||
RQMssqlRunSql q -> MSSQL.runSQL q
|
||||
RQMysqlRunSql q -> MySQL.runSQL q
|
||||
RQCitusRunSql q -> Postgres.runRunSQL @'Citus q
|
||||
RQCockroachRunSql q -> Postgres.runRunSQL @'Cockroach q
|
||||
RQCitusRunSql q -> Postgres.runRunSQL @'Citus sqlGen q
|
||||
RQCockroachRunSql q -> Postgres.runRunSQL @'Cockroach sqlGen q
|
||||
RQBigqueryRunSql q -> BigQuery.runSQL q
|
||||
RQDataConnectorRunSql t q -> DataConnector.runSQL t q
|
||||
RQBigqueryDatabaseInspection q -> BigQuery.runDatabaseInspection q
|
||||
RQBulk l -> encJFromList <$> indexedMapM (runQueryM env) l
|
||||
RQBulk l -> encJFromList <$> indexedMapM (runQueryM sqlGen) l
|
||||
RQConcurrentBulk l -> do
|
||||
when (queryModifiesSchema rq) $
|
||||
throw500 "Only read-only queries are allowed in a concurrent_bulk"
|
||||
encJFromList <$> mapConcurrently (runQueryM env) l
|
||||
encJFromList <$> mapConcurrently (runQueryM sqlGen) l
|
||||
|
||||
queryModifiesUserDB :: RQLQuery -> Bool
|
||||
queryModifiesUserDB = \case
|
||||
|
@ -68,6 +68,7 @@ import Hasura.QueryTags
|
||||
import Hasura.RQL.DDL.ApiLimit (MonadGetApiTimeLimit)
|
||||
import Hasura.RQL.DDL.EventTrigger (MonadEventLogCleanup)
|
||||
import Hasura.RQL.DDL.Schema
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.Types.Endpoint as EP
|
||||
import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.RQL.Types.Source
|
||||
@ -134,6 +135,8 @@ newtype Handler m a = Handler (ReaderT HandlerCtx (ExceptT QErr m) a)
|
||||
MonadError QErr,
|
||||
MonadTrace,
|
||||
HasAppEnv,
|
||||
HasCacheStaticConfig,
|
||||
HasFeatureFlagChecker,
|
||||
HasResourceLimits,
|
||||
MonadResolveSource,
|
||||
E.MonadGQLExecutionCheck,
|
||||
@ -423,6 +426,7 @@ v1QueryHandler ::
|
||||
MonadMetadataStorage m,
|
||||
MonadResolveSource m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
MonadQueryTags m,
|
||||
MonadEventLogCleanup m,
|
||||
ProvidesNetwork m,
|
||||
@ -457,6 +461,8 @@ v1MetadataHandler ::
|
||||
MonadMetadataApiAuthorization m,
|
||||
MonadEventLogCleanup m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
HasFeatureFlagChecker m,
|
||||
ProvidesNetwork m,
|
||||
MonadGetApiTimeLimit m,
|
||||
UserInfoM m
|
||||
@ -486,6 +492,7 @@ v2QueryHandler ::
|
||||
MonadMetadataStorage m,
|
||||
MonadResolveSource m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
MonadQueryTags m,
|
||||
ProvidesNetwork m,
|
||||
UserInfoM m
|
||||
@ -713,6 +720,8 @@ mkWaiApp ::
|
||||
MonadVersionAPIWithExtraData m,
|
||||
HttpLog m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
HasFeatureFlagChecker m,
|
||||
UserAuthentication m,
|
||||
MonadMetadataApiAuthorization m,
|
||||
E.MonadGQLExecutionCheck m,
|
||||
@ -759,6 +768,8 @@ httpApp ::
|
||||
MonadVersionAPIWithExtraData m,
|
||||
HttpLog m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
HasFeatureFlagChecker m,
|
||||
UserAuthentication m,
|
||||
MonadMetadataApiAuthorization m,
|
||||
E.MonadGQLExecutionCheck m,
|
||||
|
@ -7,6 +7,7 @@ module Hasura.Server.Init.FeatureFlag
|
||||
checkFeatureFlag,
|
||||
Identifier (..),
|
||||
FeatureFlags (..),
|
||||
HasFeatureFlagChecker (..),
|
||||
featureFlags,
|
||||
logicalModelInterface,
|
||||
)
|
||||
@ -59,6 +60,20 @@ featureFlags =
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class Monad m => HasFeatureFlagChecker m where
|
||||
checkFlag :: FeatureFlag -> m Bool
|
||||
|
||||
instance HasFeatureFlagChecker m => HasFeatureFlagChecker (ReaderT r m) where
|
||||
checkFlag = lift . checkFlag
|
||||
|
||||
instance HasFeatureFlagChecker m => HasFeatureFlagChecker (ExceptT e m) where
|
||||
checkFlag = lift . checkFlag
|
||||
|
||||
instance HasFeatureFlagChecker m => HasFeatureFlagChecker (StateT s m) where
|
||||
checkFlag = lift . checkFlag
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
testFlag :: FeatureFlag
|
||||
testFlag =
|
||||
FeatureFlag
|
||||
|
@ -27,6 +27,7 @@ import Hasura.Logging
|
||||
import Hasura.Metadata.Class
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.DDL.Schema (runCacheRWT)
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.DDL.Schema.Catalog
|
||||
import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.RQL.Types.SchemaCache.Build
|
||||
@ -139,6 +140,7 @@ startSchemaSyncListenerThread logger pool instanceId interval metaVersionRef = d
|
||||
startSchemaSyncProcessorThread ::
|
||||
( C.ForkableMonadIO m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
MonadMetadataStorage m,
|
||||
MonadResolveSource m,
|
||||
ProvidesNetwork m
|
||||
@ -244,6 +246,7 @@ processor ::
|
||||
forall m void impl.
|
||||
( C.ForkableMonadIO m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
MonadMetadataStorage m,
|
||||
MonadResolveSource m,
|
||||
ProvidesNetwork m
|
||||
@ -263,6 +266,7 @@ refreshSchemaCache ::
|
||||
( MonadIO m,
|
||||
MonadBaseControl IO m,
|
||||
HasAppEnv m,
|
||||
HasCacheStaticConfig m,
|
||||
MonadMetadataStorage m,
|
||||
MonadResolveSource m,
|
||||
ProvidesNetwork m
|
||||
@ -277,15 +281,15 @@ refreshSchemaCache
|
||||
appStateRef
|
||||
threadType
|
||||
logTVar = do
|
||||
appEnv@AppEnv {..} <- askAppEnv
|
||||
AppEnv {..} <- askAppEnv
|
||||
let logger = _lsLogger appEnvLoggers
|
||||
respErr <- runExceptT $
|
||||
withSchemaCacheUpdate appStateRef logger (Just logTVar) $ do
|
||||
rebuildableCache <- liftIO $ fst <$> getRebuildableSchemaCacheWithVersion appStateRef
|
||||
appContext <- liftIO $ getAppContext appStateRef
|
||||
let serverConfigCtx = buildServerConfigCtx appEnv appContext
|
||||
let dynamicConfig = buildCacheDynamicConfig appContext
|
||||
(msg, cache, _) <-
|
||||
runCacheRWT serverConfigCtx rebuildableCache $ do
|
||||
runCacheRWT dynamicConfig rebuildableCache $ do
|
||||
schemaCache <- askSchemaCache
|
||||
let engineResourceVersion = scMetadataResourceVersion schemaCache
|
||||
unless (engineResourceVersion == resourceVersion) $ do
|
||||
|
@ -13,10 +13,7 @@ module Hasura.Server.Types
|
||||
PGVersion (PGVersion),
|
||||
pgToDbVersion,
|
||||
RequestId (..),
|
||||
ServerConfigCtx (..),
|
||||
HasServerConfigCtx (..),
|
||||
CheckFeatureFlag (..),
|
||||
askMetadataDefaults,
|
||||
getRequestId,
|
||||
ApolloFederationStatus (..),
|
||||
isApolloFederationEnabled,
|
||||
@ -24,14 +21,9 @@ module Hasura.Server.Types
|
||||
where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.HashSet qualified as Set
|
||||
import Data.Text (intercalate, unpack)
|
||||
import Database.PG.Query qualified as PG
|
||||
import Hasura.GraphQL.Schema.NamingCase
|
||||
import Hasura.GraphQL.Schema.Options qualified as Options
|
||||
import Hasura.Prelude hiding (intercalate)
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.Metadata (MetadataDefaults)
|
||||
import Hasura.Server.Init.FeatureFlag (CheckFeatureFlag (..))
|
||||
import Hasura.Server.Utils
|
||||
import Network.HTTP.Types qualified as HTTP
|
||||
@ -141,69 +133,6 @@ data ReadOnlyMode = ReadOnlyModeEnabled | ReadOnlyModeDisabled
|
||||
data EventingMode = EventingEnabled | EventingDisabled
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | This type represents an aggregate of different configuration options used
|
||||
-- throughout the engine. The fields are the union of a subset of 'AppEnv' and a
|
||||
-- subset of 'AppContext'.
|
||||
--
|
||||
-- This type should be considered as deprecated: avoid using it directly when
|
||||
-- you can use 'AppEnv' or 'AppContext', and avoid using the entirety of it when
|
||||
-- you only need a subset of the fields. Also avoid adding new fields if
|
||||
-- possible, but if you do so, make sure to adjust the @Eq@ instance
|
||||
-- accordingly.
|
||||
data ServerConfigCtx = ServerConfigCtx
|
||||
{ _sccFunctionPermsCtx :: Options.InferFunctionPermissions,
|
||||
_sccRemoteSchemaPermsCtx :: Options.RemoteSchemaPermissions,
|
||||
_sccSQLGenCtx :: SQLGenCtx,
|
||||
_sccMaintenanceMode :: MaintenanceMode (),
|
||||
_sccExperimentalFeatures :: Set.HashSet ExperimentalFeature,
|
||||
_sccEventingMode :: EventingMode,
|
||||
_sccReadOnlyMode :: ReadOnlyMode,
|
||||
-- | stores global default naming convention
|
||||
_sccDefaultNamingConvention :: NamingCase,
|
||||
_sccMetadataDefaults :: MetadataDefaults,
|
||||
_sccCheckFeatureFlag :: CheckFeatureFlag,
|
||||
_sccApolloFederationStatus :: ApolloFederationStatus
|
||||
}
|
||||
|
||||
-- We are currently using the entire 'ServerConfigCtx' as an input to the schema
|
||||
-- cache build, and it therefore requires an 'Eq' instance. However, only a few
|
||||
-- fields will change over time: those coming from the 'AppContext', and not
|
||||
-- those coming from the 'AppEnv'. Consequently, this instance only checks the
|
||||
-- relevant fields.
|
||||
--
|
||||
-- The way to fix this will be to use a smaller type as the input to the schema
|
||||
-- build, such as 'AppContext' (or, rather, a relevant subset), on which a
|
||||
-- "correct" @Eq@ instance can be defined.
|
||||
instance Eq ServerConfigCtx where
|
||||
(==) = (==) `on` extractDynamicFields
|
||||
where
|
||||
extractDynamicFields ServerConfigCtx {..} =
|
||||
( _sccFunctionPermsCtx,
|
||||
_sccRemoteSchemaPermsCtx,
|
||||
_sccSQLGenCtx,
|
||||
_sccExperimentalFeatures,
|
||||
_sccDefaultNamingConvention,
|
||||
_sccMetadataDefaults,
|
||||
_sccApolloFederationStatus
|
||||
)
|
||||
|
||||
askMetadataDefaults :: HasServerConfigCtx m => m MetadataDefaults
|
||||
askMetadataDefaults = do
|
||||
ServerConfigCtx {_sccMetadataDefaults} <- askServerConfigCtx
|
||||
pure _sccMetadataDefaults
|
||||
|
||||
class (Monad m) => HasServerConfigCtx m where
|
||||
askServerConfigCtx :: m ServerConfigCtx
|
||||
|
||||
instance HasServerConfigCtx m => HasServerConfigCtx (ReaderT r m) where
|
||||
askServerConfigCtx = lift askServerConfigCtx
|
||||
|
||||
instance HasServerConfigCtx m => HasServerConfigCtx (ExceptT e m) where
|
||||
askServerConfigCtx = lift askServerConfigCtx
|
||||
|
||||
instance HasServerConfigCtx m => HasServerConfigCtx (StateT s m) where
|
||||
askServerConfigCtx = lift askServerConfigCtx
|
||||
|
||||
-- | Whether or not to enable apollo federation fields.
|
||||
data ApolloFederationStatus = ApolloFederationEnabled | ApolloFederationDisabled
|
||||
deriving stock (Show, Eq, Ord, Generic)
|
||||
|
@ -31,13 +31,13 @@ import Hasura.Logging
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.DDL.Schema.Cache
|
||||
import Hasura.RQL.DDL.Schema.Cache.Common
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.Metadata (emptyMetadataDefaults)
|
||||
import Hasura.RQL.Types.ResizePool
|
||||
import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.RQL.Types.SchemaCache.Build
|
||||
import Hasura.Server.Init
|
||||
import Hasura.Server.Init.FeatureFlag as FF
|
||||
import Hasura.Server.Metrics (ServerMetricsSpec, createServerMetrics)
|
||||
import Hasura.Server.Migrate
|
||||
import Hasura.Server.Prometheus (makeDummyPrometheusMetrics)
|
||||
@ -107,20 +107,22 @@ main = do
|
||||
Options.EnableBigQueryStringNumericInput
|
||||
maintenanceMode = MaintenanceModeDisabled
|
||||
readOnlyMode = ReadOnlyModeDisabled
|
||||
serverConfigCtx =
|
||||
ServerConfigCtx
|
||||
staticConfig =
|
||||
CacheStaticConfig
|
||||
maintenanceMode
|
||||
EventingEnabled
|
||||
readOnlyMode
|
||||
(CheckFeatureFlag $ checkFeatureFlag mempty)
|
||||
dynamicConfig =
|
||||
CacheDynamicConfig
|
||||
Options.InferFunctionPermissions
|
||||
Options.DisableRemoteSchemaPermissions
|
||||
sqlGenCtx
|
||||
maintenanceMode
|
||||
mempty
|
||||
EventingEnabled
|
||||
readOnlyMode
|
||||
(_default defaultNamingConventionOption)
|
||||
emptyMetadataDefaults
|
||||
(CheckFeatureFlag $ FF.checkFeatureFlag mempty)
|
||||
ApolloFederationDisabled
|
||||
cacheBuildParams = CacheBuildParams httpManager (mkPgSourceResolver print) mkMSSQLSourceResolver
|
||||
cacheBuildParams = CacheBuildParams httpManager (mkPgSourceResolver print) mkMSSQLSourceResolver staticConfig
|
||||
|
||||
(_appInit, appEnv) <-
|
||||
lowerManagedT $
|
||||
@ -145,11 +147,11 @@ main = do
|
||||
snd
|
||||
<$> (liftEitherM . runExceptT . _pecRunTx pgContext (PGExecCtxInfo (Tx PG.ReadWrite Nothing) InternalRawQuery))
|
||||
(migrateCatalog (Just sourceConfig) defaultPostgresExtensionsSchema maintenanceMode =<< liftIO getCurrentTime)
|
||||
schemaCache <- runCacheBuild cacheBuildParams $ buildRebuildableSchemaCache logger envMap metadataWithVersion serverConfigCtx
|
||||
schemaCache <- runCacheBuild cacheBuildParams $ buildRebuildableSchemaCache logger envMap metadataWithVersion dynamicConfig
|
||||
pure (_mwrvMetadata metadataWithVersion, schemaCache)
|
||||
|
||||
cacheRef <- newMVar schemaCache
|
||||
pure $ NT (run . flip MigrateSuite.runCacheRefT (serverConfigCtx, cacheRef) . fmap fst . runMetadataT metadata emptyMetadataDefaults)
|
||||
pure $ NT (run . flip MigrateSuite.runCacheRefT (dynamicConfig, cacheRef) . fmap fst . runMetadataT metadata emptyMetadataDefaults)
|
||||
|
||||
streamingSubscriptionSuite <- StreamingSubscriptionSuite.buildStreamingSubscriptionSuite
|
||||
eventTriggerLogCleanupSuite <- EventTriggerCleanupSuite.buildEventTriggerCleanupSuite
|
||||
|
@ -22,6 +22,7 @@ import Hasura.RQL.DDL.EventTrigger (MonadEventLogCleanup (..))
|
||||
import Hasura.RQL.DDL.Metadata (ClearMetadata (..), runClearMetadata)
|
||||
import Hasura.RQL.DDL.Schema
|
||||
import Hasura.RQL.DDL.Schema.Cache.Common
|
||||
import Hasura.RQL.DDL.Schema.Cache.Config
|
||||
import Hasura.RQL.DDL.Schema.LegacyCatalog (recreateSystemMetadata)
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.SchemaCache
|
||||
@ -38,7 +39,7 @@ import Test.Hspec.Expectations.Lifted
|
||||
|
||||
-- -- NOTE: downgrade test disabled for now (see #5273)
|
||||
|
||||
newtype CacheRefT m a = CacheRefT {runCacheRefT :: (ServerConfigCtx, MVar RebuildableSchemaCache) -> m a}
|
||||
newtype CacheRefT m a = CacheRefT {runCacheRefT :: (CacheDynamicConfig, MVar RebuildableSchemaCache) -> m a}
|
||||
deriving
|
||||
( Functor,
|
||||
Applicative,
|
||||
@ -47,18 +48,16 @@ newtype CacheRefT m a = CacheRefT {runCacheRefT :: (ServerConfigCtx, MVar Rebuil
|
||||
MonadError e,
|
||||
MonadBase b,
|
||||
MonadBaseControl b,
|
||||
MonadReader (ServerConfigCtx, MVar RebuildableSchemaCache),
|
||||
MonadReader (CacheDynamicConfig, MVar RebuildableSchemaCache),
|
||||
MonadTx,
|
||||
HasCacheStaticConfig,
|
||||
UserInfoM,
|
||||
MonadMetadataStorage,
|
||||
MonadResolveSource,
|
||||
ProvidesNetwork,
|
||||
MonadGetApiTimeLimit
|
||||
)
|
||||
via (ReaderT (ServerConfigCtx, MVar RebuildableSchemaCache) m)
|
||||
|
||||
instance Monad m => HasServerConfigCtx (CacheRefT m) where
|
||||
askServerConfigCtx = asks fst
|
||||
via (ReaderT (CacheDynamicConfig, MVar RebuildableSchemaCache) m)
|
||||
|
||||
instance MonadTrans CacheRefT where
|
||||
lift = CacheRefT . const
|
||||
@ -80,20 +79,21 @@ instance
|
||||
MonadBaseControl IO m,
|
||||
MonadError QErr m,
|
||||
MonadResolveSource m,
|
||||
ProvidesNetwork m
|
||||
ProvidesNetwork m,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
CacheRWM (CacheRefT m)
|
||||
where
|
||||
buildSchemaCacheWithOptions reason invalidations metadata = do
|
||||
(serverConfigCtx, scVar) <- ask
|
||||
(dynamicConfig, scVar) <- ask
|
||||
modifyMVar scVar \schemaCache -> do
|
||||
((), cache, _) <- runCacheRWT serverConfigCtx schemaCache (buildSchemaCacheWithOptions reason invalidations metadata)
|
||||
((), cache, _) <- runCacheRWT dynamicConfig schemaCache (buildSchemaCacheWithOptions reason invalidations metadata)
|
||||
pure (cache, ())
|
||||
|
||||
setMetadataResourceVersionInSchemaCache resourceVersion = do
|
||||
(serverConfigCtx, scVar) <- ask
|
||||
(dynamicConfig, scVar) <- ask
|
||||
modifyMVar scVar \schemaCache -> do
|
||||
((), cache, _) <- runCacheRWT serverConfigCtx schemaCache (setMetadataResourceVersionInSchemaCache resourceVersion)
|
||||
((), cache, _) <- runCacheRWT dynamicConfig schemaCache (setMetadataResourceVersionInSchemaCache resourceVersion)
|
||||
pure (cache, ())
|
||||
|
||||
instance Example (MetadataT (CacheRefT m) ()) where
|
||||
@ -114,7 +114,8 @@ suite ::
|
||||
MonadMetadataStorage m,
|
||||
MonadEventLogCleanup m,
|
||||
ProvidesNetwork m,
|
||||
MonadGetApiTimeLimit m
|
||||
MonadGetApiTimeLimit m,
|
||||
HasCacheStaticConfig m
|
||||
) =>
|
||||
PostgresConnConfiguration ->
|
||||
PGExecCtx ->
|
||||
@ -127,9 +128,9 @@ suite srcConfig pgExecCtx pgConnInfo = do
|
||||
liftIO $ putStrLn $ LBS.toString $ encode $ EngineLog t logLevel logType logDetail
|
||||
|
||||
migrateCatalogAndBuildCache env time = do
|
||||
serverConfigCtx <- askServerConfigCtx
|
||||
dynamicConfig <- asks fst
|
||||
(migrationResult, metadataWithVersion) <- runTx' pgExecCtx $ migrateCatalog (Just srcConfig) (ExtensionsSchema "public") MaintenanceModeDisabled time
|
||||
(,migrationResult) <$> runCacheBuildM (buildRebuildableSchemaCache logger env metadataWithVersion serverConfigCtx)
|
||||
(,migrationResult) <$> runCacheBuildM (buildRebuildableSchemaCache logger env metadataWithVersion dynamicConfig)
|
||||
|
||||
dropAndInit env time = lift do
|
||||
scVar <- asks snd
|
||||
|
Loading…
Reference in New Issue
Block a user