{-# LANGUAGE QuasiQuotes #-}

-- | Arg and Env Parsing for initialisation of the engine along with
-- corresponding logging and other helper functionality.
--
-- This module is intended as the interface for options parsing and
-- its submodules should not need to be imported directly.
module Hasura.Server.Init
  ( -- * Option Fetching and Merging
    mkHGEOptions,
    mkServeOptions,
    processPostgresConnInfo,

    -- * Metadata DB
    getDbId,
    getPgVersion,

    -- * Re-exports
    module Hasura.Server.Init.Config,
    module Hasura.Server.Init.Env,
    module Hasura.Server.Init.Arg,
    module Hasura.Server.Init.Logging,
    module Hasura.Server.Init.FeatureFlag,
  )
where

--------------------------------------------------------------------------------

import Data.HashSet qualified as HashSet
import Data.Text qualified as Text
import Database.PG.Query qualified as Query
import Hasura.Backends.Postgres.Connection qualified as Connection
import Hasura.Base.Error qualified as Error
import Hasura.GraphQL.ApolloFederation (getApolloFederationStatus)
import Hasura.GraphQL.Execute.Subscription.Options qualified as Subscription.Options
import Hasura.Logging qualified as Logging
import Hasura.Prelude
import Hasura.RQL.Types.Common qualified as Common
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Cors qualified as Cors
import Hasura.Server.Init.Arg
import Hasura.Server.Init.Config
import Hasura.Server.Init.Env
import Hasura.Server.Init.FeatureFlag
import Hasura.Server.Init.Logging
import Hasura.Server.Logging qualified as Server.Logging
import Hasura.Server.Types qualified as Types
import Network.WebSockets qualified as WebSockets
import Refined (unrefine)

--------------------------------------------------------------------------------
-- TODO(SOLOMON): Where does this note belong?

{- Note [ReadOnly Mode]
~~~~~~~~~~~~~~~~~~~~~~~~~

This mode starts the server in a (database) read-only mode. That is, only
read-only queries are allowed on users' database sources, and write
queries throw a runtime error. The use-case is for failsafe operations.
Metadata APIs are also disabled.

Following is the precise behaviour -
  1. For any GraphQL API (relay/hasura; http/websocket) - disable execution of
  mutations
  2. Metadata API is disabled
  3. /v2/query API - insert, delete, update, run_sql are disabled
  4. /v1/query API - insert, delete, update, run_sql are disabled
  5. No source catalog migrations are run
  6. During build schema cache phase, building event triggers are disabled (as
  they create corresponding database triggers)
-}

--------------------------------------------------------------------------------

-- | Query the Metadata DB for the Metadata DB UUID.
-- TODO: Move into a dedicated Metadata module (ala Pro).
getDbId :: Query.TxE Error.QErr Types.MetadataDbId
getDbId :: TxE QErr MetadataDbId
getDbId =
  Text -> MetadataDbId
Types.MetadataDbId
    (Text -> MetadataDbId)
-> (SingleRow (Identity Text) -> Text)
-> SingleRow (Identity Text)
-> MetadataDbId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity Text -> Text
forall a. Identity a -> a
runIdentity
    (Identity Text -> Text)
-> (SingleRow (Identity Text) -> Identity Text)
-> SingleRow (Identity Text)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity Text) -> Identity Text
forall a. SingleRow a -> a
Query.getRow
    (SingleRow (Identity Text) -> MetadataDbId)
-> TxET QErr IO (SingleRow (Identity Text))
-> TxE QErr MetadataDbId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query -> () -> Bool -> TxET QErr IO (SingleRow (Identity Text))
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Query.withQE
      PGTxErr -> QErr
Connection.defaultTxErrorHandler
      [Query.sql|
    SELECT (hasura_uuid :: text) FROM hdb_catalog.hdb_version
  |]
      ()
      Bool
False

getPgVersion :: Query.TxE Error.QErr Types.PGVersion
getPgVersion :: TxE QErr PGVersion
getPgVersion = Int -> PGVersion
Types.PGVersion (Int -> PGVersion) -> TxET QErr IO Int -> TxE QErr PGVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxET QErr IO Int
forall (m :: * -> *) e. MonadIO m => TxET e m Int
Query.serverVersion

--------------------------------------------------------------------------------

-- | Given the 'ServeOptionsRaw' parsed from the arg parser,
-- postprocess the db url and fetch env vars associated with the main
-- command parser, then process the subcommand raw values if
-- necessary.
mkHGEOptions ::
  (Logging.EnabledLogTypes impl) => HGEOptionsRaw (ServeOptionsRaw impl) -> WithEnv (HGEOptions (ServeOptions impl))
mkHGEOptions :: forall impl.
EnabledLogTypes impl =>
HGEOptionsRaw (ServeOptionsRaw impl)
-> WithEnv (HGEOptions (ServeOptions impl))
mkHGEOptions (HGEOptionsRaw PostgresConnInfo (Maybe PostgresConnInfoRaw)
rawDbUrl Maybe String
rawMetadataDbUrl HGECommand (ServeOptionsRaw impl)
rawCmd) = do
  PostgresConnInfo (Maybe UrlConf)
dbUrl <- PostgresConnInfo (Maybe PostgresConnInfoRaw)
-> WithEnv (PostgresConnInfo (Maybe UrlConf))
processPostgresConnInfo PostgresConnInfo (Maybe PostgresConnInfoRaw)
rawDbUrl
  Maybe String
metadataDbUrl <- Maybe String -> Option () -> WithEnvT Identity (Maybe String)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe String
rawMetadataDbUrl Option ()
metadataDbUrlOption
  HGECommand (ServeOptions impl)
cmd <- case HGECommand (ServeOptionsRaw impl)
rawCmd of
    HCServe ServeOptionsRaw impl
rso -> ServeOptions impl -> HGECommand (ServeOptions impl)
forall a. a -> HGECommand a
HCServe (ServeOptions impl -> HGECommand (ServeOptions impl))
-> WithEnvT Identity (ServeOptions impl)
-> WithEnvT Identity (HGECommand (ServeOptions impl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServeOptionsRaw impl -> WithEnvT Identity (ServeOptions impl)
forall impl.
EnabledLogTypes impl =>
ServeOptionsRaw impl -> WithEnv (ServeOptions impl)
mkServeOptions ServeOptionsRaw impl
rso
    HGECommand (ServeOptionsRaw impl)
HCExport -> HGECommand (ServeOptions impl)
-> WithEnvT Identity (HGECommand (ServeOptions impl))
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HGECommand (ServeOptions impl)
forall a. HGECommand a
HCExport
    HGECommand (ServeOptionsRaw impl)
HCClean -> HGECommand (ServeOptions impl)
-> WithEnvT Identity (HGECommand (ServeOptions impl))
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HGECommand (ServeOptions impl)
forall a. HGECommand a
HCClean
    HGECommand (ServeOptionsRaw impl)
HCVersion -> HGECommand (ServeOptions impl)
-> WithEnvT Identity (HGECommand (ServeOptions impl))
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HGECommand (ServeOptions impl)
forall a. HGECommand a
HCVersion
    HCDowngrade DowngradeOptions
tgt -> HGECommand (ServeOptions impl)
-> WithEnvT Identity (HGECommand (ServeOptions impl))
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DowngradeOptions -> HGECommand (ServeOptions impl)
forall a. DowngradeOptions -> HGECommand a
HCDowngrade DowngradeOptions
tgt)
  HGEOptions (ServeOptions impl)
-> WithEnv (HGEOptions (ServeOptions impl))
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HGEOptions (ServeOptions impl)
 -> WithEnv (HGEOptions (ServeOptions impl)))
-> HGEOptions (ServeOptions impl)
-> WithEnv (HGEOptions (ServeOptions impl))
forall a b. (a -> b) -> a -> b
$ PostgresConnInfo (Maybe UrlConf)
-> Maybe String
-> HGECommand (ServeOptions impl)
-> HGEOptions (ServeOptions impl)
forall impl.
PostgresConnInfo (Maybe UrlConf)
-> Maybe String -> HGECommand impl -> HGEOptions impl
HGEOptions PostgresConnInfo (Maybe UrlConf)
dbUrl Maybe String
metadataDbUrl HGECommand (ServeOptions impl)
cmd

-- | 'PostressConnInfo' is a a tuple of some @a@ with a 'Maybe Int'
-- representing the retries setting. This function thus takes a
-- retries setting and a 'PostgresConnInfoRaw' from the arg parser and
-- merges those results with the contents of their corresponding env
-- vars.
processPostgresConnInfo ::
  PostgresConnInfo (Maybe PostgresConnInfoRaw) ->
  WithEnv (PostgresConnInfo (Maybe Common.UrlConf))
processPostgresConnInfo :: PostgresConnInfo (Maybe PostgresConnInfoRaw)
-> WithEnv (PostgresConnInfo (Maybe UrlConf))
processPostgresConnInfo PostgresConnInfo {Maybe Int
Maybe PostgresConnInfoRaw
_pciDatabaseConn :: Maybe PostgresConnInfoRaw
_pciRetries :: Maybe Int
_pciDatabaseConn :: forall a. PostgresConnInfo a -> a
_pciRetries :: forall a. PostgresConnInfo a -> Maybe Int
..} = do
  Maybe Int
withEnvRetries <- Maybe Int -> Option () -> WithEnvT Identity (Maybe Int)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe Int
_pciRetries Option ()
retriesNumOption
  Maybe UrlConf
databaseUrl <- Maybe PostgresConnInfoRaw -> WithEnv (Maybe UrlConf)
rawConnInfoToUrlConf Maybe PostgresConnInfoRaw
_pciDatabaseConn
  PostgresConnInfo (Maybe UrlConf)
-> WithEnv (PostgresConnInfo (Maybe UrlConf))
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PostgresConnInfo (Maybe UrlConf)
 -> WithEnv (PostgresConnInfo (Maybe UrlConf)))
-> PostgresConnInfo (Maybe UrlConf)
-> WithEnv (PostgresConnInfo (Maybe UrlConf))
forall a b. (a -> b) -> a -> b
$ Maybe UrlConf -> Maybe Int -> PostgresConnInfo (Maybe UrlConf)
forall a. a -> Maybe Int -> PostgresConnInfo a
PostgresConnInfo Maybe UrlConf
databaseUrl Maybe Int
withEnvRetries

-- | A helper function for 'processPostgresConnInfo' which fetches
-- postgres connection info from the 'WithEnv' and merges it with the
-- arg parser result.
rawConnInfoToUrlConf :: Maybe PostgresConnInfoRaw -> WithEnv (Maybe Common.UrlConf)
rawConnInfoToUrlConf :: Maybe PostgresConnInfoRaw -> WithEnv (Maybe UrlConf)
rawConnInfoToUrlConf Maybe PostgresConnInfoRaw
maybeRawConnInfo = do
  [(String, String)]
env <- WithEnvT Identity [(String, String)]
forall r (m :: * -> *). MonadReader r m => m r
ask
  let databaseUrlEnvVar :: String
databaseUrlEnvVar = Option () -> String
forall def. Option def -> String
_envVar Option ()
databaseUrlOption
      hasDatabaseUrlEnv :: Bool
hasDatabaseUrlEnv = ((String, String) -> Bool) -> [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
databaseUrlEnvVar) (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
env

  Maybe UrlConf -> WithEnv (Maybe UrlConf)
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UrlConf -> WithEnv (Maybe UrlConf))
-> Maybe UrlConf -> WithEnv (Maybe UrlConf)
forall a b. (a -> b) -> a -> b
$ case Maybe PostgresConnInfoRaw
maybeRawConnInfo of
    -- If no --database-url or connection options provided in CLI command
    Maybe PostgresConnInfoRaw
Nothing ->
      if Bool
hasDatabaseUrlEnv
        then -- Consider env variable as is in order to store it as @`UrlConf`
        -- in default source configuration in metadata
          UrlConf -> Maybe UrlConf
forall a. a -> Maybe a
Just (UrlConf -> Maybe UrlConf) -> UrlConf -> Maybe UrlConf
forall a b. (a -> b) -> a -> b
$ Text -> UrlConf
Common.UrlFromEnv (Text -> UrlConf) -> Text -> UrlConf
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
databaseUrlEnvVar
        else Maybe UrlConf
forall a. Maybe a
Nothing
    Just PostgresConnInfoRaw
databaseConn ->
      UrlConf -> Maybe UrlConf
forall a. a -> Maybe a
Just (UrlConf -> Maybe UrlConf)
-> (Template -> UrlConf) -> Template -> Maybe UrlConf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputWebhook -> UrlConf
Common.UrlValue (InputWebhook -> UrlConf)
-> (Template -> InputWebhook) -> Template -> UrlConf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> InputWebhook
Common.InputWebhook (Template -> Maybe UrlConf) -> Template -> Maybe UrlConf
forall a b. (a -> b) -> a -> b
$ case PostgresConnInfoRaw
databaseConn of
        PGConnDatabaseUrl Template
urlTemplate -> Template
urlTemplate
        PGConnDetails PostgresConnDetailsRaw
connDetails -> PostgresConnDetailsRaw -> Template
rawConnDetailsToUrl PostgresConnDetailsRaw
connDetails

--------------------------------------------------------------------------------

-- | Merge the results of the serve subcommmand arg parser with
-- corresponding values from the 'WithEnv' context.
mkServeOptions :: forall impl. (Logging.EnabledLogTypes impl) => ServeOptionsRaw impl -> WithEnv (ServeOptions impl)
mkServeOptions :: forall impl.
EnabledLogTypes impl =>
ServeOptionsRaw impl -> WithEnv (ServeOptions impl)
mkServeOptions sor :: ServeOptionsRaw impl
sor@ServeOptionsRaw {Maybe Int
Maybe Text
Maybe HostPreference
Maybe (HashSet (EngineLogType impl))
Maybe (HashSet ExperimentalFeature)
Maybe (HashSet API)
Maybe TxIsolation
Maybe (Refined NonNegative Int)
Maybe (Refined NonNegative Milliseconds)
Maybe (Refined NonNegative Seconds)
Maybe (Refined Positive Int)
Maybe RefetchInterval
Maybe BatchSize
Maybe LogLevel
Maybe NamingCase
Maybe RoleName
Maybe InferFunctionPermissions
Maybe DangerouslyCollapseBooleans
Maybe ExtensionsSchema
Maybe CloseWebsocketsOnMetadataChangeStatus
Maybe ApolloFederationStatus
Maybe CorsConfig
Maybe JWTConfig
Maybe AdminSecretHash
Maybe MetadataDefaults
Maybe WSConnectionInitTimeout
Maybe KeepAliveDelay
Maybe OptionalInterval
Maybe Port
Maybe TelemetryStatus
Maybe AdminInternalErrorsStatus
CompressionOptions
RemoteSchemaPermissions
StringifyNumbers
MaintenanceMode ()
MetadataQueryLoggingMode
ConnParamsRaw
AuthHookRaw
WsReadCookieStatus
DevModeStatus
AllowListStatus
ConsoleStatus
rsoPort :: Maybe Port
rsoHost :: Maybe HostPreference
rsoConnParams :: ConnParamsRaw
rsoTxIso :: Maybe TxIsolation
rsoAdminSecret :: Maybe AdminSecretHash
rsoAuthHook :: AuthHookRaw
rsoJwtSecret :: Maybe JWTConfig
rsoUnAuthRole :: Maybe RoleName
rsoCorsConfig :: Maybe CorsConfig
rsoConsoleStatus :: ConsoleStatus
rsoConsoleAssetsDir :: Maybe Text
rsoConsoleSentryDsn :: Maybe Text
rsoEnableTelemetry :: Maybe TelemetryStatus
rsoWsReadCookie :: WsReadCookieStatus
rsoStringifyNum :: StringifyNumbers
rsoDangerousBooleanCollapse :: Maybe DangerouslyCollapseBooleans
rsoEnabledAPIs :: Maybe (HashSet API)
rsoMxRefetchInt :: Maybe RefetchInterval
rsoMxBatchSize :: Maybe BatchSize
rsoStreamingMxRefetchInt :: Maybe RefetchInterval
rsoStreamingMxBatchSize :: Maybe BatchSize
rsoEnableAllowList :: AllowListStatus
rsoEnabledLogTypes :: Maybe (HashSet (EngineLogType impl))
rsoLogLevel :: Maybe LogLevel
rsoDevMode :: DevModeStatus
rsoAdminInternalErrors :: Maybe AdminInternalErrorsStatus
rsoEventsHttpPoolSize :: Maybe (Refined Positive Int)
rsoEventsFetchInterval :: Maybe (Refined NonNegative Milliseconds)
rsoAsyncActionsFetchInterval :: Maybe OptionalInterval
rsoEnableRemoteSchemaPermissions :: RemoteSchemaPermissions
rsoWebSocketCompression :: CompressionOptions
rsoWebSocketKeepAlive :: Maybe KeepAliveDelay
rsoInferFunctionPermissions :: Maybe InferFunctionPermissions
rsoEnableMaintenanceMode :: MaintenanceMode ()
rsoSchemaPollInterval :: Maybe OptionalInterval
rsoExperimentalFeatures :: Maybe (HashSet ExperimentalFeature)
rsoEventsFetchBatchSize :: Maybe (Refined NonNegative Int)
rsoGracefulShutdownTimeout :: Maybe (Refined NonNegative Seconds)
rsoWebSocketConnectionInitTimeout :: Maybe WSConnectionInitTimeout
rsoEnableMetadataQueryLoggingEnv :: MetadataQueryLoggingMode
rsoDefaultNamingConvention :: Maybe NamingCase
rsoExtensionsSchema :: Maybe ExtensionsSchema
rsoMetadataDefaults :: Maybe MetadataDefaults
rsoApolloFederationStatus :: Maybe ApolloFederationStatus
rsoCloseWebsocketsOnMetadataChangeStatus :: Maybe CloseWebsocketsOnMetadataChangeStatus
rsoMaxTotalHeaderLength :: Maybe Int
rsoPort :: forall impl. ServeOptionsRaw impl -> Maybe Port
rsoHost :: forall impl. ServeOptionsRaw impl -> Maybe HostPreference
rsoConnParams :: forall impl. ServeOptionsRaw impl -> ConnParamsRaw
rsoTxIso :: forall impl. ServeOptionsRaw impl -> Maybe TxIsolation
rsoAdminSecret :: forall impl. ServeOptionsRaw impl -> Maybe AdminSecretHash
rsoAuthHook :: forall impl. ServeOptionsRaw impl -> AuthHookRaw
rsoJwtSecret :: forall impl. ServeOptionsRaw impl -> Maybe JWTConfig
rsoUnAuthRole :: forall impl. ServeOptionsRaw impl -> Maybe RoleName
rsoCorsConfig :: forall impl. ServeOptionsRaw impl -> Maybe CorsConfig
rsoConsoleStatus :: forall impl. ServeOptionsRaw impl -> ConsoleStatus
rsoConsoleAssetsDir :: forall impl. ServeOptionsRaw impl -> Maybe Text
rsoConsoleSentryDsn :: forall impl. ServeOptionsRaw impl -> Maybe Text
rsoEnableTelemetry :: forall impl. ServeOptionsRaw impl -> Maybe TelemetryStatus
rsoWsReadCookie :: forall impl. ServeOptionsRaw impl -> WsReadCookieStatus
rsoStringifyNum :: forall impl. ServeOptionsRaw impl -> StringifyNumbers
rsoDangerousBooleanCollapse :: forall impl.
ServeOptionsRaw impl -> Maybe DangerouslyCollapseBooleans
rsoEnabledAPIs :: forall impl. ServeOptionsRaw impl -> Maybe (HashSet API)
rsoMxRefetchInt :: forall impl. ServeOptionsRaw impl -> Maybe RefetchInterval
rsoMxBatchSize :: forall impl. ServeOptionsRaw impl -> Maybe BatchSize
rsoStreamingMxRefetchInt :: forall impl. ServeOptionsRaw impl -> Maybe RefetchInterval
rsoStreamingMxBatchSize :: forall impl. ServeOptionsRaw impl -> Maybe BatchSize
rsoEnableAllowList :: forall impl. ServeOptionsRaw impl -> AllowListStatus
rsoEnabledLogTypes :: forall impl.
ServeOptionsRaw impl -> Maybe (HashSet (EngineLogType impl))
rsoLogLevel :: forall impl. ServeOptionsRaw impl -> Maybe LogLevel
rsoDevMode :: forall impl. ServeOptionsRaw impl -> DevModeStatus
rsoAdminInternalErrors :: forall impl.
ServeOptionsRaw impl -> Maybe AdminInternalErrorsStatus
rsoEventsHttpPoolSize :: forall impl. ServeOptionsRaw impl -> Maybe (Refined Positive Int)
rsoEventsFetchInterval :: forall impl.
ServeOptionsRaw impl -> Maybe (Refined NonNegative Milliseconds)
rsoAsyncActionsFetchInterval :: forall impl. ServeOptionsRaw impl -> Maybe OptionalInterval
rsoEnableRemoteSchemaPermissions :: forall impl. ServeOptionsRaw impl -> RemoteSchemaPermissions
rsoWebSocketCompression :: forall impl. ServeOptionsRaw impl -> CompressionOptions
rsoWebSocketKeepAlive :: forall impl. ServeOptionsRaw impl -> Maybe KeepAliveDelay
rsoInferFunctionPermissions :: forall impl. ServeOptionsRaw impl -> Maybe InferFunctionPermissions
rsoEnableMaintenanceMode :: forall impl. ServeOptionsRaw impl -> MaintenanceMode ()
rsoSchemaPollInterval :: forall impl. ServeOptionsRaw impl -> Maybe OptionalInterval
rsoExperimentalFeatures :: forall impl.
ServeOptionsRaw impl -> Maybe (HashSet ExperimentalFeature)
rsoEventsFetchBatchSize :: forall impl.
ServeOptionsRaw impl -> Maybe (Refined NonNegative Int)
rsoGracefulShutdownTimeout :: forall impl.
ServeOptionsRaw impl -> Maybe (Refined NonNegative Seconds)
rsoWebSocketConnectionInitTimeout :: forall impl. ServeOptionsRaw impl -> Maybe WSConnectionInitTimeout
rsoEnableMetadataQueryLoggingEnv :: forall impl. ServeOptionsRaw impl -> MetadataQueryLoggingMode
rsoDefaultNamingConvention :: forall impl. ServeOptionsRaw impl -> Maybe NamingCase
rsoExtensionsSchema :: forall impl. ServeOptionsRaw impl -> Maybe ExtensionsSchema
rsoMetadataDefaults :: forall impl. ServeOptionsRaw impl -> Maybe MetadataDefaults
rsoApolloFederationStatus :: forall impl. ServeOptionsRaw impl -> Maybe ApolloFederationStatus
rsoCloseWebsocketsOnMetadataChangeStatus :: forall impl.
ServeOptionsRaw impl -> Maybe CloseWebsocketsOnMetadataChangeStatus
rsoMaxTotalHeaderLength :: forall impl. ServeOptionsRaw impl -> Maybe Int
..} = do
  Port
soPort <- Maybe Port -> Option Port -> WithEnvT Identity Port
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe Port
rsoPort Option Port
servePortOption
  HostPreference
soHost <- Maybe HostPreference
-> Option HostPreference -> WithEnvT Identity HostPreference
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe HostPreference
rsoHost Option HostPreference
serveHostOption
  ConnParams
soConnParams <- ConnParamsRaw -> WithEnvT Identity ConnParams
forall (m :: * -> *).
Monad m =>
ConnParamsRaw -> WithEnvT m ConnParams
mkConnParams ConnParamsRaw
rsoConnParams
  TxIsolation
soTxIso <- Maybe TxIsolation
-> Option TxIsolation -> WithEnvT Identity TxIsolation
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe TxIsolation
rsoTxIso Option TxIsolation
txIsolationOption
  HashSet AdminSecretHash
soAdminSecret <- HashSet AdminSecretHash
-> (AdminSecretHash -> HashSet AdminSecretHash)
-> Maybe AdminSecretHash
-> HashSet AdminSecretHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashSet AdminSecretHash
forall a. Monoid a => a
mempty (AdminSecretHash -> HashSet AdminSecretHash
forall a. Hashable a => a -> HashSet a
HashSet.singleton) (Maybe AdminSecretHash -> HashSet AdminSecretHash)
-> WithEnvT Identity (Maybe AdminSecretHash)
-> WithEnvT Identity (HashSet AdminSecretHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AdminSecretHash
-> [Option ()] -> WithEnvT Identity (Maybe AdminSecretHash)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> [Option ()] -> WithEnvT m (Maybe option)
withOptions Maybe AdminSecretHash
rsoAdminSecret [Option ()
adminSecretOption, Option ()
accessKeyOption]
  Maybe AuthHook
soAuthHook <- AuthHookRaw -> WithEnvT Identity (Maybe AuthHook)
forall (m :: * -> *).
Monad m =>
AuthHookRaw -> WithEnvT m (Maybe AuthHook)
mkAuthHook AuthHookRaw
rsoAuthHook
  [JWTConfig]
soJwtSecret <- Maybe JWTConfig -> [JWTConfig]
forall a. Maybe a -> [a]
maybeToList (Maybe JWTConfig -> [JWTConfig])
-> WithEnvT Identity (Maybe JWTConfig)
-> WithEnvT Identity [JWTConfig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe JWTConfig -> Option () -> WithEnvT Identity (Maybe JWTConfig)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe JWTConfig
rsoJwtSecret Option ()
jwtSecretOption
  Maybe RoleName
soUnAuthRole <- Maybe RoleName -> Option () -> WithEnvT Identity (Maybe RoleName)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe RoleName
rsoUnAuthRole Option ()
unAuthRoleOption
  CorsConfig
soCorsConfig <- ServeOptionsRaw impl
-> Maybe CorsConfig -> WithEnvT Identity CorsConfig
forall (m :: * -> *) imp.
Monad m =>
ServeOptionsRaw imp -> Maybe CorsConfig -> WithEnvT m CorsConfig
mkCorsConfig ServeOptionsRaw impl
sor Maybe CorsConfig
rsoCorsConfig
  ConsoleStatus
soConsoleStatus <- ConsoleStatus
-> (ConsoleStatus -> Bool, Bool -> ConsoleStatus)
-> Option ConsoleStatus
-> WithEnvT Identity ConsoleStatus
forall (m :: * -> *) a.
Monad m =>
a -> (a -> Bool, Bool -> a) -> Option a -> WithEnvT m a
withOptionSwitch' ConsoleStatus
rsoConsoleStatus (ConsoleStatus -> Bool
isConsoleEnabled, ConsoleStatus -> ConsoleStatus -> Bool -> ConsoleStatus
forall a. a -> a -> Bool -> a
bool ConsoleStatus
ConsoleDisabled ConsoleStatus
ConsoleEnabled) Option ConsoleStatus
enableConsoleOption
  Maybe Text
soConsoleAssetsDir <- Maybe Text -> Option () -> WithEnvT Identity (Maybe Text)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe Text
rsoConsoleAssetsDir Option ()
consoleAssetsDirOption
  Maybe Text
soConsoleSentryDsn <- Maybe Text -> Option () -> WithEnvT Identity (Maybe Text)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe Text
rsoConsoleSentryDsn Option ()
consoleSentryDsnOption
  TelemetryStatus
soEnableTelemetry <- Maybe TelemetryStatus
-> Option TelemetryStatus -> WithEnvT Identity TelemetryStatus
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe TelemetryStatus
rsoEnableTelemetry Option TelemetryStatus
enableTelemetryOption
  StringifyNumbers
soStringifyNum <-
    case StringifyNumbers
rsoStringifyNum of
      StringifyNumbers
Options.Don'tStringifyNumbers -> Maybe StringifyNumbers
-> Option StringifyNumbers -> WithEnvT Identity StringifyNumbers
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe StringifyNumbers
forall a. Maybe a
Nothing Option StringifyNumbers
stringifyNumOption
      StringifyNumbers
stringifyNums -> StringifyNumbers -> WithEnvT Identity StringifyNumbers
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StringifyNumbers
stringifyNums
  DangerouslyCollapseBooleans
soDangerousBooleanCollapse <- Maybe DangerouslyCollapseBooleans
-> Option DangerouslyCollapseBooleans
-> WithEnvT Identity DangerouslyCollapseBooleans
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe DangerouslyCollapseBooleans
rsoDangerousBooleanCollapse Option DangerouslyCollapseBooleans
dangerousBooleanCollapseOption
  HashSet API
soEnabledAPIs <- Maybe (HashSet API)
-> Option (HashSet API) -> WithEnvT Identity (HashSet API)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (HashSet API)
rsoEnabledAPIs Option (HashSet API)
enabledAPIsOption
  SubscriptionsOptions
soLiveQueryOpts <- do
    RefetchInterval
_lqoRefetchInterval <- Maybe RefetchInterval
-> Option RefetchInterval -> WithEnvT Identity RefetchInterval
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe RefetchInterval
rsoMxRefetchInt Option RefetchInterval
mxRefetchDelayOption
    BatchSize
_lqoBatchSize <- Maybe BatchSize -> Option BatchSize -> WithEnvT Identity BatchSize
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe BatchSize
rsoMxBatchSize Option BatchSize
mxBatchSizeOption
    SubscriptionsOptions -> WithEnvT Identity SubscriptionsOptions
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubscriptionsOptions -> WithEnvT Identity SubscriptionsOptions)
-> SubscriptionsOptions -> WithEnvT Identity SubscriptionsOptions
forall a b. (a -> b) -> a -> b
$ Subscription.Options.SubscriptionsOptions {RefetchInterval
BatchSize
_lqoRefetchInterval :: RefetchInterval
_lqoBatchSize :: BatchSize
_lqoBatchSize :: BatchSize
_lqoRefetchInterval :: RefetchInterval
..}
  SubscriptionsOptions
soStreamingQueryOpts <- do
    RefetchInterval
_lqoRefetchInterval <- Maybe RefetchInterval
-> Option RefetchInterval -> WithEnvT Identity RefetchInterval
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe RefetchInterval
rsoStreamingMxRefetchInt Option RefetchInterval
streamingMxRefetchDelayOption
    BatchSize
_lqoBatchSize <- Maybe BatchSize -> Option BatchSize -> WithEnvT Identity BatchSize
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe BatchSize
rsoStreamingMxBatchSize Option BatchSize
streamingMxBatchSizeOption
    SubscriptionsOptions -> WithEnvT Identity SubscriptionsOptions
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubscriptionsOptions -> WithEnvT Identity SubscriptionsOptions)
-> SubscriptionsOptions -> WithEnvT Identity SubscriptionsOptions
forall a b. (a -> b) -> a -> b
$ Subscription.Options.SubscriptionsOptions {RefetchInterval
BatchSize
_lqoBatchSize :: BatchSize
_lqoRefetchInterval :: RefetchInterval
_lqoRefetchInterval :: RefetchInterval
_lqoBatchSize :: BatchSize
..}
  AllowListStatus
soEnableAllowList <- AllowListStatus
-> (AllowListStatus -> Bool, Bool -> AllowListStatus)
-> Option AllowListStatus
-> WithEnvT Identity AllowListStatus
forall (m :: * -> *) a.
Monad m =>
a -> (a -> Bool, Bool -> a) -> Option a -> WithEnvT m a
withOptionSwitch' AllowListStatus
rsoEnableAllowList (AllowListStatus -> Bool
isAllowListEnabled, AllowListStatus -> AllowListStatus -> Bool -> AllowListStatus
forall a. a -> a -> Bool -> a
bool AllowListStatus
AllowListDisabled AllowListStatus
AllowListEnabled) Option AllowListStatus
enableAllowlistOption
  HashSet (EngineLogType impl)
soEnabledLogTypes <- Maybe (HashSet (EngineLogType impl))
-> Option (HashSet (EngineLogType impl))
-> WithEnvT Identity (HashSet (EngineLogType impl))
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (HashSet (EngineLogType impl))
rsoEnabledLogTypes (forall impl.
EnabledLogTypes impl =>
Option (HashSet (EngineLogType impl))
enabledLogsOption @impl)
  LogLevel
soLogLevel <- Maybe LogLevel -> Option LogLevel -> WithEnvT Identity LogLevel
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe LogLevel
rsoLogLevel Option LogLevel
logLevelOption
  DevModeStatus
soDevMode <- DevModeStatus
-> (DevModeStatus -> Bool, Bool -> DevModeStatus)
-> Option DevModeStatus
-> WithEnvT Identity DevModeStatus
forall (m :: * -> *) a.
Monad m =>
a -> (a -> Bool, Bool -> a) -> Option a -> WithEnvT m a
withOptionSwitch' DevModeStatus
rsoDevMode (DevModeStatus -> Bool
isDevModeEnabled, DevModeStatus -> DevModeStatus -> Bool -> DevModeStatus
forall a. a -> a -> Bool -> a
bool DevModeStatus
DevModeDisabled DevModeStatus
DevModeEnabled) Option DevModeStatus
graphqlDevModeOption
  AdminInternalErrorsStatus
soAdminInternalErrors <- Maybe AdminInternalErrorsStatus
-> Option AdminInternalErrorsStatus
-> WithEnvT Identity AdminInternalErrorsStatus
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe AdminInternalErrorsStatus
rsoAdminInternalErrors Option AdminInternalErrorsStatus
graphqlAdminInternalErrorsOption
  Refined Positive Int
soEventsHttpPoolSize <- Maybe (Refined Positive Int)
-> Option (Refined Positive Int)
-> WithEnvT Identity (Refined Positive Int)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (Refined Positive Int)
rsoEventsHttpPoolSize Option (Refined Positive Int)
graphqlEventsHttpPoolSizeOption
  Refined NonNegative Milliseconds
soEventsFetchInterval <- Maybe (Refined NonNegative Milliseconds)
-> Option (Refined NonNegative Milliseconds)
-> WithEnvT Identity (Refined NonNegative Milliseconds)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (Refined NonNegative Milliseconds)
rsoEventsFetchInterval Option (Refined NonNegative Milliseconds)
graphqlEventsFetchIntervalOption
  OptionalInterval
soAsyncActionsFetchInterval <- Maybe OptionalInterval
-> Option OptionalInterval -> WithEnvT Identity OptionalInterval
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe OptionalInterval
rsoAsyncActionsFetchInterval Option OptionalInterval
asyncActionsFetchIntervalOption
  RemoteSchemaPermissions
soEnableRemoteSchemaPermissions <-
    case RemoteSchemaPermissions
rsoEnableRemoteSchemaPermissions of
      RemoteSchemaPermissions
Options.DisableRemoteSchemaPermissions -> Maybe RemoteSchemaPermissions
-> Option RemoteSchemaPermissions
-> WithEnvT Identity RemoteSchemaPermissions
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe RemoteSchemaPermissions
forall a. Maybe a
Nothing Option RemoteSchemaPermissions
enableRemoteSchemaPermsOption
      RemoteSchemaPermissions
enableRemoteSchemaPermissions -> RemoteSchemaPermissions
-> WithEnvT Identity RemoteSchemaPermissions
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteSchemaPermissions
enableRemoteSchemaPermissions
  CompressionOptions
webSocketCompressionFromEnv <-
    CompressionOptions
-> (CompressionOptions -> Bool, Bool -> CompressionOptions)
-> Option CompressionOptions
-> WithEnvT Identity CompressionOptions
forall (m :: * -> *) a.
Monad m =>
a -> (a -> Bool, Bool -> a) -> Option a -> WithEnvT m a
withOptionSwitch' CompressionOptions
rsoWebSocketCompression (CompressionOptions -> Bool
isWebSocketCompressionEnabled, CompressionOptions
-> CompressionOptions -> Bool -> CompressionOptions
forall a. a -> a -> Bool -> a
bool CompressionOptions
WebSockets.NoCompression (PermessageDeflate -> CompressionOptions
WebSockets.PermessageDeflateCompression PermessageDeflate
WebSockets.defaultPermessageDeflate)) Option CompressionOptions
webSocketCompressionOption
  let soConnectionOptions :: ConnectionOptions
soConnectionOptions = ConnectionOptions
WebSockets.defaultConnectionOptions {connectionCompressionOptions :: CompressionOptions
WebSockets.connectionCompressionOptions = CompressionOptions
webSocketCompressionFromEnv}
  KeepAliveDelay
soWebSocketKeepAlive <- Maybe KeepAliveDelay
-> Option KeepAliveDelay -> WithEnvT Identity KeepAliveDelay
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe KeepAliveDelay
rsoWebSocketKeepAlive Option KeepAliveDelay
webSocketKeepAliveOption
  InferFunctionPermissions
soInferFunctionPermissions <- Maybe InferFunctionPermissions
-> Option InferFunctionPermissions
-> WithEnvT Identity InferFunctionPermissions
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe InferFunctionPermissions
rsoInferFunctionPermissions Option InferFunctionPermissions
inferFunctionPermsOption
  MaintenanceMode ()
soEnableMaintenanceMode <- case MaintenanceMode ()
rsoEnableMaintenanceMode of
    MaintenanceMode ()
Types.MaintenanceModeDisabled -> Maybe (MaintenanceMode ())
-> Option (MaintenanceMode ())
-> WithEnvT Identity (MaintenanceMode ())
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (MaintenanceMode ())
forall a. Maybe a
Nothing Option (MaintenanceMode ())
enableMaintenanceModeOption
    MaintenanceMode ()
maintenanceModeEnabled -> MaintenanceMode () -> WithEnvT Identity (MaintenanceMode ())
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MaintenanceMode ()
maintenanceModeEnabled
  OptionalInterval
soSchemaPollInterval <- Maybe OptionalInterval
-> Option OptionalInterval -> WithEnvT Identity OptionalInterval
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe OptionalInterval
rsoSchemaPollInterval Option OptionalInterval
schemaPollIntervalOption
  HashSet ExperimentalFeature
soExperimentalFeatures <- Maybe (HashSet ExperimentalFeature)
-> Option (HashSet ExperimentalFeature)
-> WithEnvT Identity (HashSet ExperimentalFeature)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (HashSet ExperimentalFeature)
rsoExperimentalFeatures Option (HashSet ExperimentalFeature)
experimentalFeaturesOption
  Refined NonNegative Int
soEventsFetchBatchSize <- Maybe (Refined NonNegative Int)
-> Option (Refined NonNegative Int)
-> WithEnvT Identity (Refined NonNegative Int)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (Refined NonNegative Int)
rsoEventsFetchBatchSize Option (Refined NonNegative Int)
eventsFetchBatchSizeOption
  Refined NonNegative Seconds
soGracefulShutdownTimeout <- Maybe (Refined NonNegative Seconds)
-> Option (Refined NonNegative Seconds)
-> WithEnvT Identity (Refined NonNegative Seconds)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (Refined NonNegative Seconds)
rsoGracefulShutdownTimeout Option (Refined NonNegative Seconds)
gracefulShutdownOption
  WSConnectionInitTimeout
soWebSocketConnectionInitTimeout <- Maybe WSConnectionInitTimeout
-> Option WSConnectionInitTimeout
-> WithEnvT Identity WSConnectionInitTimeout
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe WSConnectionInitTimeout
rsoWebSocketConnectionInitTimeout Option WSConnectionInitTimeout
webSocketConnectionInitTimeoutOption
  let soEventingMode :: EventingMode
soEventingMode = EventingMode
Types.EventingEnabled
  let soReadOnlyMode :: ReadOnlyMode
soReadOnlyMode = ReadOnlyMode
Types.ReadOnlyModeDisabled
  MetadataQueryLoggingMode
soEnableMetadataQueryLogging <- case MetadataQueryLoggingMode
rsoEnableMetadataQueryLoggingEnv of
    MetadataQueryLoggingMode
Server.Logging.MetadataQueryLoggingDisabled -> Maybe MetadataQueryLoggingMode
-> Option MetadataQueryLoggingMode
-> WithEnvT Identity MetadataQueryLoggingMode
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe MetadataQueryLoggingMode
forall a. Maybe a
Nothing Option MetadataQueryLoggingMode
enableMetadataQueryLoggingOption
    MetadataQueryLoggingMode
metadataQueryLoggingEnabled -> MetadataQueryLoggingMode
-> WithEnvT Identity MetadataQueryLoggingMode
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetadataQueryLoggingMode
metadataQueryLoggingEnabled
  NamingCase
soDefaultNamingConvention <- Maybe NamingCase
-> Option NamingCase -> WithEnvT Identity NamingCase
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe NamingCase
rsoDefaultNamingConvention Option NamingCase
defaultNamingConventionOption
  MetadataDefaults
soMetadataDefaults <- Maybe MetadataDefaults
-> Option MetadataDefaults -> WithEnvT Identity MetadataDefaults
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe MetadataDefaults
rsoMetadataDefaults Option MetadataDefaults
metadataDefaultsOption
  ExtensionsSchema
soExtensionsSchema <- Maybe ExtensionsSchema
-> Option ExtensionsSchema -> WithEnvT Identity ExtensionsSchema
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe ExtensionsSchema
rsoExtensionsSchema Option ExtensionsSchema
metadataDBExtensionsSchemaOption
  ApolloFederationStatus
soApolloFederationStatus <- do
    Maybe ApolloFederationStatus
apolloFederationStatusOptionM <- Maybe (Maybe ApolloFederationStatus)
-> Option (Maybe ApolloFederationStatus)
-> WithEnvT Identity (Maybe ApolloFederationStatus)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault (ApolloFederationStatus -> Maybe ApolloFederationStatus
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApolloFederationStatus -> Maybe ApolloFederationStatus)
-> Maybe ApolloFederationStatus
-> Maybe (Maybe ApolloFederationStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ApolloFederationStatus
rsoApolloFederationStatus) Option (Maybe ApolloFederationStatus)
apolloFederationStatusOption
    ApolloFederationStatus -> WithEnvT Identity ApolloFederationStatus
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApolloFederationStatus
 -> WithEnvT Identity ApolloFederationStatus)
-> ApolloFederationStatus
-> WithEnvT Identity ApolloFederationStatus
forall a b. (a -> b) -> a -> b
$ HashSet ExperimentalFeature
-> Maybe ApolloFederationStatus -> ApolloFederationStatus
getApolloFederationStatus HashSet ExperimentalFeature
soExperimentalFeatures Maybe ApolloFederationStatus
apolloFederationStatusOptionM
  CloseWebsocketsOnMetadataChangeStatus
soCloseWebsocketsOnMetadataChangeStatus <- do
    Maybe CloseWebsocketsOnMetadataChangeStatus
-> Option CloseWebsocketsOnMetadataChangeStatus
-> WithEnvT Identity CloseWebsocketsOnMetadataChangeStatus
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe CloseWebsocketsOnMetadataChangeStatus
rsoCloseWebsocketsOnMetadataChangeStatus Option CloseWebsocketsOnMetadataChangeStatus
closeWebsocketsOnMetadataChangeOption
  Int
soMaxTotalHeaderLength <- Maybe Int -> Option Int -> WithEnvT Identity Int
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe Int
rsoMaxTotalHeaderLength Option Int
maxTotalHeaderLengthOption
  ServeOptions impl -> WithEnv (ServeOptions impl)
forall a. a -> WithEnvT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServeOptions {Int
[JWTConfig]
Maybe Text
Maybe RoleName
Maybe AuthHook
HostPreference
HashSet (EngineLogType impl)
HashSet ExperimentalFeature
HashSet AdminSecretHash
HashSet API
TxIsolation
ConnParams
Refined NonNegative Int
Refined NonNegative Milliseconds
Refined NonNegative Seconds
Refined Positive Int
ConnectionOptions
SubscriptionsOptions
LogLevel
NamingCase
RemoteSchemaPermissions
InferFunctionPermissions
DangerouslyCollapseBooleans
StringifyNumbers
ExtensionsSchema
CloseWebsocketsOnMetadataChangeStatus
ApolloFederationStatus
EventingMode
ReadOnlyMode
MaintenanceMode ()
CorsConfig
MetadataQueryLoggingMode
MetadataDefaults
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
TelemetryStatus
DevModeStatus
AllowListStatus
AdminInternalErrorsStatus
ConsoleStatus
soPort :: Port
soHost :: HostPreference
soConnParams :: ConnParams
soTxIso :: TxIsolation
soAdminSecret :: HashSet AdminSecretHash
soAuthHook :: Maybe AuthHook
soJwtSecret :: [JWTConfig]
soUnAuthRole :: Maybe RoleName
soCorsConfig :: CorsConfig
soConsoleStatus :: ConsoleStatus
soConsoleAssetsDir :: Maybe Text
soConsoleSentryDsn :: Maybe Text
soEnableTelemetry :: TelemetryStatus
soStringifyNum :: StringifyNumbers
soDangerousBooleanCollapse :: DangerouslyCollapseBooleans
soEnabledAPIs :: HashSet API
soLiveQueryOpts :: SubscriptionsOptions
soStreamingQueryOpts :: SubscriptionsOptions
soEnableAllowList :: AllowListStatus
soEnabledLogTypes :: HashSet (EngineLogType impl)
soLogLevel :: LogLevel
soDevMode :: DevModeStatus
soAdminInternalErrors :: AdminInternalErrorsStatus
soEventsHttpPoolSize :: Refined Positive Int
soEventsFetchInterval :: Refined NonNegative Milliseconds
soAsyncActionsFetchInterval :: OptionalInterval
soEnableRemoteSchemaPermissions :: RemoteSchemaPermissions
soConnectionOptions :: ConnectionOptions
soWebSocketKeepAlive :: KeepAliveDelay
soInferFunctionPermissions :: InferFunctionPermissions
soEnableMaintenanceMode :: MaintenanceMode ()
soSchemaPollInterval :: OptionalInterval
soExperimentalFeatures :: HashSet ExperimentalFeature
soEventsFetchBatchSize :: Refined NonNegative Int
soGracefulShutdownTimeout :: Refined NonNegative Seconds
soWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
soEventingMode :: EventingMode
soReadOnlyMode :: ReadOnlyMode
soEnableMetadataQueryLogging :: MetadataQueryLoggingMode
soDefaultNamingConvention :: NamingCase
soMetadataDefaults :: MetadataDefaults
soExtensionsSchema :: ExtensionsSchema
soApolloFederationStatus :: ApolloFederationStatus
soCloseWebsocketsOnMetadataChangeStatus :: CloseWebsocketsOnMetadataChangeStatus
soMaxTotalHeaderLength :: Int
soPort :: Port
soHost :: HostPreference
soConnParams :: ConnParams
soTxIso :: TxIsolation
soAdminSecret :: HashSet AdminSecretHash
soAuthHook :: Maybe AuthHook
soJwtSecret :: [JWTConfig]
soUnAuthRole :: Maybe RoleName
soCorsConfig :: CorsConfig
soConsoleStatus :: ConsoleStatus
soConsoleAssetsDir :: Maybe Text
soConsoleSentryDsn :: Maybe Text
soEnableTelemetry :: TelemetryStatus
soStringifyNum :: StringifyNumbers
soDangerousBooleanCollapse :: DangerouslyCollapseBooleans
soEnabledAPIs :: HashSet API
soLiveQueryOpts :: SubscriptionsOptions
soStreamingQueryOpts :: SubscriptionsOptions
soEnableAllowList :: AllowListStatus
soEnabledLogTypes :: HashSet (EngineLogType impl)
soLogLevel :: LogLevel
soEventsHttpPoolSize :: Refined Positive Int
soEventsFetchInterval :: Refined NonNegative Milliseconds
soAsyncActionsFetchInterval :: OptionalInterval
soEnableRemoteSchemaPermissions :: RemoteSchemaPermissions
soConnectionOptions :: ConnectionOptions
soWebSocketKeepAlive :: KeepAliveDelay
soInferFunctionPermissions :: InferFunctionPermissions
soEnableMaintenanceMode :: MaintenanceMode ()
soSchemaPollInterval :: OptionalInterval
soExperimentalFeatures :: HashSet ExperimentalFeature
soEventsFetchBatchSize :: Refined NonNegative Int
soDevMode :: DevModeStatus
soAdminInternalErrors :: AdminInternalErrorsStatus
soGracefulShutdownTimeout :: Refined NonNegative Seconds
soWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
soEventingMode :: EventingMode
soReadOnlyMode :: ReadOnlyMode
soEnableMetadataQueryLogging :: MetadataQueryLoggingMode
soDefaultNamingConvention :: NamingCase
soExtensionsSchema :: ExtensionsSchema
soMetadataDefaults :: MetadataDefaults
soApolloFederationStatus :: ApolloFederationStatus
soCloseWebsocketsOnMetadataChangeStatus :: CloseWebsocketsOnMetadataChangeStatus
soMaxTotalHeaderLength :: Int
..}

-- | Fetch Postgres 'Query.ConnParams' components from the environment
-- and merge with the values consumed by the arg parser in
-- 'ConnParamsRaw'.
mkConnParams :: (Monad m) => ConnParamsRaw -> WithEnvT m Query.ConnParams
mkConnParams :: forall (m :: * -> *).
Monad m =>
ConnParamsRaw -> WithEnvT m ConnParams
mkConnParams ConnParamsRaw {Maybe Bool
Maybe (Refined NonNegative Int)
Maybe (Refined NonNegative NominalDiffTime)
rcpStripes :: Maybe (Refined NonNegative Int)
rcpConns :: Maybe (Refined NonNegative Int)
rcpIdleTime :: Maybe (Refined NonNegative Int)
rcpConnLifetime :: Maybe (Refined NonNegative NominalDiffTime)
rcpAllowPrepare :: Maybe Bool
rcpPoolTimeout :: Maybe (Refined NonNegative NominalDiffTime)
rcpStripes :: ConnParamsRaw -> Maybe (Refined NonNegative Int)
rcpConns :: ConnParamsRaw -> Maybe (Refined NonNegative Int)
rcpIdleTime :: ConnParamsRaw -> Maybe (Refined NonNegative Int)
rcpConnLifetime :: ConnParamsRaw -> Maybe (Refined NonNegative NominalDiffTime)
rcpAllowPrepare :: ConnParamsRaw -> Maybe Bool
rcpPoolTimeout :: ConnParamsRaw -> Maybe (Refined NonNegative NominalDiffTime)
..} = do
  Int
cpStripes <- Refined NonNegative Int -> Int
forall {k} (p :: k) x. Refined p x -> x
unrefine (Refined NonNegative Int -> Int)
-> WithEnvT m (Refined NonNegative Int) -> WithEnvT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Refined NonNegative Int)
-> Option (Refined NonNegative Int)
-> WithEnvT m (Refined NonNegative Int)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (Refined NonNegative Int)
rcpStripes Option (Refined NonNegative Int)
pgStripesOption
  -- Note: by Little's Law we can expect e.g. (with 50 max connections) a
  -- hard throughput cap at 1000RPS when db queries take 50ms on average:
  Int
cpConns <- Refined NonNegative Int -> Int
forall {k} (p :: k) x. Refined p x -> x
unrefine (Refined NonNegative Int -> Int)
-> WithEnvT m (Refined NonNegative Int) -> WithEnvT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Refined NonNegative Int)
-> Option (Refined NonNegative Int)
-> WithEnvT m (Refined NonNegative Int)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (Refined NonNegative Int)
rcpConns Option (Refined NonNegative Int)
pgConnsOption
  Int
cpIdleTime <- Refined NonNegative Int -> Int
forall {k} (p :: k) x. Refined p x -> x
unrefine (Refined NonNegative Int -> Int)
-> WithEnvT m (Refined NonNegative Int) -> WithEnvT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Refined NonNegative Int)
-> Option (Refined NonNegative Int)
-> WithEnvT m (Refined NonNegative Int)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (Refined NonNegative Int)
rcpIdleTime Option (Refined NonNegative Int)
pgTimeoutOption
  Bool
cpAllowPrepare <- Maybe Bool -> Option Bool -> WithEnvT m Bool
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe Bool
rcpAllowPrepare Option Bool
pgUsePreparedStatementsOption
  -- TODO: Add newtype to allow this:
  Maybe NominalDiffTime
cpMbLifetime <- do
    NominalDiffTime
lifetime <- Refined NonNegative NominalDiffTime -> NominalDiffTime
forall {k} (p :: k) x. Refined p x -> x
unrefine (Refined NonNegative NominalDiffTime -> NominalDiffTime)
-> WithEnvT m (Refined NonNegative NominalDiffTime)
-> WithEnvT m NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Refined NonNegative NominalDiffTime)
-> Option (Refined NonNegative NominalDiffTime)
-> WithEnvT m (Refined NonNegative NominalDiffTime)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe (Refined NonNegative NominalDiffTime)
rcpConnLifetime Option (Refined NonNegative NominalDiffTime)
pgConnLifetimeOption
    if NominalDiffTime
lifetime NominalDiffTime -> NominalDiffTime -> Bool
forall a. Eq a => a -> a -> Bool
== NominalDiffTime
0
      then Maybe NominalDiffTime -> WithEnvT m (Maybe NominalDiffTime)
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NominalDiffTime
forall a. Maybe a
Nothing
      else Maybe NominalDiffTime -> WithEnvT m (Maybe NominalDiffTime)
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NominalDiffTime -> Maybe NominalDiffTime
forall a. a -> Maybe a
Just NominalDiffTime
lifetime)
  Maybe NominalDiffTime
cpTimeout <- (Refined NonNegative NominalDiffTime -> NominalDiffTime)
-> Maybe (Refined NonNegative NominalDiffTime)
-> Maybe NominalDiffTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Refined NonNegative NominalDiffTime -> NominalDiffTime
forall {k} (p :: k) x. Refined p x -> x
unrefine (Maybe (Refined NonNegative NominalDiffTime)
 -> Maybe NominalDiffTime)
-> WithEnvT m (Maybe (Refined NonNegative NominalDiffTime))
-> WithEnvT m (Maybe NominalDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Refined NonNegative NominalDiffTime)
-> Option ()
-> WithEnvT m (Maybe (Refined NonNegative NominalDiffTime))
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe (Refined NonNegative NominalDiffTime)
rcpPoolTimeout Option ()
pgPoolTimeoutOption
  let cpCancel :: Bool
cpCancel = Bool
True
  ConnParams -> WithEnvT m ConnParams
forall a. a -> WithEnvT m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (ConnParams -> WithEnvT m ConnParams)
-> ConnParams -> WithEnvT m ConnParams
forall a b. (a -> b) -> a -> b
$ Query.ConnParams {Bool
Int
Maybe NominalDiffTime
cpStripes :: Int
cpConns :: Int
cpIdleTime :: Int
cpAllowPrepare :: Bool
cpMbLifetime :: Maybe NominalDiffTime
cpTimeout :: Maybe NominalDiffTime
cpCancel :: Bool
cpStripes :: Int
cpConns :: Int
cpIdleTime :: Int
cpAllowPrepare :: Bool
cpMbLifetime :: Maybe NominalDiffTime
cpTimeout :: Maybe NominalDiffTime
cpCancel :: Bool
..}

-- | Fetch 'Auth.AuthHook' components from the environment and merge
-- with the values consumed by the arg parser in 'AuthHookRaw'.
mkAuthHook :: (Monad m) => AuthHookRaw -> WithEnvT m (Maybe Auth.AuthHook)
mkAuthHook :: forall (m :: * -> *).
Monad m =>
AuthHookRaw -> WithEnvT m (Maybe AuthHook)
mkAuthHook (AuthHookRaw Maybe Text
mUrl Maybe AuthHookType
mType Maybe Bool
mSendRequestBody) = do
  Maybe Text
mUrlEnv <- Maybe Text -> Option () -> WithEnvT m (Maybe Text)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe Text
mUrl Option ()
authHookOption
  -- Also support HASURA_GRAPHQL_AUTH_HOOK_TYPE
  -- TODO (from master):- drop this in next major update <--- (NOTE: This comment is from 2020-08-21)
  AuthHookType
authMode <-
    Maybe AuthHookType
-> WithEnvT m AuthHookType -> WithEnvT m AuthHookType
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
      Maybe AuthHookType
mType
      ( AuthHookType -> Maybe AuthHookType -> AuthHookType
forall a. a -> Maybe a -> a
fromMaybe (Option AuthHookType -> AuthHookType
forall def. Option def -> def
_default Option AuthHookType
authHookModeOption)
          (Maybe AuthHookType -> AuthHookType)
-> WithEnvT m (Maybe AuthHookType) -> WithEnvT m AuthHookType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> WithEnvT m (Maybe AuthHookType)
forall (m :: * -> *) a.
(Monad m, FromEnv a) =>
[String] -> WithEnvT m (Maybe a)
considerEnvs
            [Option AuthHookType -> String
forall def. Option def -> String
_envVar Option AuthHookType
authHookModeOption, String
"HASURA_GRAPHQL_AUTH_HOOK_TYPE"]
      )
  -- if authMode is `GET` then authSendRequestBody is set to `False`, otherwise we check for the config value
  Bool
authSendRequestBody <-
    case AuthHookType
authMode of
      AuthHookType
Auth.AHTGet -> Bool -> WithEnvT m Bool
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      AuthHookType
Auth.AHTPost ->
        Maybe Bool -> WithEnvT m Bool -> WithEnvT m Bool
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
          Maybe Bool
mSendRequestBody
          ( Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Option Bool -> Bool
forall def. Option def -> def
_default Option Bool
authHookSendRequestBodyOption)
              (Maybe Bool -> Bool) -> WithEnvT m (Maybe Bool) -> WithEnvT m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> WithEnvT m (Maybe Bool)
forall (m :: * -> *) a.
(Monad m, FromEnv a) =>
[String] -> WithEnvT m (Maybe a)
considerEnvs
                [Option Bool -> String
forall def. Option def -> String
_envVar Option Bool
authHookSendRequestBodyOption]
          )
  Maybe AuthHook -> WithEnvT m (Maybe AuthHook)
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AuthHook -> WithEnvT m (Maybe AuthHook))
-> Maybe AuthHook -> WithEnvT m (Maybe AuthHook)
forall a b. (a -> b) -> a -> b
$ (\Text
url -> Text -> AuthHookType -> Bool -> AuthHook
Auth.AuthHook Text
url AuthHookType
authMode Bool
authSendRequestBody) (Text -> AuthHook) -> Maybe Text -> Maybe AuthHook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mUrlEnv

-- | Fetch 'Cors.CorsConfig' settings from the environment and merge
-- with the settings consumed by the arg parser.
mkCorsConfig :: (Monad m) => ServeOptionsRaw imp -> Maybe Cors.CorsConfig -> WithEnvT m Cors.CorsConfig
mkCorsConfig :: forall (m :: * -> *) imp.
Monad m =>
ServeOptionsRaw imp -> Maybe CorsConfig -> WithEnvT m CorsConfig
mkCorsConfig ServeOptionsRaw {Maybe Int
Maybe Text
Maybe HostPreference
Maybe (HashSet (EngineLogType imp))
Maybe (HashSet ExperimentalFeature)
Maybe (HashSet API)
Maybe TxIsolation
Maybe (Refined NonNegative Int)
Maybe (Refined NonNegative Milliseconds)
Maybe (Refined NonNegative Seconds)
Maybe (Refined Positive Int)
Maybe RefetchInterval
Maybe BatchSize
Maybe LogLevel
Maybe NamingCase
Maybe RoleName
Maybe InferFunctionPermissions
Maybe DangerouslyCollapseBooleans
Maybe ExtensionsSchema
Maybe CloseWebsocketsOnMetadataChangeStatus
Maybe ApolloFederationStatus
Maybe CorsConfig
Maybe JWTConfig
Maybe AdminSecretHash
Maybe MetadataDefaults
Maybe WSConnectionInitTimeout
Maybe KeepAliveDelay
Maybe OptionalInterval
Maybe Port
Maybe TelemetryStatus
Maybe AdminInternalErrorsStatus
CompressionOptions
RemoteSchemaPermissions
StringifyNumbers
MaintenanceMode ()
MetadataQueryLoggingMode
ConnParamsRaw
AuthHookRaw
WsReadCookieStatus
DevModeStatus
AllowListStatus
ConsoleStatus
rsoPort :: forall impl. ServeOptionsRaw impl -> Maybe Port
rsoHost :: forall impl. ServeOptionsRaw impl -> Maybe HostPreference
rsoConnParams :: forall impl. ServeOptionsRaw impl -> ConnParamsRaw
rsoTxIso :: forall impl. ServeOptionsRaw impl -> Maybe TxIsolation
rsoAdminSecret :: forall impl. ServeOptionsRaw impl -> Maybe AdminSecretHash
rsoAuthHook :: forall impl. ServeOptionsRaw impl -> AuthHookRaw
rsoJwtSecret :: forall impl. ServeOptionsRaw impl -> Maybe JWTConfig
rsoUnAuthRole :: forall impl. ServeOptionsRaw impl -> Maybe RoleName
rsoCorsConfig :: forall impl. ServeOptionsRaw impl -> Maybe CorsConfig
rsoConsoleStatus :: forall impl. ServeOptionsRaw impl -> ConsoleStatus
rsoConsoleAssetsDir :: forall impl. ServeOptionsRaw impl -> Maybe Text
rsoConsoleSentryDsn :: forall impl. ServeOptionsRaw impl -> Maybe Text
rsoEnableTelemetry :: forall impl. ServeOptionsRaw impl -> Maybe TelemetryStatus
rsoWsReadCookie :: forall impl. ServeOptionsRaw impl -> WsReadCookieStatus
rsoStringifyNum :: forall impl. ServeOptionsRaw impl -> StringifyNumbers
rsoDangerousBooleanCollapse :: forall impl.
ServeOptionsRaw impl -> Maybe DangerouslyCollapseBooleans
rsoEnabledAPIs :: forall impl. ServeOptionsRaw impl -> Maybe (HashSet API)
rsoMxRefetchInt :: forall impl. ServeOptionsRaw impl -> Maybe RefetchInterval
rsoMxBatchSize :: forall impl. ServeOptionsRaw impl -> Maybe BatchSize
rsoStreamingMxRefetchInt :: forall impl. ServeOptionsRaw impl -> Maybe RefetchInterval
rsoStreamingMxBatchSize :: forall impl. ServeOptionsRaw impl -> Maybe BatchSize
rsoEnableAllowList :: forall impl. ServeOptionsRaw impl -> AllowListStatus
rsoEnabledLogTypes :: forall impl.
ServeOptionsRaw impl -> Maybe (HashSet (EngineLogType impl))
rsoLogLevel :: forall impl. ServeOptionsRaw impl -> Maybe LogLevel
rsoDevMode :: forall impl. ServeOptionsRaw impl -> DevModeStatus
rsoAdminInternalErrors :: forall impl.
ServeOptionsRaw impl -> Maybe AdminInternalErrorsStatus
rsoEventsHttpPoolSize :: forall impl. ServeOptionsRaw impl -> Maybe (Refined Positive Int)
rsoEventsFetchInterval :: forall impl.
ServeOptionsRaw impl -> Maybe (Refined NonNegative Milliseconds)
rsoAsyncActionsFetchInterval :: forall impl. ServeOptionsRaw impl -> Maybe OptionalInterval
rsoEnableRemoteSchemaPermissions :: forall impl. ServeOptionsRaw impl -> RemoteSchemaPermissions
rsoWebSocketCompression :: forall impl. ServeOptionsRaw impl -> CompressionOptions
rsoWebSocketKeepAlive :: forall impl. ServeOptionsRaw impl -> Maybe KeepAliveDelay
rsoInferFunctionPermissions :: forall impl. ServeOptionsRaw impl -> Maybe InferFunctionPermissions
rsoEnableMaintenanceMode :: forall impl. ServeOptionsRaw impl -> MaintenanceMode ()
rsoSchemaPollInterval :: forall impl. ServeOptionsRaw impl -> Maybe OptionalInterval
rsoExperimentalFeatures :: forall impl.
ServeOptionsRaw impl -> Maybe (HashSet ExperimentalFeature)
rsoEventsFetchBatchSize :: forall impl.
ServeOptionsRaw impl -> Maybe (Refined NonNegative Int)
rsoGracefulShutdownTimeout :: forall impl.
ServeOptionsRaw impl -> Maybe (Refined NonNegative Seconds)
rsoWebSocketConnectionInitTimeout :: forall impl. ServeOptionsRaw impl -> Maybe WSConnectionInitTimeout
rsoEnableMetadataQueryLoggingEnv :: forall impl. ServeOptionsRaw impl -> MetadataQueryLoggingMode
rsoDefaultNamingConvention :: forall impl. ServeOptionsRaw impl -> Maybe NamingCase
rsoExtensionsSchema :: forall impl. ServeOptionsRaw impl -> Maybe ExtensionsSchema
rsoMetadataDefaults :: forall impl. ServeOptionsRaw impl -> Maybe MetadataDefaults
rsoApolloFederationStatus :: forall impl. ServeOptionsRaw impl -> Maybe ApolloFederationStatus
rsoCloseWebsocketsOnMetadataChangeStatus :: forall impl.
ServeOptionsRaw impl -> Maybe CloseWebsocketsOnMetadataChangeStatus
rsoMaxTotalHeaderLength :: forall impl. ServeOptionsRaw impl -> Maybe Int
rsoPort :: Maybe Port
rsoHost :: Maybe HostPreference
rsoConnParams :: ConnParamsRaw
rsoTxIso :: Maybe TxIsolation
rsoAdminSecret :: Maybe AdminSecretHash
rsoAuthHook :: AuthHookRaw
rsoJwtSecret :: Maybe JWTConfig
rsoUnAuthRole :: Maybe RoleName
rsoCorsConfig :: Maybe CorsConfig
rsoConsoleStatus :: ConsoleStatus
rsoConsoleAssetsDir :: Maybe Text
rsoConsoleSentryDsn :: Maybe Text
rsoEnableTelemetry :: Maybe TelemetryStatus
rsoWsReadCookie :: WsReadCookieStatus
rsoStringifyNum :: StringifyNumbers
rsoDangerousBooleanCollapse :: Maybe DangerouslyCollapseBooleans
rsoEnabledAPIs :: Maybe (HashSet API)
rsoMxRefetchInt :: Maybe RefetchInterval
rsoMxBatchSize :: Maybe BatchSize
rsoStreamingMxRefetchInt :: Maybe RefetchInterval
rsoStreamingMxBatchSize :: Maybe BatchSize
rsoEnableAllowList :: AllowListStatus
rsoEnabledLogTypes :: Maybe (HashSet (EngineLogType imp))
rsoLogLevel :: Maybe LogLevel
rsoDevMode :: DevModeStatus
rsoAdminInternalErrors :: Maybe AdminInternalErrorsStatus
rsoEventsHttpPoolSize :: Maybe (Refined Positive Int)
rsoEventsFetchInterval :: Maybe (Refined NonNegative Milliseconds)
rsoAsyncActionsFetchInterval :: Maybe OptionalInterval
rsoEnableRemoteSchemaPermissions :: RemoteSchemaPermissions
rsoWebSocketCompression :: CompressionOptions
rsoWebSocketKeepAlive :: Maybe KeepAliveDelay
rsoInferFunctionPermissions :: Maybe InferFunctionPermissions
rsoEnableMaintenanceMode :: MaintenanceMode ()
rsoSchemaPollInterval :: Maybe OptionalInterval
rsoExperimentalFeatures :: Maybe (HashSet ExperimentalFeature)
rsoEventsFetchBatchSize :: Maybe (Refined NonNegative Int)
rsoGracefulShutdownTimeout :: Maybe (Refined NonNegative Seconds)
rsoWebSocketConnectionInitTimeout :: Maybe WSConnectionInitTimeout
rsoEnableMetadataQueryLoggingEnv :: MetadataQueryLoggingMode
rsoDefaultNamingConvention :: Maybe NamingCase
rsoExtensionsSchema :: Maybe ExtensionsSchema
rsoMetadataDefaults :: Maybe MetadataDefaults
rsoApolloFederationStatus :: Maybe ApolloFederationStatus
rsoCloseWebsocketsOnMetadataChangeStatus :: Maybe CloseWebsocketsOnMetadataChangeStatus
rsoMaxTotalHeaderLength :: Maybe Int
..} Maybe CorsConfig
mCfg = do
  CorsConfig
corsCfg <- do
    Bool
corsDisabled <- Maybe Bool -> Option Bool -> WithEnvT m Bool
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe Bool
forall a. Maybe a
Nothing Option Bool
disableCorsOption
    if Bool
corsDisabled
      then CorsConfig -> WithEnvT m CorsConfig
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> CorsConfig
Cors.CCDisabled (Bool -> CorsConfig) -> Bool -> CorsConfig
forall a b. (a -> b) -> a -> b
$ Option Bool -> Bool
forall def. Option def -> def
_default Option Bool
disableCorsOption)
      else Maybe CorsConfig -> Option CorsConfig -> WithEnvT m CorsConfig
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe CorsConfig
mCfg Option CorsConfig
corsDomainOption
  WsReadCookieStatus
readCookVal <-
    case WsReadCookieStatus
rsoWsReadCookie of
      WsReadCookieStatus
WsReadCookieDisabled -> Maybe WsReadCookieStatus
-> Option WsReadCookieStatus -> WithEnvT m WsReadCookieStatus
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe WsReadCookieStatus
forall a. Maybe a
Nothing Option WsReadCookieStatus
wsReadCookieOption
      WsReadCookieStatus
p -> WsReadCookieStatus -> WithEnvT m WsReadCookieStatus
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WsReadCookieStatus
p
  WsReadCookieStatus
wsReadCookie <- case (CorsConfig -> Bool
Cors.isCorsDisabled CorsConfig
corsCfg, WsReadCookieStatus
readCookVal) of
    (Bool
True, WsReadCookieStatus
_) -> WsReadCookieStatus -> WithEnvT m WsReadCookieStatus
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WsReadCookieStatus
readCookVal
    (Bool
False, WsReadCookieStatus
WsReadCookieEnabled) ->
      String -> WithEnvT m WsReadCookieStatus
forall a. String -> WithEnvT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        (String -> WithEnvT m WsReadCookieStatus)
-> String -> WithEnvT m WsReadCookieStatus
forall a b. (a -> b) -> a -> b
$ Option WsReadCookieStatus -> String
forall def. Option def -> String
_envVar Option WsReadCookieStatus
wsReadCookieOption
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" can only be used when CORS is disabled"
    (Bool
False, WsReadCookieStatus
WsReadCookieDisabled) -> WsReadCookieStatus -> WithEnvT m WsReadCookieStatus
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WsReadCookieStatus
WsReadCookieDisabled
  CorsConfig -> WithEnvT m CorsConfig
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CorsConfig -> WithEnvT m CorsConfig)
-> CorsConfig -> WithEnvT m CorsConfig
forall a b. (a -> b) -> a -> b
$ case CorsConfig
corsCfg of
    Cors.CCDisabled Bool
_ -> Bool -> CorsConfig
Cors.CCDisabled (Bool -> CorsConfig) -> Bool -> CorsConfig
forall a b. (a -> b) -> a -> b
$ WsReadCookieStatus -> Bool
isWsReadCookieEnabled WsReadCookieStatus
wsReadCookie
    CorsConfig
_ -> CorsConfig
corsCfg