{-# LANGUAGE TemplateHaskell #-}

-- | The Arg Opt.Parser for the 'serve' subcommand.
module Hasura.Server.Init.Arg.Command.Serve
  ( -- * Opt.Parser
    serveCommandParser,

    -- * Options
    servePortOption,
    serveHostOption,
    pgStripesOption,
    pgConnsOption,
    pgTimeoutOption,
    pgConnLifetimeOption,
    pgUsePreparedStatementsOption,
    pgPoolTimeoutOption,
    txIsolationOption,
    adminSecretOption,
    accessKeyOption,
    authHookOption,
    authHookModeOption,
    authHookSendRequestBodyOption,
    jwtSecretOption,
    unAuthRoleOption,
    corsDomainOption,
    disableCorsOption,
    enableConsoleOption,
    consoleAssetsDirOption,
    consoleSentryDsnOption,
    enableTelemetryOption,
    wsReadCookieOption,
    stringifyNumOption,
    dangerousBooleanCollapseOption,
    enabledAPIsOption,
    mxRefetchDelayOption,
    mxBatchSizeOption,
    streamingMxRefetchDelayOption,
    streamingMxBatchSizeOption,
    enableAllowlistOption,
    enabledLogsOption,
    logLevelOption,
    graphqlDevModeOption,
    graphqlAdminInternalErrorsOption,
    graphqlEventsHttpPoolSizeOption,
    graphqlEventsFetchIntervalOption,
    asyncActionsFetchIntervalOption,
    enableRemoteSchemaPermsOption,
    webSocketCompressionOption,
    webSocketKeepAliveOption,
    inferFunctionPermsOption,
    enableMaintenanceModeOption,
    schemaPollIntervalOption,
    experimentalFeaturesOption,
    eventsFetchBatchSizeOption,
    gracefulShutdownOption,
    webSocketConnectionInitTimeoutOption,
    enableMetadataQueryLoggingOption,
    defaultNamingConventionOption,
    metadataDBExtensionsSchemaOption,
    parseMetadataDefaults,
    metadataDefaultsOption,
    apolloFederationStatusOption,
    closeWebsocketsOnMetadataChangeOption,
    maxTotalHeaderLengthOption,

    -- * Pretty Printer
    serveCmdFooter,
  )
where

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

import Data.HashSet qualified as HashSet
import Data.Text qualified as Text
import Data.Time qualified as Time
import Database.PG.Query qualified as Query
import Hasura.Backends.Postgres.Connection.MonadTx qualified as MonadTx
import Hasura.Cache.Bounded qualified as Bounded
import Hasura.GraphQL.Execute.Subscription.Options qualified as Subscription.Options
import Hasura.Logging qualified as Logging
import Hasura.Prelude
import Hasura.RQL.Types.Metadata (MetadataDefaults, emptyMetadataDefaults)
import Hasura.RQL.Types.NamingCase qualified as NC
import Hasura.RQL.Types.Roles (RoleName)
import Hasura.RQL.Types.Roles qualified as Roles
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.PrettyPrinter qualified as PP
import Hasura.Server.Init.Config qualified as Config
import Hasura.Server.Init.Env qualified as Env
import Hasura.Server.Logging qualified as Server.Logging
import Hasura.Server.Types qualified as Types
import Network.Wai.Handler.Warp qualified as Warp
import Network.WebSockets qualified as WebSockets
import Options.Applicative qualified as Opt
import Refined (NonNegative, Positive, Refined, refineTH)
import Witch qualified

--------------------------------------------------------------------------------
-- Serve Command

serveCommandParser :: (Logging.EnabledLogTypes impl) => Opt.Parser (Config.ServeOptionsRaw impl)
serveCommandParser :: forall impl. EnabledLogTypes impl => Parser (ServeOptionsRaw impl)
serveCommandParser =
  Maybe Port
-> Maybe HostPreference
-> ConnParamsRaw
-> Maybe TxIsolation
-> Maybe AdminSecretHash
-> AuthHookRaw
-> Maybe JWTConfig
-> Maybe RoleName
-> Maybe CorsConfig
-> ConsoleStatus
-> Maybe Text
-> Maybe Text
-> Maybe TelemetryStatus
-> WsReadCookieStatus
-> StringifyNumbers
-> Maybe DangerouslyCollapseBooleans
-> Maybe (HashSet API)
-> Maybe RefetchInterval
-> Maybe BatchSize
-> Maybe RefetchInterval
-> Maybe BatchSize
-> AllowListStatus
-> Maybe (HashSet (EngineLogType impl))
-> Maybe LogLevel
-> DevModeStatus
-> Maybe AdminInternalErrorsStatus
-> Maybe (Refined Positive Int)
-> Maybe (Refined NonNegative Milliseconds)
-> Maybe OptionalInterval
-> RemoteSchemaPermissions
-> CompressionOptions
-> Maybe KeepAliveDelay
-> Maybe InferFunctionPermissions
-> MaintenanceMode ()
-> Maybe OptionalInterval
-> Maybe (HashSet ExperimentalFeature)
-> Maybe (Refined NonNegative Int)
-> Maybe (Refined NonNegative Seconds)
-> Maybe WSConnectionInitTimeout
-> MetadataQueryLoggingMode
-> Maybe NamingCase
-> Maybe ExtensionsSchema
-> Maybe MetadataDefaults
-> Maybe ApolloFederationStatus
-> Maybe CloseWebsocketsOnMetadataChangeStatus
-> Maybe Int
-> ServeOptionsRaw impl
forall impl.
Maybe Port
-> Maybe HostPreference
-> ConnParamsRaw
-> Maybe TxIsolation
-> Maybe AdminSecretHash
-> AuthHookRaw
-> Maybe JWTConfig
-> Maybe RoleName
-> Maybe CorsConfig
-> ConsoleStatus
-> Maybe Text
-> Maybe Text
-> Maybe TelemetryStatus
-> WsReadCookieStatus
-> StringifyNumbers
-> Maybe DangerouslyCollapseBooleans
-> Maybe (HashSet API)
-> Maybe RefetchInterval
-> Maybe BatchSize
-> Maybe RefetchInterval
-> Maybe BatchSize
-> AllowListStatus
-> Maybe (HashSet (EngineLogType impl))
-> Maybe LogLevel
-> DevModeStatus
-> Maybe AdminInternalErrorsStatus
-> Maybe (Refined Positive Int)
-> Maybe (Refined NonNegative Milliseconds)
-> Maybe OptionalInterval
-> RemoteSchemaPermissions
-> CompressionOptions
-> Maybe KeepAliveDelay
-> Maybe InferFunctionPermissions
-> MaintenanceMode ()
-> Maybe OptionalInterval
-> Maybe (HashSet ExperimentalFeature)
-> Maybe (Refined NonNegative Int)
-> Maybe (Refined NonNegative Seconds)
-> Maybe WSConnectionInitTimeout
-> MetadataQueryLoggingMode
-> Maybe NamingCase
-> Maybe ExtensionsSchema
-> Maybe MetadataDefaults
-> Maybe ApolloFederationStatus
-> Maybe CloseWebsocketsOnMetadataChangeStatus
-> Maybe Int
-> ServeOptionsRaw impl
Config.ServeOptionsRaw
    (Maybe Port
 -> Maybe HostPreference
 -> ConnParamsRaw
 -> Maybe TxIsolation
 -> Maybe AdminSecretHash
 -> AuthHookRaw
 -> Maybe JWTConfig
 -> Maybe RoleName
 -> Maybe CorsConfig
 -> ConsoleStatus
 -> Maybe Text
 -> Maybe Text
 -> Maybe TelemetryStatus
 -> WsReadCookieStatus
 -> StringifyNumbers
 -> Maybe DangerouslyCollapseBooleans
 -> Maybe (HashSet API)
 -> Maybe RefetchInterval
 -> Maybe BatchSize
 -> Maybe RefetchInterval
 -> Maybe BatchSize
 -> AllowListStatus
 -> Maybe (HashSet (EngineLogType impl))
 -> Maybe LogLevel
 -> DevModeStatus
 -> Maybe AdminInternalErrorsStatus
 -> Maybe (Refined Positive Int)
 -> Maybe (Refined NonNegative Milliseconds)
 -> Maybe OptionalInterval
 -> RemoteSchemaPermissions
 -> CompressionOptions
 -> Maybe KeepAliveDelay
 -> Maybe InferFunctionPermissions
 -> MaintenanceMode ()
 -> Maybe OptionalInterval
 -> Maybe (HashSet ExperimentalFeature)
 -> Maybe (Refined NonNegative Int)
 -> Maybe (Refined NonNegative Seconds)
 -> Maybe WSConnectionInitTimeout
 -> MetadataQueryLoggingMode
 -> Maybe NamingCase
 -> Maybe ExtensionsSchema
 -> Maybe MetadataDefaults
 -> Maybe ApolloFederationStatus
 -> Maybe CloseWebsocketsOnMetadataChangeStatus
 -> Maybe Int
 -> ServeOptionsRaw impl)
-> Parser (Maybe Port)
-> Parser
     (Maybe HostPreference
      -> ConnParamsRaw
      -> Maybe TxIsolation
      -> Maybe AdminSecretHash
      -> AuthHookRaw
      -> Maybe JWTConfig
      -> Maybe RoleName
      -> Maybe CorsConfig
      -> ConsoleStatus
      -> Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Port)
parseServerPort
    Parser
  (Maybe HostPreference
   -> ConnParamsRaw
   -> Maybe TxIsolation
   -> Maybe AdminSecretHash
   -> AuthHookRaw
   -> Maybe JWTConfig
   -> Maybe RoleName
   -> Maybe CorsConfig
   -> ConsoleStatus
   -> Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe HostPreference)
-> Parser
     (ConnParamsRaw
      -> Maybe TxIsolation
      -> Maybe AdminSecretHash
      -> AuthHookRaw
      -> Maybe JWTConfig
      -> Maybe RoleName
      -> Maybe CorsConfig
      -> ConsoleStatus
      -> Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe HostPreference)
parseServerHost
    Parser
  (ConnParamsRaw
   -> Maybe TxIsolation
   -> Maybe AdminSecretHash
   -> AuthHookRaw
   -> Maybe JWTConfig
   -> Maybe RoleName
   -> Maybe CorsConfig
   -> ConsoleStatus
   -> Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser ConnParamsRaw
-> Parser
     (Maybe TxIsolation
      -> Maybe AdminSecretHash
      -> AuthHookRaw
      -> Maybe JWTConfig
      -> Maybe RoleName
      -> Maybe CorsConfig
      -> ConsoleStatus
      -> Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConnParamsRaw
parseConnParams
    Parser
  (Maybe TxIsolation
   -> Maybe AdminSecretHash
   -> AuthHookRaw
   -> Maybe JWTConfig
   -> Maybe RoleName
   -> Maybe CorsConfig
   -> ConsoleStatus
   -> Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe TxIsolation)
-> Parser
     (Maybe AdminSecretHash
      -> AuthHookRaw
      -> Maybe JWTConfig
      -> Maybe RoleName
      -> Maybe CorsConfig
      -> ConsoleStatus
      -> Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe TxIsolation)
parseTxIsolation
    Parser
  (Maybe AdminSecretHash
   -> AuthHookRaw
   -> Maybe JWTConfig
   -> Maybe RoleName
   -> Maybe CorsConfig
   -> ConsoleStatus
   -> Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe AdminSecretHash)
-> Parser
     (AuthHookRaw
      -> Maybe JWTConfig
      -> Maybe RoleName
      -> Maybe CorsConfig
      -> ConsoleStatus
      -> Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser (Maybe AdminSecretHash)
parseAdminSecret Parser (Maybe AdminSecretHash)
-> Parser (Maybe AdminSecretHash) -> Parser (Maybe AdminSecretHash)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe AdminSecretHash)
parseAccessKey)
    Parser
  (AuthHookRaw
   -> Maybe JWTConfig
   -> Maybe RoleName
   -> Maybe CorsConfig
   -> ConsoleStatus
   -> Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser AuthHookRaw
-> Parser
     (Maybe JWTConfig
      -> Maybe RoleName
      -> Maybe CorsConfig
      -> ConsoleStatus
      -> Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AuthHookRaw
parseAuthHook
    Parser
  (Maybe JWTConfig
   -> Maybe RoleName
   -> Maybe CorsConfig
   -> ConsoleStatus
   -> Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe JWTConfig)
-> Parser
     (Maybe RoleName
      -> Maybe CorsConfig
      -> ConsoleStatus
      -> Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe JWTConfig)
parseJwtSecret
    Parser
  (Maybe RoleName
   -> Maybe CorsConfig
   -> ConsoleStatus
   -> Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe RoleName)
-> Parser
     (Maybe CorsConfig
      -> ConsoleStatus
      -> Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe RoleName)
parseUnAuthRole
    Parser
  (Maybe CorsConfig
   -> ConsoleStatus
   -> Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe CorsConfig)
-> Parser
     (ConsoleStatus
      -> Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe CorsConfig)
parseCorsConfig
    Parser
  (ConsoleStatus
   -> Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser ConsoleStatus
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConsoleStatus
parseEnableConsole
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Text)
parseConsoleAssetsDir
    Parser
  (Maybe Text
   -> Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe Text)
-> Parser
     (Maybe TelemetryStatus
      -> WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Text)
parseConsoleSentryDsn
    Parser
  (Maybe TelemetryStatus
   -> WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe TelemetryStatus)
-> Parser
     (WsReadCookieStatus
      -> StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe TelemetryStatus)
parseEnableTelemetry
    Parser
  (WsReadCookieStatus
   -> StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser WsReadCookieStatus
-> Parser
     (StringifyNumbers
      -> Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WsReadCookieStatus
parseWsReadCookie
    Parser
  (StringifyNumbers
   -> Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser StringifyNumbers
-> Parser
     (Maybe DangerouslyCollapseBooleans
      -> Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StringifyNumbers
parseStringifyNum
    Parser
  (Maybe DangerouslyCollapseBooleans
   -> Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe DangerouslyCollapseBooleans)
-> Parser
     (Maybe (HashSet API)
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DangerouslyCollapseBooleans)
parseDangerousBooleanCollapse
    Parser
  (Maybe (HashSet API)
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe (HashSet API))
-> Parser
     (Maybe RefetchInterval
      -> Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (HashSet API))
parseEnabledAPIs
    Parser
  (Maybe RefetchInterval
   -> Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe RefetchInterval)
-> Parser
     (Maybe BatchSize
      -> Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe RefetchInterval)
parseMxRefetchDelay
    Parser
  (Maybe BatchSize
   -> Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe BatchSize)
-> Parser
     (Maybe RefetchInterval
      -> Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe BatchSize)
parseMxBatchSize
    Parser
  (Maybe RefetchInterval
   -> Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe RefetchInterval)
-> Parser
     (Maybe BatchSize
      -> AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe RefetchInterval)
parseStreamingMxRefetchDelay
    Parser
  (Maybe BatchSize
   -> AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe BatchSize)
-> Parser
     (AllowListStatus
      -> Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe BatchSize)
parseStreamingMxBatchSize
    Parser
  (AllowListStatus
   -> Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser AllowListStatus
-> Parser
     (Maybe (HashSet (EngineLogType impl))
      -> Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AllowListStatus
parseEnableAllowlist
    Parser
  (Maybe (HashSet (EngineLogType impl))
   -> Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe (HashSet (EngineLogType impl)))
-> Parser
     (Maybe LogLevel
      -> DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (HashSet (EngineLogType impl)))
forall impl.
EnabledLogTypes impl =>
Parser (Maybe (HashSet (EngineLogType impl)))
parseEnabledLogs
    Parser
  (Maybe LogLevel
   -> DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe LogLevel)
-> Parser
     (DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe LogLevel)
parseLogLevel
    Parser
  (DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe CacheSize)
-> Parser
     (DevModeStatus
      -> Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Maybe CacheSize)
parsePlanCacheSize -- parsed (for backwards compatibility reasons) but ignored
    Parser
  (DevModeStatus
   -> Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser DevModeStatus
-> Parser
     (Maybe AdminInternalErrorsStatus
      -> Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DevModeStatus
parseGraphqlDevMode
    Parser
  (Maybe AdminInternalErrorsStatus
   -> Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe AdminInternalErrorsStatus)
-> Parser
     (Maybe (Refined Positive Int)
      -> Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe AdminInternalErrorsStatus)
parseGraphqlAdminInternalErrors
    Parser
  (Maybe (Refined Positive Int)
   -> Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe (Refined Positive Int))
-> Parser
     (Maybe (Refined NonNegative Milliseconds)
      -> Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Refined Positive Int))
parseGraphqlEventsHttpPoolSize
    Parser
  (Maybe (Refined NonNegative Milliseconds)
   -> Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe (Refined NonNegative Milliseconds))
-> Parser
     (Maybe OptionalInterval
      -> RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Refined NonNegative Milliseconds))
parseGraphqlEventsFetchInterval
    Parser
  (Maybe OptionalInterval
   -> RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe OptionalInterval)
-> Parser
     (RemoteSchemaPermissions
      -> CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OptionalInterval)
parseGraphqlAsyncActionsFetchInterval
    Parser
  (RemoteSchemaPermissions
   -> CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser RemoteSchemaPermissions
-> Parser
     (CompressionOptions
      -> Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RemoteSchemaPermissions
parseEnableRemoteSchemaPerms
    Parser
  (CompressionOptions
   -> Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser CompressionOptions
-> Parser
     (Maybe KeepAliveDelay
      -> Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CompressionOptions
parseWebSocketCompression
    Parser
  (Maybe KeepAliveDelay
   -> Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe KeepAliveDelay)
-> Parser
     (Maybe InferFunctionPermissions
      -> MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe KeepAliveDelay)
parseWebSocketKeepAlive
    Parser
  (Maybe InferFunctionPermissions
   -> MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe InferFunctionPermissions)
-> Parser
     (MaintenanceMode ()
      -> Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe InferFunctionPermissions)
parseInferFunctionPerms
    Parser
  (MaintenanceMode ()
   -> Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (MaintenanceMode ())
-> Parser
     (Maybe OptionalInterval
      -> Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (MaintenanceMode ())
parseEnableMaintenanceMode
    Parser
  (Maybe OptionalInterval
   -> Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe OptionalInterval)
-> Parser
     (Maybe (HashSet ExperimentalFeature)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OptionalInterval)
parseSchemaPollInterval
    Parser
  (Maybe (HashSet ExperimentalFeature)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe (HashSet ExperimentalFeature))
-> Parser
     (Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (HashSet ExperimentalFeature))
parseExperimentalFeatures
    Parser
  (Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe (Refined NonNegative Int))
-> Parser
     (Maybe (Refined NonNegative Seconds)
      -> Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Refined NonNegative Int))
parseEventsFetchBatchSize
    Parser
  (Maybe (Refined NonNegative Seconds)
   -> Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe (Refined NonNegative Seconds))
-> Parser
     (Maybe WSConnectionInitTimeout
      -> MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Refined NonNegative Seconds))
parseGracefulShutdownTimeout
    Parser
  (Maybe WSConnectionInitTimeout
   -> MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe WSConnectionInitTimeout)
-> Parser
     (MetadataQueryLoggingMode
      -> Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe WSConnectionInitTimeout)
parseWebSocketConnectionInitTimeout
    Parser
  (MetadataQueryLoggingMode
   -> Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser MetadataQueryLoggingMode
-> Parser
     (Maybe NamingCase
      -> Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MetadataQueryLoggingMode
parseEnableMetadataQueryLogging
    Parser
  (Maybe NamingCase
   -> Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe NamingCase)
-> Parser
     (Maybe ExtensionsSchema
      -> Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe NamingCase)
parseDefaultNamingConvention
    Parser
  (Maybe ExtensionsSchema
   -> Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe ExtensionsSchema)
-> Parser
     (Maybe MetadataDefaults
      -> Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe ExtensionsSchema)
parseExtensionsSchema
    Parser
  (Maybe MetadataDefaults
   -> Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe MetadataDefaults)
-> Parser
     (Maybe ApolloFederationStatus
      -> Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int
      -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe MetadataDefaults)
parseMetadataDefaults
    Parser
  (Maybe ApolloFederationStatus
   -> Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int
   -> ServeOptionsRaw impl)
-> Parser (Maybe ApolloFederationStatus)
-> Parser
     (Maybe CloseWebsocketsOnMetadataChangeStatus
      -> Maybe Int -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe ApolloFederationStatus)
parseApolloFederationStatus
    Parser
  (Maybe CloseWebsocketsOnMetadataChangeStatus
   -> Maybe Int -> ServeOptionsRaw impl)
-> Parser (Maybe CloseWebsocketsOnMetadataChangeStatus)
-> Parser (Maybe Int -> ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe CloseWebsocketsOnMetadataChangeStatus)
parseEnableCloseWebsocketsOnMetadataChange
    Parser (Maybe Int -> ServeOptionsRaw impl)
-> Parser (Maybe Int) -> Parser (ServeOptionsRaw impl)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Int)
parseMaxTotalHeaderLength

--------------------------------------------------------------------------------
-- Serve Options

parseServerPort :: Opt.Parser (Maybe Config.Port)
parseServerPort :: Parser (Maybe Port)
parseServerPort =
  Parser Port -> Parser (Maybe Port)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser Port -> Parser (Maybe Port))
-> Parser Port -> Parser (Maybe Port)
forall a b. (a -> b) -> a -> b
$ ReadM Port -> Mod OptionFields Port -> Parser Port
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String Port) -> ReadM Port
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String Port
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields Port
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"server-port"
          Mod OptionFields Port
-> Mod OptionFields Port -> Mod OptionFields Port
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Port
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<PORT>"
          Mod OptionFields Port
-> Mod OptionFields Port -> Mod OptionFields Port
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Port
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option Port -> String
forall def. Option def -> String
Config._helpMessage Option Port
servePortOption)
      )

servePortOption :: Config.Option Config.Port
servePortOption :: Option Port
servePortOption =
  Config.Option
    { _default :: Port
_default = Int -> Port
Config.unsafePort Int
8080,
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_SERVER_PORT",
      _helpMessage :: String
_helpMessage = String
"Port on which graphql-engine should be served (default: 8080)"
    }

parseServerHost :: Opt.Parser (Maybe Warp.HostPreference)
parseServerHost :: Parser (Maybe HostPreference)
parseServerHost =
  Parser HostPreference -> Parser (Maybe HostPreference)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser HostPreference -> Parser (Maybe HostPreference))
-> Parser HostPreference -> Parser (Maybe HostPreference)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields HostPreference -> Parser HostPreference
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      ( String -> Mod OptionFields HostPreference
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"server-host"
          Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields HostPreference
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<HOST>"
          Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields HostPreference
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option HostPreference -> String
forall def. Option def -> String
Config._helpMessage Option HostPreference
serveHostOption)
      )

serveHostOption :: Config.Option Warp.HostPreference
serveHostOption :: Option HostPreference
serveHostOption =
  Config.Option
    { _default :: HostPreference
_default = HostPreference
"*",
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_SERVER_HOST",
      _helpMessage :: String
_helpMessage = String
"Host on which graphql-engine will listen (default: *)"
    }

parseConnParams :: Opt.Parser Config.ConnParamsRaw
parseConnParams :: Parser ConnParamsRaw
parseConnParams =
  Maybe (Refined NonNegative Int)
-> Maybe (Refined NonNegative Int)
-> Maybe (Refined NonNegative Int)
-> Maybe (Refined NonNegative NominalDiffTime)
-> Maybe Bool
-> Maybe (Refined NonNegative NominalDiffTime)
-> ConnParamsRaw
Config.ConnParamsRaw (Maybe (Refined NonNegative Int)
 -> Maybe (Refined NonNegative Int)
 -> Maybe (Refined NonNegative Int)
 -> Maybe (Refined NonNegative NominalDiffTime)
 -> Maybe Bool
 -> Maybe (Refined NonNegative NominalDiffTime)
 -> ConnParamsRaw)
-> Parser (Maybe (Refined NonNegative Int))
-> Parser
     (Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative NominalDiffTime)
      -> Maybe Bool
      -> Maybe (Refined NonNegative NominalDiffTime)
      -> ConnParamsRaw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe (Refined NonNegative Int))
pgStripes Parser
  (Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative NominalDiffTime)
   -> Maybe Bool
   -> Maybe (Refined NonNegative NominalDiffTime)
   -> ConnParamsRaw)
-> Parser (Maybe (Refined NonNegative Int))
-> Parser
     (Maybe (Refined NonNegative Int)
      -> Maybe (Refined NonNegative NominalDiffTime)
      -> Maybe Bool
      -> Maybe (Refined NonNegative NominalDiffTime)
      -> ConnParamsRaw)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Refined NonNegative Int))
pgConns Parser
  (Maybe (Refined NonNegative Int)
   -> Maybe (Refined NonNegative NominalDiffTime)
   -> Maybe Bool
   -> Maybe (Refined NonNegative NominalDiffTime)
   -> ConnParamsRaw)
-> Parser (Maybe (Refined NonNegative Int))
-> Parser
     (Maybe (Refined NonNegative NominalDiffTime)
      -> Maybe Bool
      -> Maybe (Refined NonNegative NominalDiffTime)
      -> ConnParamsRaw)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Refined NonNegative Int))
pgIdleTimeout Parser
  (Maybe (Refined NonNegative NominalDiffTime)
   -> Maybe Bool
   -> Maybe (Refined NonNegative NominalDiffTime)
   -> ConnParamsRaw)
-> Parser (Maybe (Refined NonNegative NominalDiffTime))
-> Parser
     (Maybe Bool
      -> Maybe (Refined NonNegative NominalDiffTime) -> ConnParamsRaw)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Refined NonNegative NominalDiffTime))
pgConnLifetime Parser
  (Maybe Bool
   -> Maybe (Refined NonNegative NominalDiffTime) -> ConnParamsRaw)
-> Parser (Maybe Bool)
-> Parser
     (Maybe (Refined NonNegative NominalDiffTime) -> ConnParamsRaw)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
pgUsePreparedStatements Parser
  (Maybe (Refined NonNegative NominalDiffTime) -> ConnParamsRaw)
-> Parser (Maybe (Refined NonNegative NominalDiffTime))
-> Parser ConnParamsRaw
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Refined NonNegative NominalDiffTime))
pgPoolTimeout
  where
    pgStripes :: Opt.Parser (Maybe (Refined NonNegative Int))
    pgStripes :: Parser (Maybe (Refined NonNegative Int))
pgStripes =
      Parser (Refined NonNegative Int)
-> Parser (Maybe (Refined NonNegative Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser (Refined NonNegative Int)
 -> Parser (Maybe (Refined NonNegative Int)))
-> Parser (Refined NonNegative Int)
-> Parser (Maybe (Refined NonNegative Int))
forall a b. (a -> b) -> a -> b
$ ReadM (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Parser (Refined NonNegative Int)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ((String -> Either String (Refined NonNegative Int))
-> ReadM (Refined NonNegative Int)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Refined NonNegative Int)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
          ( String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"stripes"
              Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
's'
              Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<NO OF STRIPES>"
              Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (Refined NonNegative Int) -> String
forall def. Option def -> String
Config._helpMessage Option (Refined NonNegative Int)
pgStripesOption)
          )

    pgConns :: Opt.Parser (Maybe (Refined NonNegative Int))
    pgConns :: Parser (Maybe (Refined NonNegative Int))
pgConns =
      Parser (Refined NonNegative Int)
-> Parser (Maybe (Refined NonNegative Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser (Refined NonNegative Int)
 -> Parser (Maybe (Refined NonNegative Int)))
-> Parser (Refined NonNegative Int)
-> Parser (Maybe (Refined NonNegative Int))
forall a b. (a -> b) -> a -> b
$ ReadM (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Parser (Refined NonNegative Int)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ((String -> Either String (Refined NonNegative Int))
-> ReadM (Refined NonNegative Int)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Refined NonNegative Int)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
          ( String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"connections"
              Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'c'
              Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<NO OF CONNS>"
              Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (Refined NonNegative Int) -> String
forall def. Option def -> String
Config._helpMessage Option (Refined NonNegative Int)
pgConnsOption)
          )

    pgIdleTimeout :: Opt.Parser (Maybe (Refined NonNegative Int))
    pgIdleTimeout :: Parser (Maybe (Refined NonNegative Int))
pgIdleTimeout =
      Parser (Refined NonNegative Int)
-> Parser (Maybe (Refined NonNegative Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser (Refined NonNegative Int)
 -> Parser (Maybe (Refined NonNegative Int)))
-> Parser (Refined NonNegative Int)
-> Parser (Maybe (Refined NonNegative Int))
forall a b. (a -> b) -> a -> b
$ ReadM (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Parser (Refined NonNegative Int)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ((String -> Either String (Refined NonNegative Int))
-> ReadM (Refined NonNegative Int)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Refined NonNegative Int)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
          ( String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"timeout"
              Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<SECONDS>"
              Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (Refined NonNegative Int) -> String
forall def. Option def -> String
Config._helpMessage Option (Refined NonNegative Int)
pgTimeoutOption)
          )

    pgConnLifetime :: Opt.Parser (Maybe (Refined NonNegative Time.NominalDiffTime))
    pgConnLifetime :: Parser (Maybe (Refined NonNegative NominalDiffTime))
pgConnLifetime =
      Parser (Refined NonNegative NominalDiffTime)
-> Parser (Maybe (Refined NonNegative NominalDiffTime))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser (Refined NonNegative NominalDiffTime)
 -> Parser (Maybe (Refined NonNegative NominalDiffTime)))
-> Parser (Refined NonNegative NominalDiffTime)
-> Parser (Maybe (Refined NonNegative NominalDiffTime))
forall a b. (a -> b) -> a -> b
$ ReadM (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Parser (Refined NonNegative NominalDiffTime)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ((String -> Either String (Refined NonNegative NominalDiffTime))
-> ReadM (Refined NonNegative NominalDiffTime)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Refined NonNegative NominalDiffTime)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
          ( String -> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"conn-lifetime"
              Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<SECONDS>"
              Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (Refined NonNegative NominalDiffTime) -> String
forall def. Option def -> String
Config._helpMessage Option (Refined NonNegative NominalDiffTime)
pgConnLifetimeOption)
          )

    pgUsePreparedStatements :: Opt.Parser (Maybe Bool)
    pgUsePreparedStatements :: Parser (Maybe Bool)
pgUsePreparedStatements =
      Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser Bool -> Parser (Maybe Bool))
-> Parser Bool -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ ReadM Bool -> Mod OptionFields Bool -> Parser Bool
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ((String -> Either String Bool) -> ReadM Bool
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String Bool
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
          ( String -> Mod OptionFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"use-prepared-statements"
              Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Bool
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<true|false>"
              Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option Bool -> String
forall def. Option def -> String
Config._helpMessage Option Bool
pgUsePreparedStatementsOption)
          )

    pgPoolTimeout :: Opt.Parser (Maybe (Refined NonNegative Time.NominalDiffTime))
    pgPoolTimeout :: Parser (Maybe (Refined NonNegative NominalDiffTime))
pgPoolTimeout =
      Parser (Refined NonNegative NominalDiffTime)
-> Parser (Maybe (Refined NonNegative NominalDiffTime))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser (Refined NonNegative NominalDiffTime)
 -> Parser (Maybe (Refined NonNegative NominalDiffTime)))
-> Parser (Refined NonNegative NominalDiffTime)
-> Parser (Maybe (Refined NonNegative NominalDiffTime))
forall a b. (a -> b) -> a -> b
$ ReadM (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Parser (Refined NonNegative NominalDiffTime)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ((String -> Either String (Refined NonNegative NominalDiffTime))
-> ReadM (Refined NonNegative NominalDiffTime)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Refined NonNegative NominalDiffTime)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
          ( String -> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-timeout"
              Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<SECONDS>"
              Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
-> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative NominalDiffTime)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
pgPoolTimeoutOption)
          )

pgStripesOption :: Config.Option (Refined NonNegative Int)
pgStripesOption :: Option (Refined NonNegative Int)
pgStripesOption =
  Config.Option
    { _default :: Refined NonNegative Int
_default = $$(refineTH @NonNegative @Int 1),
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_PG_STRIPES",
      _helpMessage :: String
_helpMessage =
        String
"Number of stripes (distinct sub-pools) to maintain with Postgres (default: 1). "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"New connections will be taken from a particular stripe pseudo-randomly."
    }

pgConnsOption :: Config.Option (Refined NonNegative Int)
pgConnsOption :: Option (Refined NonNegative Int)
pgConnsOption =
  Config.Option
    { _default :: Refined NonNegative Int
_default = $$(refineTH @NonNegative @Int 50),
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_PG_CONNECTIONS",
      _helpMessage :: String
_helpMessage =
        String
"Maximum number of Postgres connections that can be opened per stripe (default: 50). "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"When the maximum is reached we will block until a new connection becomes available, "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"even if there is capacity in other stripes."
    }

pgTimeoutOption :: Config.Option (Refined NonNegative Int)
pgTimeoutOption :: Option (Refined NonNegative Int)
pgTimeoutOption =
  Config.Option
    { _default :: Refined NonNegative Int
_default = $$(refineTH @NonNegative @Int 180),
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_PG_TIMEOUT",
      _helpMessage :: String
_helpMessage = String
"Each connection's idle time before it is closed (default: 180 sec)"
    }

pgConnLifetimeOption :: Config.Option (Refined NonNegative Time.NominalDiffTime)
pgConnLifetimeOption :: Option (Refined NonNegative NominalDiffTime)
pgConnLifetimeOption =
  Config.Option
    { _default :: Refined NonNegative NominalDiffTime
_default = $$(refineTH @NonNegative @Time.NominalDiffTime 600),
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_PG_CONN_LIFETIME",
      _helpMessage :: String
_helpMessage =
        String
"Time from connection creation after which the connection should be destroyed and a new one "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"created. A value of 0 indicates we should never destroy an active connection. If 0 is "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"passed, memory from large query results may not be reclaimed. (default: 600 sec)"
    }

pgUsePreparedStatementsOption :: Config.Option Bool
pgUsePreparedStatementsOption :: Option Bool
pgUsePreparedStatementsOption =
  Config.Option
    { _default :: Bool
_default = Bool
True,
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_USE_PREPARED_STATEMENTS",
      _helpMessage :: String
_helpMessage = String
"Use prepared statements for queries (default: true)"
    }

pgPoolTimeoutOption :: Config.Option ()
pgPoolTimeoutOption :: Option ()
pgPoolTimeoutOption =
  Config.Option
    { _default :: ()
_default = (),
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_PG_POOL_TIMEOUT",
      _helpMessage :: String
_helpMessage = String
"How long to wait when acquiring a Postgres connection, in seconds (default: forever)."
    }

parseTxIsolation :: Opt.Parser (Maybe Query.TxIsolation)
parseTxIsolation :: Parser (Maybe TxIsolation)
parseTxIsolation =
  Parser TxIsolation -> Parser (Maybe TxIsolation)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser TxIsolation -> Parser (Maybe TxIsolation))
-> Parser TxIsolation -> Parser (Maybe TxIsolation)
forall a b. (a -> b) -> a -> b
$ ReadM TxIsolation
-> Mod OptionFields TxIsolation -> Parser TxIsolation
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String TxIsolation) -> ReadM TxIsolation
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String TxIsolation
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields TxIsolation
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-iso"
          Mod OptionFields TxIsolation
-> Mod OptionFields TxIsolation -> Mod OptionFields TxIsolation
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields TxIsolation
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'i'
          Mod OptionFields TxIsolation
-> Mod OptionFields TxIsolation -> Mod OptionFields TxIsolation
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIsolation
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<TXISO>"
          Mod OptionFields TxIsolation
-> Mod OptionFields TxIsolation -> Mod OptionFields TxIsolation
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIsolation
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option TxIsolation -> String
forall def. Option def -> String
Config._helpMessage Option TxIsolation
txIsolationOption)
      )

txIsolationOption :: Config.Option Query.TxIsolation
txIsolationOption :: Option TxIsolation
txIsolationOption =
  Config.Option
    { _default :: TxIsolation
Config._default = TxIsolation
Query.ReadCommitted,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_TX_ISOLATION",
      _helpMessage :: String
Config._helpMessage = String
"transaction isolation. read-committed / repeatable-read / serializable (default: read-commited)"
    }

parseAdminSecret :: Opt.Parser (Maybe Auth.AdminSecretHash)
parseAdminSecret :: Parser (Maybe AdminSecretHash)
parseAdminSecret =
  Parser AdminSecretHash -> Parser (Maybe AdminSecretHash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser AdminSecretHash -> Parser (Maybe AdminSecretHash))
-> Parser AdminSecretHash -> Parser (Maybe AdminSecretHash)
forall a b. (a -> b) -> a -> b
$ Text -> AdminSecretHash
Auth.hashAdminSecret
    (Text -> AdminSecretHash) -> Parser Text -> Parser AdminSecretHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      ( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"admin-secret"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADMIN SECRET KEY"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
adminSecretOption)
      )

adminSecretOption :: Config.Option ()
adminSecretOption :: Option ()
adminSecretOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ADMIN_SECRET",
      _helpMessage :: String
Config._helpMessage = String
"Admin Secret key, required to access this instance"
    }

parseAccessKey :: Opt.Parser (Maybe Auth.AdminSecretHash)
parseAccessKey :: Parser (Maybe AdminSecretHash)
parseAccessKey =
  Parser AdminSecretHash -> Parser (Maybe AdminSecretHash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser AdminSecretHash -> Parser (Maybe AdminSecretHash))
-> Parser AdminSecretHash -> Parser (Maybe AdminSecretHash)
forall a b. (a -> b) -> a -> b
$ Text -> AdminSecretHash
Auth.hashAdminSecret
    (Text -> AdminSecretHash) -> Parser Text -> Parser AdminSecretHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      ( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"access-key"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADMIN SECRET KEY (DEPRECATED: USE --admin-secret)"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
accessKeyOption)
      )

accessKeyOption :: Config.Option ()
accessKeyOption :: Option ()
accessKeyOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ACCESS_KEY",
      _helpMessage :: String
Config._helpMessage = String
"Admin secret key, required to access this instance (deprecated: use HASURA_GRAPHQL_ADMIN_SECRET instead)"
    }

parseAuthHook :: Opt.Parser Config.AuthHookRaw
parseAuthHook :: Parser AuthHookRaw
parseAuthHook =
  Maybe Text -> Maybe AuthHookType -> Maybe Bool -> AuthHookRaw
Config.AuthHookRaw (Maybe Text -> Maybe AuthHookType -> Maybe Bool -> AuthHookRaw)
-> Parser (Maybe Text)
-> Parser (Maybe AuthHookType -> Maybe Bool -> AuthHookRaw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Text)
url Parser (Maybe AuthHookType -> Maybe Bool -> AuthHookRaw)
-> Parser (Maybe AuthHookType)
-> Parser (Maybe Bool -> AuthHookRaw)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe AuthHookType)
urlType Parser (Maybe Bool -> AuthHookRaw)
-> Parser (Maybe Bool) -> Parser AuthHookRaw
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
sendRequestBody
  where
    url :: Parser (Maybe Text)
url =
      Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser Text -> Parser (Maybe Text))
-> Parser Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          ( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"auth-hook"
              Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<WEB HOOK URL>"
              Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
authHookOption)
          )
    urlType :: Parser (Maybe AuthHookType)
urlType =
      Parser AuthHookType -> Parser (Maybe AuthHookType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser AuthHookType -> Parser (Maybe AuthHookType))
-> Parser AuthHookType -> Parser (Maybe AuthHookType)
forall a b. (a -> b) -> a -> b
$ ReadM AuthHookType
-> Mod OptionFields AuthHookType -> Parser AuthHookType
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ((String -> Either String AuthHookType) -> ReadM AuthHookType
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String AuthHookType
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
          ( String -> Mod OptionFields AuthHookType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"auth-hook-mode"
              Mod OptionFields AuthHookType
-> Mod OptionFields AuthHookType -> Mod OptionFields AuthHookType
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AuthHookType
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<GET|POST>"
              Mod OptionFields AuthHookType
-> Mod OptionFields AuthHookType -> Mod OptionFields AuthHookType
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AuthHookType
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option AuthHookType -> String
forall def. Option def -> String
Config._helpMessage Option AuthHookType
authHookModeOption)
          )
    Parser (Maybe Bool)
sendRequestBody :: Opt.Parser (Maybe Bool) =
      Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser Bool -> Parser (Maybe Bool))
-> Parser Bool -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ ReadM Bool -> Mod OptionFields Bool -> Parser Bool
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ((String -> Either String Bool) -> ReadM Bool
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String Bool
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
          ( String -> Mod OptionFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"auth-hook-send-request-body"
              Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Bool
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<true|false>"
              Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option Bool -> String
forall def. Option def -> String
Config._helpMessage Option Bool
authHookSendRequestBodyOption)
          )

authHookOption :: Config.Option ()
authHookOption :: Option ()
authHookOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_AUTH_HOOK",
      _helpMessage :: String
Config._helpMessage = String
"URL of the authorization webhook required to authorize requests"
    }

authHookModeOption :: Config.Option Auth.AuthHookType
authHookModeOption :: Option AuthHookType
authHookModeOption =
  Config.Option
    { _default :: AuthHookType
Config._default = AuthHookType
Auth.AHTGet,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_AUTH_HOOK_MODE",
      _helpMessage :: String
Config._helpMessage = String
"HTTP method to use for authorization webhook (default: GET)"
    }

authHookSendRequestBodyOption :: Config.Option Bool
authHookSendRequestBodyOption :: Option Bool
authHookSendRequestBodyOption =
  Config.Option
    { _default :: Bool
Config._default = Bool
True,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_AUTH_HOOK_SEND_REQUEST_BODY",
      _helpMessage :: String
Config._helpMessage = String
"Send request body in POST method (default: true)"
    }

parseJwtSecret :: Opt.Parser (Maybe Auth.JWTConfig)
parseJwtSecret :: Parser (Maybe JWTConfig)
parseJwtSecret =
  Parser JWTConfig -> Parser (Maybe JWTConfig)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser JWTConfig -> Parser (Maybe JWTConfig))
-> Parser JWTConfig -> Parser (Maybe JWTConfig)
forall a b. (a -> b) -> a -> b
$ ReadM JWTConfig -> Mod OptionFields JWTConfig -> Parser JWTConfig
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String JWTConfig) -> ReadM JWTConfig
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String JWTConfig
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields JWTConfig
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"jwt-secret"
          Mod OptionFields JWTConfig
-> Mod OptionFields JWTConfig -> Mod OptionFields JWTConfig
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields JWTConfig
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<JSON CONFIG>"
          Mod OptionFields JWTConfig
-> Mod OptionFields JWTConfig -> Mod OptionFields JWTConfig
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields JWTConfig
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
jwtSecretOption)
      )

jwtSecretOption :: Config.Option ()
jwtSecretOption :: Option ()
jwtSecretOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_JWT_SECRET",
      _helpMessage :: String
Config._helpMessage =
        String
"The JSON containing type and the JWK used for verifying. e.g: "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`{\"type\": \"HS256\", \"key\": \"<your-hmac-shared-secret>\", \"claims_namespace\": \"<optional-custom-claims-key-name>\"}`,"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`{\"type\": \"RS256\", \"key\": \"<your-PEM-RSA-public-key>\", \"claims_namespace\": \"<optional-custom-claims-key-name>\"}`"
    }

parseUnAuthRole :: Opt.Parser (Maybe RoleName)
parseUnAuthRole :: Parser (Maybe RoleName)
parseUnAuthRole =
  (Maybe Text -> Maybe RoleName)
-> Parser (Maybe Text) -> Parser (Maybe RoleName)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Text -> Maybe RoleName
mkRoleName
    (Parser (Maybe Text) -> Parser (Maybe RoleName))
-> Parser (Maybe Text) -> Parser (Maybe RoleName)
forall a b. (a -> b) -> a -> b
$ Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser Text -> Parser (Maybe Text))
-> Parser Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      ( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"unauthorized-role"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<ROLE>"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
unAuthRoleOption)
      )
  where
    mkRoleName :: Maybe Text -> Maybe RoleName
mkRoleName Maybe Text
mText = Maybe Text
mText Maybe Text -> (Text -> Maybe RoleName) -> Maybe RoleName
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe RoleName
Roles.mkRoleName

unAuthRoleOption :: Config.Option ()
unAuthRoleOption :: Option ()
unAuthRoleOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_UNAUTHORIZED_ROLE",
      _helpMessage :: String
Config._helpMessage =
        String
"Unauthorized role, used when admin-secret is not sent in admin-secret only mode "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"or \"Authorization\" header is absent in JWT mode"
    }

parseCorsConfig :: Opt.Parser (Maybe Cors.CorsConfig)
parseCorsConfig :: Parser (Maybe CorsConfig)
parseCorsConfig = Bool -> Maybe CorsConfig -> Maybe CorsConfig
mapCC (Bool -> Maybe CorsConfig -> Maybe CorsConfig)
-> Parser Bool -> Parser (Maybe CorsConfig -> Maybe CorsConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
disableCors Parser (Maybe CorsConfig -> Maybe CorsConfig)
-> Parser (Maybe CorsConfig) -> Parser (Maybe CorsConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe CorsConfig)
corsDomain
  where
    corsDomain :: Parser (Maybe CorsConfig)
corsDomain =
      Parser CorsConfig -> Parser (Maybe CorsConfig)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser CorsConfig -> Parser (Maybe CorsConfig))
-> Parser CorsConfig -> Parser (Maybe CorsConfig)
forall a b. (a -> b) -> a -> b
$ ReadM CorsConfig
-> Mod OptionFields CorsConfig -> Parser CorsConfig
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ((String -> Either String CorsConfig) -> ReadM CorsConfig
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String CorsConfig
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
          ( String -> Mod OptionFields CorsConfig
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cors-domain"
              Mod OptionFields CorsConfig
-> Mod OptionFields CorsConfig -> Mod OptionFields CorsConfig
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields CorsConfig
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<DOMAINS>"
              Mod OptionFields CorsConfig
-> Mod OptionFields CorsConfig -> Mod OptionFields CorsConfig
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields CorsConfig
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option CorsConfig -> String
forall def. Option def -> String
Config._helpMessage Option CorsConfig
corsDomainOption)
          )

    disableCors :: Parser Bool
disableCors =
      Mod FlagFields Bool -> Parser Bool
Opt.switch
        ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"disable-cors"
            Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option Bool -> String
forall def. Option def -> String
Config._helpMessage Option Bool
disableCorsOption)
        )

    mapCC :: Bool -> Maybe CorsConfig -> Maybe CorsConfig
mapCC Bool
isDisabled Maybe CorsConfig
domains =
      Maybe CorsConfig -> Maybe CorsConfig -> Bool -> Maybe CorsConfig
forall a. a -> a -> Bool -> a
bool Maybe CorsConfig
domains (CorsConfig -> Maybe CorsConfig
forall a. a -> Maybe a
Just (CorsConfig -> Maybe CorsConfig) -> CorsConfig -> Maybe CorsConfig
forall a b. (a -> b) -> a -> b
$ Bool -> CorsConfig
Cors.CCDisabled Bool
False) Bool
isDisabled

corsDomainOption :: Config.Option Cors.CorsConfig
corsDomainOption :: Option CorsConfig
corsDomainOption =
  Config.Option
    { _default :: CorsConfig
Config._default = CorsConfig
Cors.CCAllowAll,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_CORS_DOMAIN",
      _helpMessage :: String
Config._helpMessage =
        String
"CSV of list of domains, excluding scheme (http/https) and including  port, "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"to allow CORS for. Wildcard domains are allowed. See docs for details."
    }

disableCorsOption :: Config.Option Bool
disableCorsOption :: Option Bool
disableCorsOption =
  Config.Option
    { _default :: Bool
Config._default = Bool
False,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_DISABLE_CORS",
      _helpMessage :: String
Config._helpMessage = String
"Disable CORS. Do not send any CORS headers on any request"
    }

parseEnableConsole :: Opt.Parser Config.ConsoleStatus
parseEnableConsole :: Parser ConsoleStatus
parseEnableConsole =
  (ConsoleStatus -> ConsoleStatus -> Bool -> ConsoleStatus
forall a. a -> a -> Bool -> a
bool ConsoleStatus
Config.ConsoleDisabled ConsoleStatus
Config.ConsoleEnabled)
    (Bool -> ConsoleStatus) -> Parser Bool -> Parser ConsoleStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"enable-console"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option ConsoleStatus -> String
forall def. Option def -> String
Config._helpMessage Option ConsoleStatus
enableConsoleOption)
      )

enableConsoleOption :: Config.Option Config.ConsoleStatus
enableConsoleOption :: Option ConsoleStatus
enableConsoleOption =
  Config.Option
    { _default :: ConsoleStatus
Config._default = ConsoleStatus
Config.ConsoleDisabled,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ENABLE_CONSOLE",
      _helpMessage :: String
Config._helpMessage = String
"Enable API Console (default: false)"
    }

parseConsoleAssetsDir :: Opt.Parser (Maybe Text)
parseConsoleAssetsDir :: Parser (Maybe Text)
parseConsoleAssetsDir =
  Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser Text -> Parser (Maybe Text))
-> Parser Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ReadM Text -> Mod OptionFields Text -> Parser Text
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String Text) -> ReadM Text
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String Text
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"console-assets-dir"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
consoleAssetsDirOption)
      )

consoleAssetsDirOption :: Config.Option ()
consoleAssetsDirOption :: Option ()
consoleAssetsDirOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_CONSOLE_ASSETS_DIR",
      _helpMessage :: String
Config._helpMessage =
        String
"A directory from which static assets required for console is served at"
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'/console/assets' path. Can be set to '/srv/console-assets' on the"
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" default docker image to disable loading assets from CDN."
    }

parseConsoleSentryDsn :: Opt.Parser (Maybe Text)
parseConsoleSentryDsn :: Parser (Maybe Text)
parseConsoleSentryDsn =
  Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser Text -> Parser (Maybe Text))
-> Parser Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ReadM Text -> Mod OptionFields Text -> Parser Text
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String Text) -> ReadM Text
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String Text
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"console-sentry-dsn"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
consoleSentryDsnOption)
      )

consoleSentryDsnOption :: Config.Option ()
consoleSentryDsnOption :: Option ()
consoleSentryDsnOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_CONSOLE_SENTRY_DSN",
      _helpMessage :: String
Config._helpMessage =
        String
"A Sentry DSN for reporting console errors"
    }

-- NOTE: Should this be an 'Opt.flag'?
parseEnableTelemetry :: Opt.Parser (Maybe Config.TelemetryStatus)
parseEnableTelemetry :: Parser (Maybe TelemetryStatus)
parseEnableTelemetry =
  Parser TelemetryStatus -> Parser (Maybe TelemetryStatus)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser TelemetryStatus -> Parser (Maybe TelemetryStatus))
-> Parser TelemetryStatus -> Parser (Maybe TelemetryStatus)
forall a b. (a -> b) -> a -> b
$ ReadM TelemetryStatus
-> Mod OptionFields TelemetryStatus -> Parser TelemetryStatus
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String TelemetryStatus) -> ReadM TelemetryStatus
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String TelemetryStatus
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields TelemetryStatus
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"enable-telemetry"
          Mod OptionFields TelemetryStatus
-> Mod OptionFields TelemetryStatus
-> Mod OptionFields TelemetryStatus
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TelemetryStatus
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option TelemetryStatus -> String
forall def. Option def -> String
Config._helpMessage Option TelemetryStatus
enableTelemetryOption)
      )

enableTelemetryOption :: Config.Option Config.TelemetryStatus
enableTelemetryOption :: Option TelemetryStatus
enableTelemetryOption =
  Config.Option
    { _default :: TelemetryStatus
_default = TelemetryStatus
Config.TelemetryEnabled,
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_ENABLE_TELEMETRY",
      _helpMessage :: String
_helpMessage = String
"Enable anonymous telemetry on the server and console. For more information, see: https://hasura.io/docs/latest/guides/telemetry (default: true)"
    }

parseWsReadCookie :: Opt.Parser Config.WsReadCookieStatus
parseWsReadCookie :: Parser WsReadCookieStatus
parseWsReadCookie =
  WsReadCookieStatus
-> WsReadCookieStatus -> Bool -> WsReadCookieStatus
forall a. a -> a -> Bool -> a
bool WsReadCookieStatus
Config.WsReadCookieDisabled WsReadCookieStatus
Config.WsReadCookieEnabled
    (Bool -> WsReadCookieStatus)
-> Parser Bool -> Parser WsReadCookieStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"ws-read-cookie"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option WsReadCookieStatus -> String
forall def. Option def -> String
Config._helpMessage Option WsReadCookieStatus
wsReadCookieOption)
      )

wsReadCookieOption :: Config.Option Config.WsReadCookieStatus
wsReadCookieOption :: Option WsReadCookieStatus
wsReadCookieOption =
  Config.Option
    { _default :: WsReadCookieStatus
Config._default = WsReadCookieStatus
Config.WsReadCookieDisabled,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_WS_READ_COOKIE",
      _helpMessage :: String
Config._helpMessage =
        String
"Read cookie on WebSocket initial handshake, even when CORS is disabled."
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" This can be a potential security flaw! Please make sure you know "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"what you're doing."
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" This configuration is only applicable when CORS is disabled."
    }

parseStringifyNum :: Opt.Parser Options.StringifyNumbers
parseStringifyNum :: Parser StringifyNumbers
parseStringifyNum =
  (Bool -> StringifyNumbers)
-> Parser Bool -> Parser StringifyNumbers
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StringifyNumbers -> StringifyNumbers -> Bool -> StringifyNumbers
forall a. a -> a -> Bool -> a
bool StringifyNumbers
Options.Don'tStringifyNumbers StringifyNumbers
Options.StringifyNumbers)
    (Parser Bool -> Parser StringifyNumbers)
-> Parser Bool -> Parser StringifyNumbers
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"stringify-numeric-types"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option StringifyNumbers -> String
forall def. Option def -> String
Config._helpMessage Option StringifyNumbers
stringifyNumOption)
      )

stringifyNumOption :: Config.Option Options.StringifyNumbers
stringifyNumOption :: Option StringifyNumbers
stringifyNumOption =
  Config.Option
    { _default :: StringifyNumbers
Config._default = StringifyNumbers
Options.Don'tStringifyNumbers,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_STRINGIFY_NUMERIC_TYPES",
      _helpMessage :: String
Config._helpMessage = String
"Stringify numeric types (default: false)"
    }

parseDangerousBooleanCollapse :: Opt.Parser (Maybe Options.DangerouslyCollapseBooleans)
parseDangerousBooleanCollapse :: Parser (Maybe DangerouslyCollapseBooleans)
parseDangerousBooleanCollapse =
  Parser DangerouslyCollapseBooleans
-> Parser (Maybe DangerouslyCollapseBooleans)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser DangerouslyCollapseBooleans
 -> Parser (Maybe DangerouslyCollapseBooleans))
-> Parser DangerouslyCollapseBooleans
-> Parser (Maybe DangerouslyCollapseBooleans)
forall a b. (a -> b) -> a -> b
$ ReadM DangerouslyCollapseBooleans
-> Mod OptionFields DangerouslyCollapseBooleans
-> Parser DangerouslyCollapseBooleans
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String DangerouslyCollapseBooleans)
-> ReadM DangerouslyCollapseBooleans
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String DangerouslyCollapseBooleans
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields DangerouslyCollapseBooleans
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"v1-boolean-null-collapse"
          Mod OptionFields DangerouslyCollapseBooleans
-> Mod OptionFields DangerouslyCollapseBooleans
-> Mod OptionFields DangerouslyCollapseBooleans
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields DangerouslyCollapseBooleans
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option DangerouslyCollapseBooleans -> String
forall def. Option def -> String
Config._helpMessage Option DangerouslyCollapseBooleans
dangerousBooleanCollapseOption)
      )

dangerousBooleanCollapseOption :: Config.Option Options.DangerouslyCollapseBooleans
dangerousBooleanCollapseOption :: Option DangerouslyCollapseBooleans
dangerousBooleanCollapseOption =
  Config.Option
    { _default :: DangerouslyCollapseBooleans
Config._default = DangerouslyCollapseBooleans
Options.Don'tDangerouslyCollapseBooleans,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_V1_BOOLEAN_NULL_COLLAPSE",
      _helpMessage :: String
Config._helpMessage =
        String
"Emulate V1's behaviour re. boolean expression, where an explicit 'null'"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" value will be interpreted to mean that the field should be ignored"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" [DEPRECATED, WILL BE REMOVED SOON] (default: false)"
    }

parseEnabledAPIs :: Opt.Parser (Maybe (HashSet Config.API))
parseEnabledAPIs :: Parser (Maybe (HashSet API))
parseEnabledAPIs =
  Parser (HashSet API) -> Parser (Maybe (HashSet API))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser (HashSet API) -> Parser (Maybe (HashSet API)))
-> Parser (HashSet API) -> Parser (Maybe (HashSet API))
forall a b. (a -> b) -> a -> b
$ ReadM (HashSet API)
-> Mod OptionFields (HashSet API) -> Parser (HashSet API)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (HashSet API)) -> ReadM (HashSet API)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (HashSet API)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields (HashSet API)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"enabled-apis"
          Mod OptionFields (HashSet API)
-> Mod OptionFields (HashSet API) -> Mod OptionFields (HashSet API)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (HashSet API)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (HashSet API) -> String
forall def. Option def -> String
Config._helpMessage Option (HashSet API)
enabledAPIsOption)
      )

enabledAPIsOption :: Config.Option (HashSet Config.API)
enabledAPIsOption :: Option (HashSet API)
enabledAPIsOption =
  Config.Option
    { _default :: HashSet API
Config._default = [API] -> HashSet API
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [API
Config.METADATA, API
Config.GRAPHQL, API
Config.PGDUMP, API
Config.CONFIG],
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ENABLED_APIS",
      _helpMessage :: String
Config._helpMessage = String
"Comma separated list of enabled APIs. (default: metadata,graphql,pgdump,config)"
    }

parseMxRefetchDelay :: Opt.Parser (Maybe Subscription.Options.RefetchInterval)
parseMxRefetchDelay :: Parser (Maybe RefetchInterval)
parseMxRefetchDelay =
  Parser RefetchInterval -> Parser (Maybe RefetchInterval)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser RefetchInterval -> Parser (Maybe RefetchInterval))
-> Parser RefetchInterval -> Parser (Maybe RefetchInterval)
forall a b. (a -> b) -> a -> b
$ ReadM RefetchInterval
-> Mod OptionFields RefetchInterval -> Parser RefetchInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String RefetchInterval) -> ReadM RefetchInterval
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String RefetchInterval
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields RefetchInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"live-queries-multiplexed-refetch-interval"
          Mod OptionFields RefetchInterval
-> Mod OptionFields RefetchInterval
-> Mod OptionFields RefetchInterval
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields RefetchInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<INTERVAL(ms)>"
          Mod OptionFields RefetchInterval
-> Mod OptionFields RefetchInterval
-> Mod OptionFields RefetchInterval
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields RefetchInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option RefetchInterval -> String
forall def. Option def -> String
Config._envVar Option RefetchInterval
mxRefetchDelayOption)
      )

mxRefetchDelayOption :: Config.Option Subscription.Options.RefetchInterval
mxRefetchDelayOption :: Option RefetchInterval
mxRefetchDelayOption =
  Config.Option
    { _default :: RefetchInterval
Config._default = Refined NonNegative DiffTime -> RefetchInterval
Subscription.Options.RefetchInterval $$(refineTH 1),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_LIVE_QUERIES_MULTIPLEXED_REFETCH_INTERVAL",
      _helpMessage :: String
Config._helpMessage =
        String
"results will only be sent once in this interval (in milliseconds) for "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"live queries which can be multiplexed. Default: 1000 (1sec)"
    }

parseMxBatchSize :: Opt.Parser (Maybe Subscription.Options.BatchSize)
parseMxBatchSize :: Parser (Maybe BatchSize)
parseMxBatchSize =
  Parser BatchSize -> Parser (Maybe BatchSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser BatchSize -> Parser (Maybe BatchSize))
-> Parser BatchSize -> Parser (Maybe BatchSize)
forall a b. (a -> b) -> a -> b
$ ReadM BatchSize -> Mod OptionFields BatchSize -> Parser BatchSize
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String BatchSize) -> ReadM BatchSize
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String BatchSize
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields BatchSize
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"live-queries-multiplexed-batch-size"
          Mod OptionFields BatchSize
-> Mod OptionFields BatchSize -> Mod OptionFields BatchSize
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields BatchSize
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"BATCH_SIZE"
          Mod OptionFields BatchSize
-> Mod OptionFields BatchSize -> Mod OptionFields BatchSize
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields BatchSize
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option BatchSize -> String
forall def. Option def -> String
Config._helpMessage Option BatchSize
mxBatchSizeOption)
      )

mxBatchSizeOption :: Config.Option Subscription.Options.BatchSize
mxBatchSizeOption :: Option BatchSize
mxBatchSizeOption =
  Config.Option
    { _default :: BatchSize
_default = Refined NonNegative Int -> BatchSize
Subscription.Options.BatchSize $$(refineTH 100),
      _envVar :: String
_envVar = String
"HASURA_GRAPHQL_LIVE_QUERIES_MULTIPLEXED_BATCH_SIZE",
      _helpMessage :: String
_helpMessage =
        String
"multiplexed live queries are split into batches of the specified "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"size. Default 100. "
    }

parseStreamingMxRefetchDelay :: Opt.Parser (Maybe Subscription.Options.RefetchInterval)
parseStreamingMxRefetchDelay :: Parser (Maybe RefetchInterval)
parseStreamingMxRefetchDelay =
  Parser RefetchInterval -> Parser (Maybe RefetchInterval)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser RefetchInterval -> Parser (Maybe RefetchInterval))
-> Parser RefetchInterval -> Parser (Maybe RefetchInterval)
forall a b. (a -> b) -> a -> b
$ ReadM RefetchInterval
-> Mod OptionFields RefetchInterval -> Parser RefetchInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String RefetchInterval) -> ReadM RefetchInterval
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String RefetchInterval
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields RefetchInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"streaming-queries-multiplexed-refetch-interval"
          Mod OptionFields RefetchInterval
-> Mod OptionFields RefetchInterval
-> Mod OptionFields RefetchInterval
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields RefetchInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<INTERVAL(ms)>"
          Mod OptionFields RefetchInterval
-> Mod OptionFields RefetchInterval
-> Mod OptionFields RefetchInterval
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields RefetchInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option RefetchInterval -> String
forall def. Option def -> String
Config._helpMessage Option RefetchInterval
streamingMxRefetchDelayOption)
      )

streamingMxRefetchDelayOption :: Config.Option Subscription.Options.RefetchInterval
streamingMxRefetchDelayOption :: Option RefetchInterval
streamingMxRefetchDelayOption =
  Config.Option
    { _default :: RefetchInterval
Config._default = Refined NonNegative DiffTime -> RefetchInterval
Subscription.Options.RefetchInterval $$(refineTH 1),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_STREAMING_QUERIES_MULTIPLEXED_REFETCH_INTERVAL",
      _helpMessage :: String
Config._helpMessage =
        String
"results will only be sent once in this interval (in milliseconds) for "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"streaming queries which can be multiplexed. Default: 1000 (1sec)"
    }

parseStreamingMxBatchSize :: Opt.Parser (Maybe Subscription.Options.BatchSize)
parseStreamingMxBatchSize :: Parser (Maybe BatchSize)
parseStreamingMxBatchSize =
  Parser BatchSize -> Parser (Maybe BatchSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser BatchSize -> Parser (Maybe BatchSize))
-> Parser BatchSize -> Parser (Maybe BatchSize)
forall a b. (a -> b) -> a -> b
$ ReadM BatchSize -> Mod OptionFields BatchSize -> Parser BatchSize
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String BatchSize) -> ReadM BatchSize
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String BatchSize
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields BatchSize
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"streaming-queries-multiplexed-batch-size"
          Mod OptionFields BatchSize
-> Mod OptionFields BatchSize -> Mod OptionFields BatchSize
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields BatchSize
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"BATCH_SIZE"
          Mod OptionFields BatchSize
-> Mod OptionFields BatchSize -> Mod OptionFields BatchSize
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields BatchSize
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option BatchSize -> String
forall def. Option def -> String
Config._helpMessage Option BatchSize
streamingMxBatchSizeOption)
      )

streamingMxBatchSizeOption :: Config.Option Subscription.Options.BatchSize
streamingMxBatchSizeOption :: Option BatchSize
streamingMxBatchSizeOption =
  Config.Option
    { _default :: BatchSize
Config._default = Refined NonNegative Int -> BatchSize
Subscription.Options.BatchSize $$(refineTH 100),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_STREAMING_QUERIES_MULTIPLEXED_BATCH_SIZE",
      _helpMessage :: String
Config._helpMessage =
        String
"multiplexed live queries are split into batches of the specified "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"size. Default 100. "
    }

parseEnableAllowlist :: Opt.Parser Config.AllowListStatus
parseEnableAllowlist :: Parser AllowListStatus
parseEnableAllowlist =
  AllowListStatus -> AllowListStatus -> Bool -> AllowListStatus
forall a. a -> a -> Bool -> a
bool AllowListStatus
Config.AllowListDisabled AllowListStatus
Config.AllowListEnabled
    (Bool -> AllowListStatus) -> Parser Bool -> Parser AllowListStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"enable-allowlist"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option AllowListStatus -> String
forall def. Option def -> String
Config._helpMessage Option AllowListStatus
enableAllowlistOption)
      )

enableAllowlistOption :: Config.Option Config.AllowListStatus
enableAllowlistOption :: Option AllowListStatus
enableAllowlistOption =
  Config.Option
    { _default :: AllowListStatus
Config._default = AllowListStatus
Config.AllowListDisabled,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ENABLE_ALLOWLIST",
      _helpMessage :: String
Config._helpMessage = String
"Only accept allowed GraphQL queries"
    }

parseEnabledLogs :: forall impl. (Logging.EnabledLogTypes impl) => Opt.Parser (Maybe (HashSet (Logging.EngineLogType impl)))
parseEnabledLogs :: forall impl.
EnabledLogTypes impl =>
Parser (Maybe (HashSet (EngineLogType impl)))
parseEnabledLogs =
  Parser (HashSet (EngineLogType impl))
-> Parser (Maybe (HashSet (EngineLogType impl)))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser (HashSet (EngineLogType impl))
 -> Parser (Maybe (HashSet (EngineLogType impl))))
-> Parser (HashSet (EngineLogType impl))
-> Parser (Maybe (HashSet (EngineLogType impl)))
forall a b. (a -> b) -> a -> b
$ ReadM (HashSet (EngineLogType impl))
-> Mod OptionFields (HashSet (EngineLogType impl))
-> Parser (HashSet (EngineLogType impl))
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (HashSet (EngineLogType impl)))
-> ReadM (HashSet (EngineLogType impl))
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (HashSet (EngineLogType impl))
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields (HashSet (EngineLogType impl))
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"enabled-log-types"
          Mod OptionFields (HashSet (EngineLogType impl))
-> Mod OptionFields (HashSet (EngineLogType impl))
-> Mod OptionFields (HashSet (EngineLogType impl))
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (HashSet (EngineLogType impl))
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (HashSet (EngineLogType impl)) -> String
forall def. Option def -> String
Config._helpMessage (forall impl.
EnabledLogTypes impl =>
Option (HashSet (EngineLogType impl))
enabledLogsOption @impl))
      )

enabledLogsOption :: (Logging.EnabledLogTypes impl) => Config.Option (HashSet (Logging.EngineLogType impl))
enabledLogsOption :: forall impl.
EnabledLogTypes impl =>
Option (HashSet (EngineLogType impl))
enabledLogsOption =
  Config.Option
    { _default :: HashSet (EngineLogType impl)
Config._default = HashSet (EngineLogType impl)
forall impl. EnabledLogTypes impl => HashSet (EngineLogType impl)
Logging.defaultEnabledLogTypes,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ENABLED_LOG_TYPES",
      _helpMessage :: String
Config._helpMessage =
        String
"Comma separated list of enabled log types "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"(default: "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
defaultLogTypes
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"(all: "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
allAllowedLogTypes
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
    }
  where
    defaultLogTypes :: String
defaultLogTypes = Text -> String
Text.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> String) -> [Text] -> String
forall a b. (a -> b) -> a -> b
$ forall target source. From source target => source -> target
Witch.into @Text (EngineLogType Hasura -> Text) -> [EngineLogType Hasura] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet (EngineLogType Hasura) -> [EngineLogType Hasura]
forall a. HashSet a -> [a]
HashSet.toList HashSet (EngineLogType Hasura)
Logging.defaultEnabledEngineLogTypes
    allAllowedLogTypes :: String
allAllowedLogTypes = Text -> String
Text.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> String) -> [Text] -> String
forall a b. (a -> b) -> a -> b
$ forall target source. From source target => source -> target
Witch.into @Text (EngineLogType Hasura -> Text) -> [EngineLogType Hasura] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EngineLogType Hasura]
Logging.userAllowedLogTypes

parseLogLevel :: Opt.Parser (Maybe Logging.LogLevel)
parseLogLevel :: Parser (Maybe LogLevel)
parseLogLevel =
  Parser LogLevel -> Parser (Maybe LogLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser LogLevel -> Parser (Maybe LogLevel))
-> Parser LogLevel -> Parser (Maybe LogLevel)
forall a b. (a -> b) -> a -> b
$ ReadM LogLevel -> Mod OptionFields LogLevel -> Parser LogLevel
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String LogLevel) -> ReadM LogLevel
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String LogLevel
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"log-level"
          Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields LogLevel
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option LogLevel -> String
forall def. Option def -> String
Config._helpMessage Option LogLevel
logLevelOption)
      )

logLevelOption :: Config.Option Logging.LogLevel
logLevelOption :: Option LogLevel
logLevelOption =
  Config.Option
    { _default :: LogLevel
Config._default = LogLevel
Logging.LevelInfo,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_LOG_LEVEL",
      _helpMessage :: String
Config._helpMessage = String
"Server log level (default: info) (all: error, warn, info, debug)"
    }

parsePlanCacheSize :: Opt.Parser (Maybe Bounded.CacheSize)
parsePlanCacheSize :: Parser (Maybe CacheSize)
parsePlanCacheSize =
  Parser CacheSize -> Parser (Maybe CacheSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser CacheSize -> Parser (Maybe CacheSize))
-> Parser CacheSize -> Parser (Maybe CacheSize)
forall a b. (a -> b) -> a -> b
$ ReadM CacheSize -> Mod OptionFields CacheSize -> Parser CacheSize
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String CacheSize) -> ReadM CacheSize
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String CacheSize
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields CacheSize
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"query-plan-cache-size"
          Mod OptionFields CacheSize
-> Mod OptionFields CacheSize -> Mod OptionFields CacheSize
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields CacheSize
forall (f :: * -> *) a. String -> Mod f a
Opt.help
            ( String
"[DEPRECATED: value ignored.] The maximum number of query plans "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"that can be cached, allowed values: 0-65535, "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"0 disables the cache. Default 4000"
            )
      )

parseGraphqlDevMode :: Opt.Parser Config.DevModeStatus
parseGraphqlDevMode :: Parser DevModeStatus
parseGraphqlDevMode =
  DevModeStatus -> DevModeStatus -> Bool -> DevModeStatus
forall a. a -> a -> Bool -> a
bool DevModeStatus
Config.DevModeDisabled DevModeStatus
Config.DevModeEnabled
    (Bool -> DevModeStatus) -> Parser Bool -> Parser DevModeStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"dev-mode"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option DevModeStatus -> String
forall def. Option def -> String
Config._helpMessage Option DevModeStatus
graphqlDevModeOption)
      )

graphqlDevModeOption :: Config.Option Config.DevModeStatus
graphqlDevModeOption :: Option DevModeStatus
graphqlDevModeOption =
  Config.Option
    { _default :: DevModeStatus
Config._default = DevModeStatus
Config.DevModeDisabled,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_DEV_MODE",
      _helpMessage :: String
Config._helpMessage = String
"Set dev mode for GraphQL requests; include 'internal' key in the errors extensions (if required) of the response"
    }

parseGraphqlAdminInternalErrors :: Opt.Parser (Maybe Config.AdminInternalErrorsStatus)
parseGraphqlAdminInternalErrors :: Parser (Maybe AdminInternalErrorsStatus)
parseGraphqlAdminInternalErrors =
  Parser AdminInternalErrorsStatus
-> Parser (Maybe AdminInternalErrorsStatus)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser AdminInternalErrorsStatus
 -> Parser (Maybe AdminInternalErrorsStatus))
-> Parser AdminInternalErrorsStatus
-> Parser (Maybe AdminInternalErrorsStatus)
forall a b. (a -> b) -> a -> b
$ ReadM AdminInternalErrorsStatus
-> Mod OptionFields AdminInternalErrorsStatus
-> Parser AdminInternalErrorsStatus
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String AdminInternalErrorsStatus)
-> ReadM AdminInternalErrorsStatus
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String AdminInternalErrorsStatus
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields AdminInternalErrorsStatus
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"admin-internal-errors"
          Mod OptionFields AdminInternalErrorsStatus
-> Mod OptionFields AdminInternalErrorsStatus
-> Mod OptionFields AdminInternalErrorsStatus
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AdminInternalErrorsStatus
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option AdminInternalErrorsStatus -> String
forall def. Option def -> String
Config._helpMessage Option AdminInternalErrorsStatus
graphqlAdminInternalErrorsOption)
      )

graphqlAdminInternalErrorsOption :: Config.Option Config.AdminInternalErrorsStatus
graphqlAdminInternalErrorsOption :: Option AdminInternalErrorsStatus
graphqlAdminInternalErrorsOption =
  Config.Option
    { -- Default to `true` to enable backwards compatibility
      _default :: AdminInternalErrorsStatus
Config._default = AdminInternalErrorsStatus
Config.AdminInternalErrorsEnabled,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ADMIN_INTERNAL_ERRORS",
      _helpMessage :: String
Config._helpMessage = String
"Enables including 'internal' information in an error response for requests made by an 'admin' (default: true)"
    }

parseGraphqlEventsHttpPoolSize :: Opt.Parser (Maybe (Refined Positive Int))
parseGraphqlEventsHttpPoolSize :: Parser (Maybe (Refined Positive Int))
parseGraphqlEventsHttpPoolSize =
  Parser (Refined Positive Int)
-> Parser (Maybe (Refined Positive Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser (Refined Positive Int)
 -> Parser (Maybe (Refined Positive Int)))
-> Parser (Refined Positive Int)
-> Parser (Maybe (Refined Positive Int))
forall a b. (a -> b) -> a -> b
$ ReadM (Refined Positive Int)
-> Mod OptionFields (Refined Positive Int)
-> Parser (Refined Positive Int)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Refined Positive Int))
-> ReadM (Refined Positive Int)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Refined Positive Int)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields (Refined Positive Int)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"events-http-pool-size"
          Mod OptionFields (Refined Positive Int)
-> Mod OptionFields (Refined Positive Int)
-> Mod OptionFields (Refined Positive Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined Positive Int)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar (Option (Refined Positive Int) -> String
forall def. Option def -> String
Config._envVar Option (Refined Positive Int)
graphqlEventsHttpPoolSizeOption)
          Mod OptionFields (Refined Positive Int)
-> Mod OptionFields (Refined Positive Int)
-> Mod OptionFields (Refined Positive Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined Positive Int)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (Refined Positive Int) -> String
forall def. Option def -> String
Config._helpMessage Option (Refined Positive Int)
graphqlEventsHttpPoolSizeOption)
      )

graphqlEventsHttpPoolSizeOption :: Config.Option (Refined Positive Int)
graphqlEventsHttpPoolSizeOption :: Option (Refined Positive Int)
graphqlEventsHttpPoolSizeOption =
  Config.Option
    { _default :: Refined Positive Int
Config._default = $$(refineTH @Positive @Int 100),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_EVENTS_HTTP_POOL_SIZE",
      _helpMessage :: String
Config._helpMessage = String
"Max event processing threads (default: 100)"
    }

parseGraphqlEventsFetchInterval :: Opt.Parser (Maybe (Refined NonNegative Milliseconds))
parseGraphqlEventsFetchInterval :: Parser (Maybe (Refined NonNegative Milliseconds))
parseGraphqlEventsFetchInterval =
  Parser (Refined NonNegative Milliseconds)
-> Parser (Maybe (Refined NonNegative Milliseconds))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser (Refined NonNegative Milliseconds)
 -> Parser (Maybe (Refined NonNegative Milliseconds)))
-> Parser (Refined NonNegative Milliseconds)
-> Parser (Maybe (Refined NonNegative Milliseconds))
forall a b. (a -> b) -> a -> b
$ ReadM (Refined NonNegative Milliseconds)
-> Mod OptionFields (Refined NonNegative Milliseconds)
-> Parser (Refined NonNegative Milliseconds)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Refined NonNegative Milliseconds))
-> ReadM (Refined NonNegative Milliseconds)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Refined NonNegative Milliseconds)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields (Refined NonNegative Milliseconds)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"events-fetch-interval"
          Mod OptionFields (Refined NonNegative Milliseconds)
-> Mod OptionFields (Refined NonNegative Milliseconds)
-> Mod OptionFields (Refined NonNegative Milliseconds)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Milliseconds)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar (Option (Refined NonNegative Milliseconds) -> String
forall def. Option def -> String
Config._envVar Option (Refined NonNegative Milliseconds)
graphqlEventsFetchIntervalOption)
          Mod OptionFields (Refined NonNegative Milliseconds)
-> Mod OptionFields (Refined NonNegative Milliseconds)
-> Mod OptionFields (Refined NonNegative Milliseconds)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Milliseconds)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (Refined NonNegative Milliseconds) -> String
forall def. Option def -> String
Config._helpMessage Option (Refined NonNegative Milliseconds)
graphqlEventsFetchIntervalOption)
      )

graphqlEventsFetchIntervalOption :: Config.Option (Refined NonNegative Milliseconds)
graphqlEventsFetchIntervalOption :: Option (Refined NonNegative Milliseconds)
graphqlEventsFetchIntervalOption =
  Config.Option
    { _default :: Refined NonNegative Milliseconds
Config._default = $$(refineTH @NonNegative @Milliseconds 1000),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_EVENTS_FETCH_INTERVAL",
      _helpMessage :: String
Config._helpMessage = String
"Interval in milliseconds to sleep before trying to fetch events again after a fetch returned no events from postgres (default: 1 second)."
    }

parseGraphqlAsyncActionsFetchInterval :: Opt.Parser (Maybe Config.OptionalInterval)
parseGraphqlAsyncActionsFetchInterval :: Parser (Maybe OptionalInterval)
parseGraphqlAsyncActionsFetchInterval =
  Parser OptionalInterval -> Parser (Maybe OptionalInterval)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser OptionalInterval -> Parser (Maybe OptionalInterval))
-> Parser OptionalInterval -> Parser (Maybe OptionalInterval)
forall a b. (a -> b) -> a -> b
$ ReadM OptionalInterval
-> Mod OptionFields OptionalInterval -> Parser OptionalInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String OptionalInterval)
-> ReadM OptionalInterval
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String OptionalInterval
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields OptionalInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"async-actions-fetch-interval"
          Mod OptionFields OptionalInterval
-> Mod OptionFields OptionalInterval
-> Mod OptionFields OptionalInterval
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OptionalInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar (Option OptionalInterval -> String
forall def. Option def -> String
Config._envVar Option OptionalInterval
asyncActionsFetchIntervalOption)
          Mod OptionFields OptionalInterval
-> Mod OptionFields OptionalInterval
-> Mod OptionFields OptionalInterval
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OptionalInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option OptionalInterval -> String
forall def. Option def -> String
Config._helpMessage Option OptionalInterval
asyncActionsFetchIntervalOption)
      )

asyncActionsFetchIntervalOption :: Config.Option Config.OptionalInterval
asyncActionsFetchIntervalOption :: Option OptionalInterval
asyncActionsFetchIntervalOption =
  Config.Option
    { _default :: OptionalInterval
Config._default = Refined NonNegative Milliseconds -> OptionalInterval
Config.Interval $$(refineTH 1000),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ASYNC_ACTIONS_FETCH_INTERVAL",
      _helpMessage :: String
Config._helpMessage =
        String
"Interval in milliseconds to sleep before trying to fetch new async actions. "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Value \"0\" implies completely disable fetching async actions from storage. "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Default 1000 milliseconds"
    }

parseEnableRemoteSchemaPerms :: Opt.Parser Options.RemoteSchemaPermissions
parseEnableRemoteSchemaPerms :: Parser RemoteSchemaPermissions
parseEnableRemoteSchemaPerms =
  (Bool -> RemoteSchemaPermissions)
-> Parser Bool -> Parser RemoteSchemaPermissions
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RemoteSchemaPermissions
-> RemoteSchemaPermissions -> Bool -> RemoteSchemaPermissions
forall a. a -> a -> Bool -> a
bool RemoteSchemaPermissions
Options.DisableRemoteSchemaPermissions RemoteSchemaPermissions
Options.EnableRemoteSchemaPermissions)
    (Parser Bool -> Parser RemoteSchemaPermissions)
-> Parser Bool -> Parser RemoteSchemaPermissions
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"enable-remote-schema-permissions"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option RemoteSchemaPermissions -> String
forall def. Option def -> String
Config._helpMessage Option RemoteSchemaPermissions
enableRemoteSchemaPermsOption)
      )

enableRemoteSchemaPermsOption :: Config.Option Options.RemoteSchemaPermissions
enableRemoteSchemaPermsOption :: Option RemoteSchemaPermissions
enableRemoteSchemaPermsOption =
  Config.Option
    { _default :: RemoteSchemaPermissions
Config._default = RemoteSchemaPermissions
Options.DisableRemoteSchemaPermissions,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ENABLE_REMOTE_SCHEMA_PERMISSIONS",
      _helpMessage :: String
Config._helpMessage = String
"Enables remote schema permissions (default: false)"
    }

parseWebSocketCompression :: Opt.Parser WebSockets.CompressionOptions
parseWebSocketCompression :: Parser CompressionOptions
parseWebSocketCompression =
  CompressionOptions
-> CompressionOptions -> Bool -> CompressionOptions
forall a. a -> a -> Bool -> a
bool CompressionOptions
WebSockets.NoCompression (PermessageDeflate -> CompressionOptions
WebSockets.PermessageDeflateCompression PermessageDeflate
WebSockets.defaultPermessageDeflate)
    (Bool -> CompressionOptions)
-> Parser Bool -> Parser CompressionOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"websocket-compression"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option CompressionOptions -> String
forall def. Option def -> String
Config._helpMessage Option CompressionOptions
webSocketCompressionOption)
      )

webSocketCompressionOption :: Config.Option WebSockets.CompressionOptions
webSocketCompressionOption :: Option CompressionOptions
webSocketCompressionOption =
  Config.Option
    { _default :: CompressionOptions
Config._default = CompressionOptions
WebSockets.NoCompression,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_CONNECTION_COMPRESSION",
      _helpMessage :: String
Config._helpMessage = String
"Enable WebSocket permessage-deflate compression (default: false)"
    }

parseWebSocketKeepAlive :: Opt.Parser (Maybe Config.KeepAliveDelay)
parseWebSocketKeepAlive :: Parser (Maybe KeepAliveDelay)
parseWebSocketKeepAlive =
  Parser KeepAliveDelay -> Parser (Maybe KeepAliveDelay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser KeepAliveDelay -> Parser (Maybe KeepAliveDelay))
-> Parser KeepAliveDelay -> Parser (Maybe KeepAliveDelay)
forall a b. (a -> b) -> a -> b
$ ReadM KeepAliveDelay
-> Mod OptionFields KeepAliveDelay -> Parser KeepAliveDelay
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String KeepAliveDelay) -> ReadM KeepAliveDelay
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String KeepAliveDelay
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields KeepAliveDelay
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"websocket-keepalive"
          Mod OptionFields KeepAliveDelay
-> Mod OptionFields KeepAliveDelay
-> Mod OptionFields KeepAliveDelay
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields KeepAliveDelay
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option KeepAliveDelay -> String
forall def. Option def -> String
Config._helpMessage Option KeepAliveDelay
webSocketKeepAliveOption)
      )

-- NOTE: this is purely used by Apollo-Subscription-Transport-WS
webSocketKeepAliveOption :: Config.Option Config.KeepAliveDelay
webSocketKeepAliveOption :: Option KeepAliveDelay
webSocketKeepAliveOption =
  Config.Option
    { _default :: KeepAliveDelay
Config._default = Refined NonNegative Seconds -> KeepAliveDelay
Config.KeepAliveDelay $$(refineTH 5),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_WEBSOCKET_KEEPALIVE",
      _helpMessage :: String
Config._helpMessage = String
"Control websocket keep-alive timeout (default 5 seconds)"
    }

parseInferFunctionPerms :: Opt.Parser (Maybe Options.InferFunctionPermissions)
parseInferFunctionPerms :: Parser (Maybe InferFunctionPermissions)
parseInferFunctionPerms =
  Parser InferFunctionPermissions
-> Parser (Maybe InferFunctionPermissions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser InferFunctionPermissions
 -> Parser (Maybe InferFunctionPermissions))
-> Parser InferFunctionPermissions
-> Parser (Maybe InferFunctionPermissions)
forall a b. (a -> b) -> a -> b
$ ReadM InferFunctionPermissions
-> Mod OptionFields InferFunctionPermissions
-> Parser InferFunctionPermissions
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String InferFunctionPermissions)
-> ReadM InferFunctionPermissions
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String InferFunctionPermissions
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields InferFunctionPermissions
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"infer-function-permissions"
          Mod OptionFields InferFunctionPermissions
-> Mod OptionFields InferFunctionPermissions
-> Mod OptionFields InferFunctionPermissions
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields InferFunctionPermissions
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option InferFunctionPermissions -> String
forall def. Option def -> String
Config._helpMessage Option InferFunctionPermissions
inferFunctionPermsOption)
      )

inferFunctionPermsOption :: Config.Option Options.InferFunctionPermissions
inferFunctionPermsOption :: Option InferFunctionPermissions
inferFunctionPermsOption =
  Config.Option
    { _default :: InferFunctionPermissions
Config._default = InferFunctionPermissions
Options.InferFunctionPermissions,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_INFER_FUNCTION_PERMISSIONS",
      _helpMessage :: String
Config._helpMessage = String
"Infers function permissions (default: true)"
    }

parseEnableMaintenanceMode :: Opt.Parser (Types.MaintenanceMode ())
parseEnableMaintenanceMode :: Parser (MaintenanceMode ())
parseEnableMaintenanceMode =
  (Bool -> MaintenanceMode ())
-> Parser Bool -> Parser (MaintenanceMode ())
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MaintenanceMode ()
-> MaintenanceMode () -> Bool -> MaintenanceMode ()
forall a. a -> a -> Bool -> a
bool MaintenanceMode ()
forall a. MaintenanceMode a
Types.MaintenanceModeDisabled (() -> MaintenanceMode ()
forall a. a -> MaintenanceMode a
Types.MaintenanceModeEnabled ()))
    (Parser Bool -> Parser (MaintenanceMode ()))
-> Parser Bool -> Parser (MaintenanceMode ())
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"enable-maintenance-mode"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (MaintenanceMode ()) -> String
forall def. Option def -> String
Config._helpMessage Option (MaintenanceMode ())
enableMaintenanceModeOption)
      )

enableMaintenanceModeOption :: Config.Option (Types.MaintenanceMode ())
enableMaintenanceModeOption :: Option (MaintenanceMode ())
enableMaintenanceModeOption =
  Config.Option
    { _default :: MaintenanceMode ()
Config._default = MaintenanceMode ()
forall a. MaintenanceMode a
Types.MaintenanceModeDisabled,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ENABLE_MAINTENANCE_MODE",
      _helpMessage :: String
Config._helpMessage = String
"Flag to enable maintenance mode in the graphql-engine"
    }

parseSchemaPollInterval :: Opt.Parser (Maybe Config.OptionalInterval)
parseSchemaPollInterval :: Parser (Maybe OptionalInterval)
parseSchemaPollInterval =
  Parser OptionalInterval -> Parser (Maybe OptionalInterval)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser OptionalInterval -> Parser (Maybe OptionalInterval))
-> Parser OptionalInterval -> Parser (Maybe OptionalInterval)
forall a b. (a -> b) -> a -> b
$ ReadM OptionalInterval
-> Mod OptionFields OptionalInterval -> Parser OptionalInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String OptionalInterval)
-> ReadM OptionalInterval
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String OptionalInterval
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields OptionalInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"schema-sync-poll-interval"
          Mod OptionFields OptionalInterval
-> Mod OptionFields OptionalInterval
-> Mod OptionFields OptionalInterval
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OptionalInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar (Option OptionalInterval -> String
forall def. Option def -> String
Config._envVar Option OptionalInterval
schemaPollIntervalOption)
          Mod OptionFields OptionalInterval
-> Mod OptionFields OptionalInterval
-> Mod OptionFields OptionalInterval
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OptionalInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option OptionalInterval -> String
forall def. Option def -> String
Config._helpMessage Option OptionalInterval
schemaPollIntervalOption)
      )

schemaPollIntervalOption :: Config.Option Config.OptionalInterval
schemaPollIntervalOption :: Option OptionalInterval
schemaPollIntervalOption =
  Config.Option
    { -- 1000 Milliseconds or 1 Second
      _default :: OptionalInterval
Config._default = Refined NonNegative Milliseconds -> OptionalInterval
Config.Interval $$(refineTH 1000),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_SCHEMA_SYNC_POLL_INTERVAL",
      _helpMessage :: String
Config._helpMessage = String
"Interval to poll metadata storage for updates in milliseconds - Default 1000 (1s) - Set to 0 to disable"
    }

parseExperimentalFeatures :: Opt.Parser (Maybe (HashSet Types.ExperimentalFeature))
parseExperimentalFeatures :: Parser (Maybe (HashSet ExperimentalFeature))
parseExperimentalFeatures =
  Parser (HashSet ExperimentalFeature)
-> Parser (Maybe (HashSet ExperimentalFeature))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser (HashSet ExperimentalFeature)
 -> Parser (Maybe (HashSet ExperimentalFeature)))
-> Parser (HashSet ExperimentalFeature)
-> Parser (Maybe (HashSet ExperimentalFeature))
forall a b. (a -> b) -> a -> b
$ ReadM (HashSet ExperimentalFeature)
-> Mod OptionFields (HashSet ExperimentalFeature)
-> Parser (HashSet ExperimentalFeature)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (HashSet ExperimentalFeature))
-> ReadM (HashSet ExperimentalFeature)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (HashSet ExperimentalFeature)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields (HashSet ExperimentalFeature)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"experimental-features"
          Mod OptionFields (HashSet ExperimentalFeature)
-> Mod OptionFields (HashSet ExperimentalFeature)
-> Mod OptionFields (HashSet ExperimentalFeature)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (HashSet ExperimentalFeature)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (HashSet ExperimentalFeature) -> String
forall def. Option def -> String
Config._helpMessage Option (HashSet ExperimentalFeature)
experimentalFeaturesOption)
      )

experimentalFeaturesOption :: Config.Option (HashSet Types.ExperimentalFeature)
experimentalFeaturesOption :: Option (HashSet ExperimentalFeature)
experimentalFeaturesOption =
  Config.Option
    { _default :: HashSet ExperimentalFeature
Config._default = HashSet ExperimentalFeature
forall a. HashSet a
HashSet.empty,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_EXPERIMENTAL_FEATURES",
      _helpMessage :: String
Config._helpMessage =
        String
"Comma separated list of experimental features. (all: inherited_roles,optimize_permission_filters and naming_convention, streaming_subscriptions, apollo_federation). "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"optimize_permission_filters: Use experimental SQL optimization"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"transformations for permission filters. "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"inherited_roles: ignored; inherited roles cannot be switched off"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"naming_convention: apply naming convention (graphql-default/hasura-default) based on source customization"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"apollo_federation: use hasura as a subgraph in an Apollo gateway (deprecated)"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"streaming_subscriptions: A streaming subscription streams the response according to the cursor provided by the user"
    }

parseEventsFetchBatchSize :: Opt.Parser (Maybe (Refined NonNegative Int))
parseEventsFetchBatchSize :: Parser (Maybe (Refined NonNegative Int))
parseEventsFetchBatchSize =
  Parser (Refined NonNegative Int)
-> Parser (Maybe (Refined NonNegative Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser (Refined NonNegative Int)
 -> Parser (Maybe (Refined NonNegative Int)))
-> Parser (Refined NonNegative Int)
-> Parser (Maybe (Refined NonNegative Int))
forall a b. (a -> b) -> a -> b
$ ReadM (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Parser (Refined NonNegative Int)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Refined NonNegative Int))
-> ReadM (Refined NonNegative Int)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Refined NonNegative Int)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"events-fetch-batch-size"
          Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar (Option (Refined NonNegative Int) -> String
forall def. Option def -> String
Config._envVar Option (Refined NonNegative Int)
eventsFetchBatchSizeOption)
          Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
-> Mod OptionFields (Refined NonNegative Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Int)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (Refined NonNegative Int) -> String
forall def. Option def -> String
Config._helpMessage Option (Refined NonNegative Int)
eventsFetchBatchSizeOption)
      )

eventsFetchBatchSizeOption :: Config.Option (Refined NonNegative Int)
eventsFetchBatchSizeOption :: Option (Refined NonNegative Int)
eventsFetchBatchSizeOption =
  Config.Option
    { _default :: Refined NonNegative Int
Config._default = $$(refineTH @NonNegative @Int 100),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_EVENTS_FETCH_BATCH_SIZE",
      _helpMessage :: String
Config._helpMessage =
        String
"The maximum number of events to be fetched from the events table in a single batch. Default 100"
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Value \"0\" implies completely disable fetching events from events table. "
    }

parseGracefulShutdownTimeout :: Opt.Parser (Maybe (Refined NonNegative Seconds))
parseGracefulShutdownTimeout :: Parser (Maybe (Refined NonNegative Seconds))
parseGracefulShutdownTimeout =
  Parser (Refined NonNegative Seconds)
-> Parser (Maybe (Refined NonNegative Seconds))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser (Refined NonNegative Seconds)
 -> Parser (Maybe (Refined NonNegative Seconds)))
-> Parser (Refined NonNegative Seconds)
-> Parser (Maybe (Refined NonNegative Seconds))
forall a b. (a -> b) -> a -> b
$ ReadM (Refined NonNegative Seconds)
-> Mod OptionFields (Refined NonNegative Seconds)
-> Parser (Refined NonNegative Seconds)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Refined NonNegative Seconds))
-> ReadM (Refined NonNegative Seconds)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Refined NonNegative Seconds)
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields (Refined NonNegative Seconds)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"graceful-shutdown-timeout"
          Mod OptionFields (Refined NonNegative Seconds)
-> Mod OptionFields (Refined NonNegative Seconds)
-> Mod OptionFields (Refined NonNegative Seconds)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Seconds)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<INTERVAL (seconds)>"
          Mod OptionFields (Refined NonNegative Seconds)
-> Mod OptionFields (Refined NonNegative Seconds)
-> Mod OptionFields (Refined NonNegative Seconds)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Refined NonNegative Seconds)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (Refined NonNegative Seconds) -> String
forall def. Option def -> String
Config._helpMessage Option (Refined NonNegative Seconds)
gracefulShutdownOption)
      )

gracefulShutdownOption :: Config.Option (Refined NonNegative Seconds)
gracefulShutdownOption :: Option (Refined NonNegative Seconds)
gracefulShutdownOption =
  Config.Option
    { _default :: Refined NonNegative Seconds
Config._default = $$(refineTH @NonNegative @Seconds 60),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_GRACEFUL_SHUTDOWN_TIMEOUT",
      _helpMessage :: String
Config._helpMessage =
        String
"Timeout for graceful shutdown before which in-flight scheduled events, "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" cron events and async actions to complete (default: 60 seconds)"
    }

parseWebSocketConnectionInitTimeout :: Opt.Parser (Maybe Config.WSConnectionInitTimeout)
parseWebSocketConnectionInitTimeout :: Parser (Maybe WSConnectionInitTimeout)
parseWebSocketConnectionInitTimeout =
  Parser WSConnectionInitTimeout
-> Parser (Maybe WSConnectionInitTimeout)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser WSConnectionInitTimeout
 -> Parser (Maybe WSConnectionInitTimeout))
-> Parser WSConnectionInitTimeout
-> Parser (Maybe WSConnectionInitTimeout)
forall a b. (a -> b) -> a -> b
$ ReadM WSConnectionInitTimeout
-> Mod OptionFields WSConnectionInitTimeout
-> Parser WSConnectionInitTimeout
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String WSConnectionInitTimeout)
-> ReadM WSConnectionInitTimeout
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String WSConnectionInitTimeout
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields WSConnectionInitTimeout
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"websocket-connection-init-timeout"
          Mod OptionFields WSConnectionInitTimeout
-> Mod OptionFields WSConnectionInitTimeout
-> Mod OptionFields WSConnectionInitTimeout
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields WSConnectionInitTimeout
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option WSConnectionInitTimeout -> String
forall def. Option def -> String
Config._helpMessage Option WSConnectionInitTimeout
webSocketConnectionInitTimeoutOption)
      )

-- NOTE: this is purely used by GraphQL-WS
webSocketConnectionInitTimeoutOption :: Config.Option Config.WSConnectionInitTimeout
webSocketConnectionInitTimeoutOption :: Option WSConnectionInitTimeout
webSocketConnectionInitTimeoutOption =
  Config.Option
    { _default :: WSConnectionInitTimeout
Config._default = Refined NonNegative Seconds -> WSConnectionInitTimeout
Config.WSConnectionInitTimeout $$(refineTH 3),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_WEBSOCKET_CONNECTION_INIT_TIMEOUT", -- FIXME?: maybe a better name
      _helpMessage :: String
Config._helpMessage = String
"Control websocket connection_init timeout (default 3 seconds)"
    }

parseEnableMetadataQueryLogging :: Opt.Parser Server.Logging.MetadataQueryLoggingMode
parseEnableMetadataQueryLogging :: Parser MetadataQueryLoggingMode
parseEnableMetadataQueryLogging =
  (Bool -> MetadataQueryLoggingMode)
-> Parser Bool -> Parser MetadataQueryLoggingMode
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MetadataQueryLoggingMode
-> MetadataQueryLoggingMode -> Bool -> MetadataQueryLoggingMode
forall a. a -> a -> Bool -> a
bool MetadataQueryLoggingMode
Server.Logging.MetadataQueryLoggingDisabled MetadataQueryLoggingMode
Server.Logging.MetadataQueryLoggingEnabled)
    (Parser Bool -> Parser MetadataQueryLoggingMode)
-> Parser Bool -> Parser MetadataQueryLoggingMode
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"enable-metadata-query-logging"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option MetadataQueryLoggingMode -> String
forall def. Option def -> String
Config._helpMessage Option MetadataQueryLoggingMode
enableMetadataQueryLoggingOption)
      )

enableMetadataQueryLoggingOption :: Config.Option Server.Logging.MetadataQueryLoggingMode
enableMetadataQueryLoggingOption :: Option MetadataQueryLoggingMode
enableMetadataQueryLoggingOption =
  Config.Option
    { _default :: MetadataQueryLoggingMode
Config._default = MetadataQueryLoggingMode
Server.Logging.MetadataQueryLoggingDisabled,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ENABLE_METADATA_QUERY_LOGGING",
      _helpMessage :: String
Config._helpMessage = String
"Enables the query field in http-logs for metadata queries (default: false)"
    }

-- TODO(SOLOMON): The defaulting behavior for this occurs inside the Engine. In
-- an isolated PR we should move that defaulting in the parsing stage.
parseDefaultNamingConvention :: Opt.Parser (Maybe NC.NamingCase)
parseDefaultNamingConvention :: Parser (Maybe NamingCase)
parseDefaultNamingConvention =
  Parser NamingCase -> Parser (Maybe NamingCase)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser NamingCase -> Parser (Maybe NamingCase))
-> Parser NamingCase -> Parser (Maybe NamingCase)
forall a b. (a -> b) -> a -> b
$ ReadM NamingCase
-> Mod OptionFields NamingCase -> Parser NamingCase
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String NamingCase) -> ReadM NamingCase
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String NamingCase
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields NamingCase
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"default-naming-convention"
          Mod OptionFields NamingCase
-> Mod OptionFields NamingCase -> Mod OptionFields NamingCase
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields NamingCase
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option NamingCase -> String
forall def. Option def -> String
Config._helpMessage Option NamingCase
defaultNamingConventionOption)
      )

defaultNamingConventionOption :: Config.Option NC.NamingCase
defaultNamingConventionOption :: Option NamingCase
defaultNamingConventionOption =
  Config.Option
    { _default :: NamingCase
Config._default = NamingCase
NC.HasuraCase,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_DEFAULT_NAMING_CONVENTION",
      _helpMessage :: String
Config._helpMessage =
        String
"Default naming convention for the auto generated graphql names. Possible values are"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"hasura-default: Use snake_case for all names."
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"graphql-default: Use camelCase for field names and PascalCase for type names."
    }

parseExtensionsSchema :: Opt.Parser (Maybe MonadTx.ExtensionsSchema)
parseExtensionsSchema :: Parser (Maybe ExtensionsSchema)
parseExtensionsSchema =
  Parser ExtensionsSchema -> Parser (Maybe ExtensionsSchema)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser ExtensionsSchema -> Parser (Maybe ExtensionsSchema))
-> Parser ExtensionsSchema -> Parser (Maybe ExtensionsSchema)
forall a b. (a -> b) -> a -> b
$ ReadM ExtensionsSchema
-> Mod OptionFields ExtensionsSchema -> Parser ExtensionsSchema
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String ExtensionsSchema)
-> ReadM ExtensionsSchema
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String ExtensionsSchema
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields ExtensionsSchema
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-database-extensions-schema"
          Mod OptionFields ExtensionsSchema
-> Mod OptionFields ExtensionsSchema
-> Mod OptionFields ExtensionsSchema
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ExtensionsSchema
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option ExtensionsSchema -> String
forall def. Option def -> String
Config._helpMessage Option ExtensionsSchema
metadataDBExtensionsSchemaOption)
      )

metadataDefaultsOption :: Config.Option MetadataDefaults
metadataDefaultsOption :: Option MetadataDefaults
metadataDefaultsOption =
  Config.Option
    { _default :: MetadataDefaults
Config._default = MetadataDefaults
emptyMetadataDefaults,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_METADATA_DEFAULTS",
      _helpMessage :: String
Config._helpMessage = String
"Default values to be included in metadata."
    }

parseMetadataDefaults :: Opt.Parser (Maybe MetadataDefaults)
parseMetadataDefaults :: Parser (Maybe MetadataDefaults)
parseMetadataDefaults =
  Parser MetadataDefaults -> Parser (Maybe MetadataDefaults)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser MetadataDefaults -> Parser (Maybe MetadataDefaults))
-> Parser MetadataDefaults -> Parser (Maybe MetadataDefaults)
forall a b. (a -> b) -> a -> b
$ ReadM MetadataDefaults
-> Mod OptionFields MetadataDefaults -> Parser MetadataDefaults
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String MetadataDefaults)
-> ReadM MetadataDefaults
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String MetadataDefaults
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields MetadataDefaults
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-defaults"
          Mod OptionFields MetadataDefaults
-> Mod OptionFields MetadataDefaults
-> Mod OptionFields MetadataDefaults
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields MetadataDefaults
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option MetadataDefaults -> String
forall def. Option def -> String
Config._helpMessage Option MetadataDefaults
metadataDefaultsOption)
      )

metadataDBExtensionsSchemaOption :: Config.Option MonadTx.ExtensionsSchema
metadataDBExtensionsSchemaOption :: Option ExtensionsSchema
metadataDBExtensionsSchemaOption =
  Config.Option
    { _default :: ExtensionsSchema
Config._default = Text -> ExtensionsSchema
MonadTx.ExtensionsSchema Text
"public",
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_METADATA_DATABASE_EXTENSIONS_SCHEMA",
      _helpMessage :: String
Config._helpMessage =
        String
"Name of the schema where Hasura can install database extensions. Default: public"
    }

apolloFederationStatusOption :: Config.Option (Maybe Types.ApolloFederationStatus)
apolloFederationStatusOption :: Option (Maybe ApolloFederationStatus)
apolloFederationStatusOption =
  Config.Option
    { _default :: Maybe ApolloFederationStatus
Config._default = Maybe ApolloFederationStatus
forall a. Maybe a
Nothing,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_ENABLE_APOLLO_FEDERATION",
      _helpMessage :: String
Config._helpMessage = String
"Enable Apollo Federation (default: false). This will allow hasura to be used as a subgraph in an Apollo gateway"
    }

parseApolloFederationStatus :: Opt.Parser (Maybe Types.ApolloFederationStatus)
parseApolloFederationStatus :: Parser (Maybe ApolloFederationStatus)
parseApolloFederationStatus =
  (Maybe ApolloFederationStatus
-> Maybe ApolloFederationStatus
-> Bool
-> Maybe ApolloFederationStatus
forall a. a -> a -> Bool -> a
bool Maybe ApolloFederationStatus
forall a. Maybe a
Nothing (ApolloFederationStatus -> Maybe ApolloFederationStatus
forall a. a -> Maybe a
Just ApolloFederationStatus
Types.ApolloFederationEnabled))
    (Bool -> Maybe ApolloFederationStatus)
-> Parser Bool -> Parser (Maybe ApolloFederationStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"enable-apollo-federation"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option (Maybe ApolloFederationStatus) -> String
forall def. Option def -> String
Config._helpMessage Option (Maybe ApolloFederationStatus)
apolloFederationStatusOption)
      )

closeWebsocketsOnMetadataChangeOption :: Config.Option (Types.CloseWebsocketsOnMetadataChangeStatus)
closeWebsocketsOnMetadataChangeOption :: Option CloseWebsocketsOnMetadataChangeStatus
closeWebsocketsOnMetadataChangeOption =
  Config.Option
    { _default :: CloseWebsocketsOnMetadataChangeStatus
Config._default = CloseWebsocketsOnMetadataChangeStatus
Types.CWMCEnabled,
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_CLOSE_WEBSOCKETS_ON_METADATA_CHANGE",
      _helpMessage :: String
Config._helpMessage = String
"Close all the websocket connections (with error code 1012) on metadata change (default: true)."
    }

parseEnableCloseWebsocketsOnMetadataChange :: Opt.Parser (Maybe Types.CloseWebsocketsOnMetadataChangeStatus)
parseEnableCloseWebsocketsOnMetadataChange :: Parser (Maybe CloseWebsocketsOnMetadataChangeStatus)
parseEnableCloseWebsocketsOnMetadataChange =
  (Maybe CloseWebsocketsOnMetadataChangeStatus
-> Maybe CloseWebsocketsOnMetadataChangeStatus
-> Bool
-> Maybe CloseWebsocketsOnMetadataChangeStatus
forall a. a -> a -> Bool -> a
bool Maybe CloseWebsocketsOnMetadataChangeStatus
forall a. Maybe a
Nothing (CloseWebsocketsOnMetadataChangeStatus
-> Maybe CloseWebsocketsOnMetadataChangeStatus
forall a. a -> Maybe a
Just CloseWebsocketsOnMetadataChangeStatus
Types.CWMCDisabled))
    (Bool -> Maybe CloseWebsocketsOnMetadataChangeStatus)
-> Parser Bool
-> Parser (Maybe CloseWebsocketsOnMetadataChangeStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"disable-close-websockets-on-metadata-change"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option CloseWebsocketsOnMetadataChangeStatus -> String
forall def. Option def -> String
Config._helpMessage Option CloseWebsocketsOnMetadataChangeStatus
closeWebsocketsOnMetadataChangeOption)
      )

parseMaxTotalHeaderLength :: Opt.Parser (Maybe Int)
parseMaxTotalHeaderLength :: Parser (Maybe Int)
parseMaxTotalHeaderLength =
  Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser Int -> Parser (Maybe Int))
-> Parser Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String Int) -> ReadM Int
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String Int
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-total-header-length"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option Int -> String
forall def. Option def -> String
Config._helpMessage Option Int
maxTotalHeaderLengthOption)
      )

maxTotalHeaderLengthOption :: Config.Option Int
maxTotalHeaderLengthOption :: Option Int
maxTotalHeaderLengthOption =
  Config.Option
    { _default :: Int
Config._default = (Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_MAX_TOTAL_HEADER_LENGTH",
      _helpMessage :: String
Config._helpMessage = String
"Max cumulative length of all headers in bytes (Default: 1MB)"
    }

--------------------------------------------------------------------------------
-- Pretty Printer

serveCmdFooter :: PP.Doc
serveCmdFooter :: Doc
serveCmdFooter =
  Doc
examplesDoc Doc -> Doc -> Doc
PP.<$> String -> Doc
PP.text String
"" Doc -> Doc -> Doc
PP.<$> Doc
envVarDoc
  where
    examplesDoc :: Doc
examplesDoc = [[String]] -> Doc
PP.mkExamplesDoc [[String]]
examples
    examples :: [[String]]
examples =
      [ [ String
"# Start GraphQL Engine on default port (8080) with console enabled",
          String
"graphql-engine --database-url <database-url> serve --enable-console"
        ],
        [ String
"# Start GraphQL Engine on default port (8080) with console disabled",
          String
"graphql-engine --database-url <database-url> serve"
        ],
        [ String
"# Start GraphQL Engine on a different port (say 9090) with console disabled",
          String
"graphql-engine --database-url <database-url> serve --server-port 9090"
        ],
        [ String
"# Start GraphQL Engine with admin secret key",
          String
"graphql-engine --database-url <database-url> serve --admin-secret <adminsecretkey>"
        ],
        [ String
"# Start GraphQL Engine with restrictive CORS policy (only allow https://example.com:8080)",
          String
"graphql-engine --database-url <database-url> serve --cors-domain https://example.com:8080"
        ],
        [ String
"# Start GraphQL Engine with multiple domains for CORS (https://example.com, http://localhost:3000 and https://*.foo.bar.com)",
          String
"graphql-engine --database-url <database-url> serve --cors-domain \"https://example.com, https://*.foo.bar.com, http://localhost:3000\""
        ],
        [ String
"# Start GraphQL Engine with Authentication Webhook (GET)",
          String
"graphql-engine --database-url <database-url> serve --admin-secret <adminsecretkey>"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" --auth-hook https://mywebhook.com/get"
        ],
        [ String
"# Start GraphQL Engine with Authentication Webhook (POST)",
          String
"graphql-engine --database-url <database-url> serve --admin-secret <adminsecretkey>"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" --auth-hook https://mywebhook.com/post --auth-hook-mode POST"
        ],
        [ String
"# Start GraphQL Engine with telemetry enabled/disabled",
          String
"graphql-engine --database-url <database-url> serve --enable-telemetry true|false"
        ],
        [ String
"# Start GraphQL Engine with HTTP compression enabled for '/v1/query' and '/v1/graphql' endpoints",
          String
"graphql-engine --database-url <database-url> serve --enable-compression"
        ],
        [ String
"# Start GraphQL Engine with enable/disable including 'internal' information in an error response for the request made by an 'admin'",
          String
"graphql-engine --database-url <database-url> serve --admin-internal-errors true|false"
        ]
      ]

    envVarDoc :: Doc
envVarDoc = [(String, String)] -> Doc
PP.mkEnvVarDoc ([(String, String)] -> Doc) -> [(String, String)] -> Doc
forall a b. (a -> b) -> a -> b
$ [(String, String)]
envVars [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> [(String, String)]
eventEnvs
    envVars :: [(String, String)]
envVars =
      [ Option Port -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option Port
servePortOption,
        Option HostPreference -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option HostPreference
serveHostOption,
        Option (Refined NonNegative Int) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined NonNegative Int)
pgStripesOption,
        Option (Refined NonNegative Int) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined NonNegative Int)
pgConnsOption,
        Option (Refined NonNegative Int) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined NonNegative Int)
pgTimeoutOption,
        Option (Refined NonNegative NominalDiffTime) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined NonNegative NominalDiffTime)
pgConnLifetimeOption,
        Option Bool -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option Bool
pgUsePreparedStatementsOption,
        Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
pgPoolTimeoutOption,
        Option TxIsolation -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option TxIsolation
txIsolationOption,
        Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
adminSecretOption,
        Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
accessKeyOption,
        Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
authHookOption,
        Option AuthHookType -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option AuthHookType
authHookModeOption,
        Option Bool -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option Bool
authHookSendRequestBodyOption,
        Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
jwtSecretOption,
        Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
unAuthRoleOption,
        Option CorsConfig -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option CorsConfig
corsDomainOption,
        Option Bool -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option Bool
disableCorsOption,
        Option ConsoleStatus -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ConsoleStatus
enableConsoleOption,
        Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
consoleAssetsDirOption,
        Option TelemetryStatus -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option TelemetryStatus
enableTelemetryOption,
        Option WsReadCookieStatus -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option WsReadCookieStatus
wsReadCookieOption,
        Option StringifyNumbers -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option StringifyNumbers
stringifyNumOption,
        Option DangerouslyCollapseBooleans -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option DangerouslyCollapseBooleans
dangerousBooleanCollapseOption,
        Option (HashSet API) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (HashSet API)
enabledAPIsOption,
        Option RefetchInterval -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option RefetchInterval
mxRefetchDelayOption,
        Option BatchSize -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option BatchSize
mxBatchSizeOption,
        Option RefetchInterval -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option RefetchInterval
streamingMxRefetchDelayOption,
        Option BatchSize -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option BatchSize
streamingMxBatchSizeOption,
        Option AllowListStatus -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option AllowListStatus
enableAllowlistOption,
        Option (HashSet (EngineLogType Hasura)) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP (forall impl.
EnabledLogTypes impl =>
Option (HashSet (EngineLogType impl))
enabledLogsOption @Logging.Hasura),
        Option LogLevel -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option LogLevel
logLevelOption,
        Option DevModeStatus -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option DevModeStatus
graphqlDevModeOption,
        Option AdminInternalErrorsStatus -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option AdminInternalErrorsStatus
graphqlAdminInternalErrorsOption,
        Option (Refined Positive Int) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined Positive Int)
graphqlEventsHttpPoolSizeOption,
        Option (Refined NonNegative Milliseconds) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined NonNegative Milliseconds)
graphqlEventsFetchIntervalOption,
        Option OptionalInterval -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option OptionalInterval
asyncActionsFetchIntervalOption,
        Option RemoteSchemaPermissions -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option RemoteSchemaPermissions
enableRemoteSchemaPermsOption,
        Option CompressionOptions -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option CompressionOptions
webSocketCompressionOption,
        Option KeepAliveDelay -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option KeepAliveDelay
webSocketKeepAliveOption,
        Option InferFunctionPermissions -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option InferFunctionPermissions
inferFunctionPermsOption,
        Option (MaintenanceMode ()) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (MaintenanceMode ())
enableMaintenanceModeOption,
        Option OptionalInterval -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option OptionalInterval
schemaPollIntervalOption,
        Option (HashSet ExperimentalFeature) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (HashSet ExperimentalFeature)
experimentalFeaturesOption,
        Option (Refined NonNegative Int) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined NonNegative Int)
eventsFetchBatchSizeOption,
        Option (Refined NonNegative Seconds) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined NonNegative Seconds)
gracefulShutdownOption,
        Option WSConnectionInitTimeout -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option WSConnectionInitTimeout
webSocketConnectionInitTimeoutOption,
        Option MetadataQueryLoggingMode -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option MetadataQueryLoggingMode
enableMetadataQueryLoggingOption,
        Option NamingCase -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option NamingCase
defaultNamingConventionOption,
        Option ExtensionsSchema -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ExtensionsSchema
metadataDBExtensionsSchemaOption,
        Option (Maybe ApolloFederationStatus) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Maybe ApolloFederationStatus)
apolloFederationStatusOption,
        Option CloseWebsocketsOnMetadataChangeStatus -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option CloseWebsocketsOnMetadataChangeStatus
closeWebsocketsOnMetadataChangeOption,
        Option Int -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option Int
maxTotalHeaderLengthOption
      ]
    eventEnvs :: [(String, String)]
eventEnvs = [Option (Refined Positive Int) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined Positive Int)
graphqlEventsHttpPoolSizeOption, Option (Refined NonNegative Milliseconds) -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option (Refined NonNegative Milliseconds)
graphqlEventsFetchIntervalOption]