{-# LANGUAGE ViewPatterns #-}

-- | Types and classes related to configuration when the server is initialised
module Hasura.Server.Init.Config
  ( -- * Option
    Option (..),
    optionPP,

    -- * HGEOptionsRaw
    HGEOptionsRaw (..),
    horDatabaseUrl,
    horMetadataDbUrl,
    horCommand,

    -- * HGEOptions
    HGEOptions (..),
    hoCommand,

    -- * PostgresConnInfo
    PostgresConnInfo (..),
    pciDatabaseConn,
    pciRetries,

    -- * PostgresRawConnInfo
    PostgresConnInfoRaw (..),
    _PGConnDatabaseUrl,
    _PGConnDetails,
    mkUrlConnInfo,

    -- * PostgresRawConnDetails
    PostgresConnDetailsRaw (..),

    -- * HGECommand
    HGECommand (..),
    _HCServe,

    -- * ServeOptionsRaw
    ServeOptionsRaw (..),
    Port,
    _getPort,
    mkPort,
    unsafePort,
    API (..),
    KeepAliveDelay (..),
    OptionalInterval (..),
    AuthHookRaw (..),
    ConnParamsRaw (..),
    ResponseInternalErrorsConfig (..),
    WSConnectionInitTimeout (..),
    msToOptionalInterval,
    rawConnDetailsToUrl,
    rawConnDetailsToUrlText,
    shouldIncludeInternal,

    -- * ServeOptions
    ServeOptions (..),

    -- * Downgrade Options
    DowngradeOptions (..),
    -- $experimentalFeatures
    -- $readOnlyMode
  )
where

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

import Control.Lens (Lens', Prism')
import Control.Lens qualified as Lens
import Data.Aeson (FromJSON, ToJSON, (.:), (.:?), (.=))
import Data.Aeson qualified as Aeson
import Data.Scientific qualified as Scientific
import Data.Text qualified as Text
import Data.Time qualified as Time
import Data.URL.Template qualified as Template
import Database.PG.Query qualified as Query
import Hasura.Backends.Postgres.Connection.MonadTx qualified as MonadTx
import Hasura.GraphQL.Execute.Subscription.Options qualified as Subscription.Options
import Hasura.GraphQL.Schema.NamingCase (NamingCase)
import Hasura.GraphQL.Schema.Options qualified as Schema.Options
import Hasura.Incremental (Cacheable)
import Hasura.Logging qualified as Logging
import Hasura.Prelude
import Hasura.RQL.Types.Common qualified as Common
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Cors qualified as Cors
import Hasura.Server.Logging qualified as Server.Logging
import Hasura.Server.Types qualified as Server.Types
import Hasura.Session qualified as Session
import Network.Wai.Handler.Warp qualified as Warp
import Network.WebSockets qualified as WebSockets

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

-- | The collected default value, env var, and help message for an
-- option. If there should be no default value then use 'Option ()'.
data Option def = Option
  { Option def -> def
_default :: def,
    Option def -> String
_envVar :: String,
    Option def -> String
_helpMessage :: String
  }

-- | Helper function for pretty printing @Option a@.
optionPP :: Option a -> (String, String)
optionPP :: Option a -> (String, String)
optionPP = Option a -> String
forall def. Option def -> String
_envVar (Option a -> String)
-> (Option a -> String) -> Option a -> (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Option a -> String
forall def. Option def -> String
_helpMessage

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

-- | Raw HGE Options from the arg parser and the env.
data HGEOptionsRaw impl = HGEOptionsRaw
  { HGEOptionsRaw impl -> PostgresConnInfo (Maybe PostgresConnInfoRaw)
_horDatabaseUrl :: PostgresConnInfo (Maybe PostgresConnInfoRaw),
    HGEOptionsRaw impl -> Maybe String
_horMetadataDbUrl :: Maybe String,
    HGEOptionsRaw impl -> HGECommand impl
_horCommand :: HGECommand impl
  }

horDatabaseUrl :: Lens' (HGEOptionsRaw impl) (PostgresConnInfo (Maybe PostgresConnInfoRaw))
horDatabaseUrl :: (PostgresConnInfo (Maybe PostgresConnInfoRaw)
 -> f (PostgresConnInfo (Maybe PostgresConnInfoRaw)))
-> HGEOptionsRaw impl -> f (HGEOptionsRaw impl)
horDatabaseUrl = (HGEOptionsRaw impl
 -> PostgresConnInfo (Maybe PostgresConnInfoRaw))
-> (HGEOptionsRaw impl
    -> PostgresConnInfo (Maybe PostgresConnInfoRaw)
    -> HGEOptionsRaw impl)
-> Lens
     (HGEOptionsRaw impl)
     (HGEOptionsRaw impl)
     (PostgresConnInfo (Maybe PostgresConnInfoRaw))
     (PostgresConnInfo (Maybe PostgresConnInfoRaw))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens HGEOptionsRaw impl -> PostgresConnInfo (Maybe PostgresConnInfoRaw)
forall impl.
HGEOptionsRaw impl -> PostgresConnInfo (Maybe PostgresConnInfoRaw)
_horDatabaseUrl ((HGEOptionsRaw impl
  -> PostgresConnInfo (Maybe PostgresConnInfoRaw)
  -> HGEOptionsRaw impl)
 -> Lens
      (HGEOptionsRaw impl)
      (HGEOptionsRaw impl)
      (PostgresConnInfo (Maybe PostgresConnInfoRaw))
      (PostgresConnInfo (Maybe PostgresConnInfoRaw)))
-> (HGEOptionsRaw impl
    -> PostgresConnInfo (Maybe PostgresConnInfoRaw)
    -> HGEOptionsRaw impl)
-> Lens
     (HGEOptionsRaw impl)
     (HGEOptionsRaw impl)
     (PostgresConnInfo (Maybe PostgresConnInfoRaw))
     (PostgresConnInfo (Maybe PostgresConnInfoRaw))
forall a b. (a -> b) -> a -> b
$ \HGEOptionsRaw impl
hdu PostgresConnInfo (Maybe PostgresConnInfoRaw)
a -> HGEOptionsRaw impl
hdu {_horDatabaseUrl :: PostgresConnInfo (Maybe PostgresConnInfoRaw)
_horDatabaseUrl = PostgresConnInfo (Maybe PostgresConnInfoRaw)
a}

horMetadataDbUrl :: Lens' (HGEOptionsRaw impl) (Maybe String)
horMetadataDbUrl :: (Maybe String -> f (Maybe String))
-> HGEOptionsRaw impl -> f (HGEOptionsRaw impl)
horMetadataDbUrl = (HGEOptionsRaw impl -> Maybe String)
-> (HGEOptionsRaw impl -> Maybe String -> HGEOptionsRaw impl)
-> Lens
     (HGEOptionsRaw impl)
     (HGEOptionsRaw impl)
     (Maybe String)
     (Maybe String)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens HGEOptionsRaw impl -> Maybe String
forall impl. HGEOptionsRaw impl -> Maybe String
_horMetadataDbUrl ((HGEOptionsRaw impl -> Maybe String -> HGEOptionsRaw impl)
 -> Lens
      (HGEOptionsRaw impl)
      (HGEOptionsRaw impl)
      (Maybe String)
      (Maybe String))
-> (HGEOptionsRaw impl -> Maybe String -> HGEOptionsRaw impl)
-> Lens
     (HGEOptionsRaw impl)
     (HGEOptionsRaw impl)
     (Maybe String)
     (Maybe String)
forall a b. (a -> b) -> a -> b
$ \HGEOptionsRaw impl
hdu Maybe String
a -> HGEOptionsRaw impl
hdu {_horMetadataDbUrl :: Maybe String
_horMetadataDbUrl = Maybe String
a}

horCommand :: Lens' (HGEOptionsRaw impl) (HGECommand impl)
horCommand :: (HGECommand impl -> f (HGECommand impl))
-> HGEOptionsRaw impl -> f (HGEOptionsRaw impl)
horCommand = (HGEOptionsRaw impl -> HGECommand impl)
-> (HGEOptionsRaw impl -> HGECommand impl -> HGEOptionsRaw impl)
-> Lens
     (HGEOptionsRaw impl)
     (HGEOptionsRaw impl)
     (HGECommand impl)
     (HGECommand impl)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens HGEOptionsRaw impl -> HGECommand impl
forall impl. HGEOptionsRaw impl -> HGECommand impl
_horCommand ((HGEOptionsRaw impl -> HGECommand impl -> HGEOptionsRaw impl)
 -> Lens
      (HGEOptionsRaw impl)
      (HGEOptionsRaw impl)
      (HGECommand impl)
      (HGECommand impl))
-> (HGEOptionsRaw impl -> HGECommand impl -> HGEOptionsRaw impl)
-> Lens
     (HGEOptionsRaw impl)
     (HGEOptionsRaw impl)
     (HGECommand impl)
     (HGECommand impl)
forall a b. (a -> b) -> a -> b
$ \HGEOptionsRaw impl
hdu HGECommand impl
a -> HGEOptionsRaw impl
hdu {_horCommand :: HGECommand impl
_horCommand = HGECommand impl
a}

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

-- | The final processed HGE options.
data HGEOptions impl = HGEOptions
  { HGEOptions impl -> PostgresConnInfo (Maybe UrlConf)
_hoDatabaseUrl :: PostgresConnInfo (Maybe Common.UrlConf),
    HGEOptions impl -> Maybe String
_hoMetadataDbUrl :: Maybe String,
    HGEOptions impl -> HGECommand impl
_hoCommand :: HGECommand impl
  }

hoCommand :: Lens' (HGEOptions impl) (HGECommand impl)
hoCommand :: (HGECommand impl -> f (HGECommand impl))
-> HGEOptions impl -> f (HGEOptions impl)
hoCommand = (HGEOptions impl -> HGECommand impl)
-> (HGEOptions impl -> HGECommand impl -> HGEOptions impl)
-> Lens
     (HGEOptions impl)
     (HGEOptions impl)
     (HGECommand impl)
     (HGECommand impl)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens HGEOptions impl -> HGECommand impl
forall impl. HGEOptions impl -> HGECommand impl
_hoCommand ((HGEOptions impl -> HGECommand impl -> HGEOptions impl)
 -> Lens
      (HGEOptions impl)
      (HGEOptions impl)
      (HGECommand impl)
      (HGECommand impl))
-> (HGEOptions impl -> HGECommand impl -> HGEOptions impl)
-> Lens
     (HGEOptions impl)
     (HGEOptions impl)
     (HGECommand impl)
     (HGECommand impl)
forall a b. (a -> b) -> a -> b
$ \HGEOptions impl
hdu HGECommand impl
a -> HGEOptions impl
hdu {_hoCommand :: HGECommand impl
_hoCommand = HGECommand impl
a}

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

-- | Postgres connection info tupled with a retry count.
--
-- In practice, the @a@ here is one of the following:
-- 1. 'Maybe PostgresConnInfoRaw'
-- 2. 'Maybe UrlConf'
-- 3. 'Maybe Text'
-- 4. 'Maybe DatabaseUrl' where 'DatabaseUrl' is an alias for 'Text'
--
-- If it contains a 'Maybe PostgresConnInfoRaw' then you have not yet
-- processed your arg parser results.
data PostgresConnInfo a = PostgresConnInfo
  { PostgresConnInfo a -> a
_pciDatabaseConn :: a,
    PostgresConnInfo a -> Maybe Int
_pciRetries :: Maybe Int
  }
  deriving (Int -> PostgresConnInfo a -> ShowS
[PostgresConnInfo a] -> ShowS
PostgresConnInfo a -> String
(Int -> PostgresConnInfo a -> ShowS)
-> (PostgresConnInfo a -> String)
-> ([PostgresConnInfo a] -> ShowS)
-> Show (PostgresConnInfo a)
forall a. Show a => Int -> PostgresConnInfo a -> ShowS
forall a. Show a => [PostgresConnInfo a] -> ShowS
forall a. Show a => PostgresConnInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostgresConnInfo a] -> ShowS
$cshowList :: forall a. Show a => [PostgresConnInfo a] -> ShowS
show :: PostgresConnInfo a -> String
$cshow :: forall a. Show a => PostgresConnInfo a -> String
showsPrec :: Int -> PostgresConnInfo a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PostgresConnInfo a -> ShowS
Show, PostgresConnInfo a -> PostgresConnInfo a -> Bool
(PostgresConnInfo a -> PostgresConnInfo a -> Bool)
-> (PostgresConnInfo a -> PostgresConnInfo a -> Bool)
-> Eq (PostgresConnInfo a)
forall a. Eq a => PostgresConnInfo a -> PostgresConnInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostgresConnInfo a -> PostgresConnInfo a -> Bool
$c/= :: forall a. Eq a => PostgresConnInfo a -> PostgresConnInfo a -> Bool
== :: PostgresConnInfo a -> PostgresConnInfo a -> Bool
$c== :: forall a. Eq a => PostgresConnInfo a -> PostgresConnInfo a -> Bool
Eq, a -> PostgresConnInfo b -> PostgresConnInfo a
(a -> b) -> PostgresConnInfo a -> PostgresConnInfo b
(forall a b. (a -> b) -> PostgresConnInfo a -> PostgresConnInfo b)
-> (forall a b. a -> PostgresConnInfo b -> PostgresConnInfo a)
-> Functor PostgresConnInfo
forall a b. a -> PostgresConnInfo b -> PostgresConnInfo a
forall a b. (a -> b) -> PostgresConnInfo a -> PostgresConnInfo b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PostgresConnInfo b -> PostgresConnInfo a
$c<$ :: forall a b. a -> PostgresConnInfo b -> PostgresConnInfo a
fmap :: (a -> b) -> PostgresConnInfo a -> PostgresConnInfo b
$cfmap :: forall a b. (a -> b) -> PostgresConnInfo a -> PostgresConnInfo b
Functor, PostgresConnInfo a -> Bool
(a -> m) -> PostgresConnInfo a -> m
(a -> b -> b) -> b -> PostgresConnInfo a -> b
(forall m. Monoid m => PostgresConnInfo m -> m)
-> (forall m a. Monoid m => (a -> m) -> PostgresConnInfo a -> m)
-> (forall m a. Monoid m => (a -> m) -> PostgresConnInfo a -> m)
-> (forall a b. (a -> b -> b) -> b -> PostgresConnInfo a -> b)
-> (forall a b. (a -> b -> b) -> b -> PostgresConnInfo a -> b)
-> (forall b a. (b -> a -> b) -> b -> PostgresConnInfo a -> b)
-> (forall b a. (b -> a -> b) -> b -> PostgresConnInfo a -> b)
-> (forall a. (a -> a -> a) -> PostgresConnInfo a -> a)
-> (forall a. (a -> a -> a) -> PostgresConnInfo a -> a)
-> (forall a. PostgresConnInfo a -> [a])
-> (forall a. PostgresConnInfo a -> Bool)
-> (forall a. PostgresConnInfo a -> Int)
-> (forall a. Eq a => a -> PostgresConnInfo a -> Bool)
-> (forall a. Ord a => PostgresConnInfo a -> a)
-> (forall a. Ord a => PostgresConnInfo a -> a)
-> (forall a. Num a => PostgresConnInfo a -> a)
-> (forall a. Num a => PostgresConnInfo a -> a)
-> Foldable PostgresConnInfo
forall a. Eq a => a -> PostgresConnInfo a -> Bool
forall a. Num a => PostgresConnInfo a -> a
forall a. Ord a => PostgresConnInfo a -> a
forall m. Monoid m => PostgresConnInfo m -> m
forall a. PostgresConnInfo a -> Bool
forall a. PostgresConnInfo a -> Int
forall a. PostgresConnInfo a -> [a]
forall a. (a -> a -> a) -> PostgresConnInfo a -> a
forall m a. Monoid m => (a -> m) -> PostgresConnInfo a -> m
forall b a. (b -> a -> b) -> b -> PostgresConnInfo a -> b
forall a b. (a -> b -> b) -> b -> PostgresConnInfo a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: PostgresConnInfo a -> a
$cproduct :: forall a. Num a => PostgresConnInfo a -> a
sum :: PostgresConnInfo a -> a
$csum :: forall a. Num a => PostgresConnInfo a -> a
minimum :: PostgresConnInfo a -> a
$cminimum :: forall a. Ord a => PostgresConnInfo a -> a
maximum :: PostgresConnInfo a -> a
$cmaximum :: forall a. Ord a => PostgresConnInfo a -> a
elem :: a -> PostgresConnInfo a -> Bool
$celem :: forall a. Eq a => a -> PostgresConnInfo a -> Bool
length :: PostgresConnInfo a -> Int
$clength :: forall a. PostgresConnInfo a -> Int
null :: PostgresConnInfo a -> Bool
$cnull :: forall a. PostgresConnInfo a -> Bool
toList :: PostgresConnInfo a -> [a]
$ctoList :: forall a. PostgresConnInfo a -> [a]
foldl1 :: (a -> a -> a) -> PostgresConnInfo a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PostgresConnInfo a -> a
foldr1 :: (a -> a -> a) -> PostgresConnInfo a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PostgresConnInfo a -> a
foldl' :: (b -> a -> b) -> b -> PostgresConnInfo a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PostgresConnInfo a -> b
foldl :: (b -> a -> b) -> b -> PostgresConnInfo a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PostgresConnInfo a -> b
foldr' :: (a -> b -> b) -> b -> PostgresConnInfo a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PostgresConnInfo a -> b
foldr :: (a -> b -> b) -> b -> PostgresConnInfo a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PostgresConnInfo a -> b
foldMap' :: (a -> m) -> PostgresConnInfo a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PostgresConnInfo a -> m
foldMap :: (a -> m) -> PostgresConnInfo a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PostgresConnInfo a -> m
fold :: PostgresConnInfo m -> m
$cfold :: forall m. Monoid m => PostgresConnInfo m -> m
Foldable, Functor PostgresConnInfo
Foldable PostgresConnInfo
Functor PostgresConnInfo
-> Foldable PostgresConnInfo
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PostgresConnInfo a -> f (PostgresConnInfo b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    PostgresConnInfo (f a) -> f (PostgresConnInfo a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PostgresConnInfo a -> m (PostgresConnInfo b))
-> (forall (m :: * -> *) a.
    Monad m =>
    PostgresConnInfo (m a) -> m (PostgresConnInfo a))
-> Traversable PostgresConnInfo
(a -> f b) -> PostgresConnInfo a -> f (PostgresConnInfo b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PostgresConnInfo (m a) -> m (PostgresConnInfo a)
forall (f :: * -> *) a.
Applicative f =>
PostgresConnInfo (f a) -> f (PostgresConnInfo a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PostgresConnInfo a -> m (PostgresConnInfo b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PostgresConnInfo a -> f (PostgresConnInfo b)
sequence :: PostgresConnInfo (m a) -> m (PostgresConnInfo a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PostgresConnInfo (m a) -> m (PostgresConnInfo a)
mapM :: (a -> m b) -> PostgresConnInfo a -> m (PostgresConnInfo b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PostgresConnInfo a -> m (PostgresConnInfo b)
sequenceA :: PostgresConnInfo (f a) -> f (PostgresConnInfo a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PostgresConnInfo (f a) -> f (PostgresConnInfo a)
traverse :: (a -> f b) -> PostgresConnInfo a -> f (PostgresConnInfo b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PostgresConnInfo a -> f (PostgresConnInfo b)
$cp2Traversable :: Foldable PostgresConnInfo
$cp1Traversable :: Functor PostgresConnInfo
Traversable)

pciDatabaseConn :: Lens' (PostgresConnInfo a) a
pciDatabaseConn :: (a -> f a) -> PostgresConnInfo a -> f (PostgresConnInfo a)
pciDatabaseConn = (PostgresConnInfo a -> a)
-> (PostgresConnInfo a -> a -> PostgresConnInfo a)
-> Lens (PostgresConnInfo a) (PostgresConnInfo a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens PostgresConnInfo a -> a
forall a. PostgresConnInfo a -> a
_pciDatabaseConn ((PostgresConnInfo a -> a -> PostgresConnInfo a)
 -> Lens (PostgresConnInfo a) (PostgresConnInfo a) a a)
-> (PostgresConnInfo a -> a -> PostgresConnInfo a)
-> Lens (PostgresConnInfo a) (PostgresConnInfo a) a a
forall a b. (a -> b) -> a -> b
$ \PostgresConnInfo a
pci a
a -> PostgresConnInfo a
pci {_pciDatabaseConn :: a
_pciDatabaseConn = a
a}

pciRetries :: Lens' (PostgresConnInfo a) (Maybe Int)
pciRetries :: (Maybe Int -> f (Maybe Int))
-> PostgresConnInfo a -> f (PostgresConnInfo a)
pciRetries = (PostgresConnInfo a -> Maybe Int)
-> (PostgresConnInfo a -> Maybe Int -> PostgresConnInfo a)
-> Lens
     (PostgresConnInfo a) (PostgresConnInfo a) (Maybe Int) (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens PostgresConnInfo a -> Maybe Int
forall a. PostgresConnInfo a -> Maybe Int
_pciRetries ((PostgresConnInfo a -> Maybe Int -> PostgresConnInfo a)
 -> Lens
      (PostgresConnInfo a) (PostgresConnInfo a) (Maybe Int) (Maybe Int))
-> (PostgresConnInfo a -> Maybe Int -> PostgresConnInfo a)
-> Lens
     (PostgresConnInfo a) (PostgresConnInfo a) (Maybe Int) (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \PostgresConnInfo a
pci Maybe Int
mi -> PostgresConnInfo a
pci {_pciRetries :: Maybe Int
_pciRetries = Maybe Int
mi}

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

-- | Postgres Connection info in the form of a templated URI string or
-- structured data.
data PostgresConnInfoRaw
  = PGConnDatabaseUrl Template.URLTemplate
  | PGConnDetails PostgresConnDetailsRaw
  deriving (Int -> PostgresConnInfoRaw -> ShowS
[PostgresConnInfoRaw] -> ShowS
PostgresConnInfoRaw -> String
(Int -> PostgresConnInfoRaw -> ShowS)
-> (PostgresConnInfoRaw -> String)
-> ([PostgresConnInfoRaw] -> ShowS)
-> Show PostgresConnInfoRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostgresConnInfoRaw] -> ShowS
$cshowList :: [PostgresConnInfoRaw] -> ShowS
show :: PostgresConnInfoRaw -> String
$cshow :: PostgresConnInfoRaw -> String
showsPrec :: Int -> PostgresConnInfoRaw -> ShowS
$cshowsPrec :: Int -> PostgresConnInfoRaw -> ShowS
Show, PostgresConnInfoRaw -> PostgresConnInfoRaw -> Bool
(PostgresConnInfoRaw -> PostgresConnInfoRaw -> Bool)
-> (PostgresConnInfoRaw -> PostgresConnInfoRaw -> Bool)
-> Eq PostgresConnInfoRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostgresConnInfoRaw -> PostgresConnInfoRaw -> Bool
$c/= :: PostgresConnInfoRaw -> PostgresConnInfoRaw -> Bool
== :: PostgresConnInfoRaw -> PostgresConnInfoRaw -> Bool
$c== :: PostgresConnInfoRaw -> PostgresConnInfoRaw -> Bool
Eq)

mkUrlConnInfo :: String -> PostgresConnInfoRaw
mkUrlConnInfo :: String -> PostgresConnInfoRaw
mkUrlConnInfo = URLTemplate -> PostgresConnInfoRaw
PGConnDatabaseUrl (URLTemplate -> PostgresConnInfoRaw)
-> (String -> URLTemplate) -> String -> PostgresConnInfoRaw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> URLTemplate
Template.mkPlainURLTemplate (Text -> URLTemplate) -> (String -> Text) -> String -> URLTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

_PGConnDatabaseUrl :: Prism' PostgresConnInfoRaw Template.URLTemplate
_PGConnDatabaseUrl :: p URLTemplate (f URLTemplate)
-> p PostgresConnInfoRaw (f PostgresConnInfoRaw)
_PGConnDatabaseUrl = (URLTemplate -> PostgresConnInfoRaw)
-> (PostgresConnInfoRaw -> Maybe URLTemplate)
-> Prism
     PostgresConnInfoRaw PostgresConnInfoRaw URLTemplate URLTemplate
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Lens.prism' URLTemplate -> PostgresConnInfoRaw
PGConnDatabaseUrl ((PostgresConnInfoRaw -> Maybe URLTemplate)
 -> Prism
      PostgresConnInfoRaw PostgresConnInfoRaw URLTemplate URLTemplate)
-> (PostgresConnInfoRaw -> Maybe URLTemplate)
-> Prism
     PostgresConnInfoRaw PostgresConnInfoRaw URLTemplate URLTemplate
forall a b. (a -> b) -> a -> b
$ \case
  PGConnDatabaseUrl URLTemplate
template -> URLTemplate -> Maybe URLTemplate
forall a. a -> Maybe a
Just URLTemplate
template
  PGConnDetails PostgresConnDetailsRaw
_ -> Maybe URLTemplate
forall a. Maybe a
Nothing

_PGConnDetails :: Prism' PostgresConnInfoRaw PostgresConnDetailsRaw
_PGConnDetails :: p PostgresConnDetailsRaw (f PostgresConnDetailsRaw)
-> p PostgresConnInfoRaw (f PostgresConnInfoRaw)
_PGConnDetails = (PostgresConnDetailsRaw -> PostgresConnInfoRaw)
-> (PostgresConnInfoRaw -> Maybe PostgresConnDetailsRaw)
-> Prism
     PostgresConnInfoRaw
     PostgresConnInfoRaw
     PostgresConnDetailsRaw
     PostgresConnDetailsRaw
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Lens.prism' PostgresConnDetailsRaw -> PostgresConnInfoRaw
PGConnDetails ((PostgresConnInfoRaw -> Maybe PostgresConnDetailsRaw)
 -> Prism
      PostgresConnInfoRaw
      PostgresConnInfoRaw
      PostgresConnDetailsRaw
      PostgresConnDetailsRaw)
-> (PostgresConnInfoRaw -> Maybe PostgresConnDetailsRaw)
-> Prism
     PostgresConnInfoRaw
     PostgresConnInfoRaw
     PostgresConnDetailsRaw
     PostgresConnDetailsRaw
forall a b. (a -> b) -> a -> b
$ \case
  PGConnDatabaseUrl URLTemplate
_ -> Maybe PostgresConnDetailsRaw
forall a. Maybe a
Nothing
  PGConnDetails PostgresConnDetailsRaw
prcd -> PostgresConnDetailsRaw -> Maybe PostgresConnDetailsRaw
forall a. a -> Maybe a
Just PostgresConnDetailsRaw
prcd

rawConnDetailsToUrl :: PostgresConnDetailsRaw -> Template.URLTemplate
rawConnDetailsToUrl :: PostgresConnDetailsRaw -> URLTemplate
rawConnDetailsToUrl =
  Text -> URLTemplate
Template.mkPlainURLTemplate (Text -> URLTemplate)
-> (PostgresConnDetailsRaw -> Text)
-> PostgresConnDetailsRaw
-> URLTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostgresConnDetailsRaw -> Text
rawConnDetailsToUrlText

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

-- | Structured Postgres connection information as provided by the arg
-- parser or env vars.
data PostgresConnDetailsRaw = PostgresConnDetailsRaw
  { PostgresConnDetailsRaw -> String
connHost :: String,
    PostgresConnDetailsRaw -> Int
connPort :: Int,
    PostgresConnDetailsRaw -> String
connUser :: String,
    PostgresConnDetailsRaw -> String
connPassword :: String,
    PostgresConnDetailsRaw -> String
connDatabase :: String,
    PostgresConnDetailsRaw -> Maybe String
connOptions :: Maybe String
  }
  deriving (PostgresConnDetailsRaw -> PostgresConnDetailsRaw -> Bool
(PostgresConnDetailsRaw -> PostgresConnDetailsRaw -> Bool)
-> (PostgresConnDetailsRaw -> PostgresConnDetailsRaw -> Bool)
-> Eq PostgresConnDetailsRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostgresConnDetailsRaw -> PostgresConnDetailsRaw -> Bool
$c/= :: PostgresConnDetailsRaw -> PostgresConnDetailsRaw -> Bool
== :: PostgresConnDetailsRaw -> PostgresConnDetailsRaw -> Bool
$c== :: PostgresConnDetailsRaw -> PostgresConnDetailsRaw -> Bool
Eq, ReadPrec [PostgresConnDetailsRaw]
ReadPrec PostgresConnDetailsRaw
Int -> ReadS PostgresConnDetailsRaw
ReadS [PostgresConnDetailsRaw]
(Int -> ReadS PostgresConnDetailsRaw)
-> ReadS [PostgresConnDetailsRaw]
-> ReadPrec PostgresConnDetailsRaw
-> ReadPrec [PostgresConnDetailsRaw]
-> Read PostgresConnDetailsRaw
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostgresConnDetailsRaw]
$creadListPrec :: ReadPrec [PostgresConnDetailsRaw]
readPrec :: ReadPrec PostgresConnDetailsRaw
$creadPrec :: ReadPrec PostgresConnDetailsRaw
readList :: ReadS [PostgresConnDetailsRaw]
$creadList :: ReadS [PostgresConnDetailsRaw]
readsPrec :: Int -> ReadS PostgresConnDetailsRaw
$creadsPrec :: Int -> ReadS PostgresConnDetailsRaw
Read, Int -> PostgresConnDetailsRaw -> ShowS
[PostgresConnDetailsRaw] -> ShowS
PostgresConnDetailsRaw -> String
(Int -> PostgresConnDetailsRaw -> ShowS)
-> (PostgresConnDetailsRaw -> String)
-> ([PostgresConnDetailsRaw] -> ShowS)
-> Show PostgresConnDetailsRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostgresConnDetailsRaw] -> ShowS
$cshowList :: [PostgresConnDetailsRaw] -> ShowS
show :: PostgresConnDetailsRaw -> String
$cshow :: PostgresConnDetailsRaw -> String
showsPrec :: Int -> PostgresConnDetailsRaw -> ShowS
$cshowsPrec :: Int -> PostgresConnDetailsRaw -> ShowS
Show)

instance FromJSON PostgresConnDetailsRaw where
  parseJSON :: Value -> Parser PostgresConnDetailsRaw
parseJSON = String
-> (Object -> Parser PostgresConnDetailsRaw)
-> Value
-> Parser PostgresConnDetailsRaw
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PostgresConnDetailsRaw" \Object
o -> do
    String
connHost <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"host"
    Int
connPort <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port"
    String
connUser <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
    String
connPassword <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"password"
    String
connDatabase <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"database"
    Maybe String
connOptions <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
    PostgresConnDetailsRaw -> Parser PostgresConnDetailsRaw
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PostgresConnDetailsRaw -> Parser PostgresConnDetailsRaw)
-> PostgresConnDetailsRaw -> Parser PostgresConnDetailsRaw
forall a b. (a -> b) -> a -> b
$ PostgresConnDetailsRaw :: String
-> Int
-> String
-> String
-> String
-> Maybe String
-> PostgresConnDetailsRaw
PostgresConnDetailsRaw {Int
String
Maybe String
connOptions :: Maybe String
connDatabase :: String
connPassword :: String
connUser :: String
connPort :: Int
connHost :: String
connOptions :: Maybe String
connDatabase :: String
connPassword :: String
connUser :: String
connPort :: Int
connHost :: String
..}

instance ToJSON PostgresConnDetailsRaw where
  toJSON :: PostgresConnDetailsRaw -> Value
toJSON PostgresConnDetailsRaw {Int
String
Maybe String
connOptions :: Maybe String
connDatabase :: String
connPassword :: String
connUser :: String
connPort :: Int
connHost :: String
connOptions :: PostgresConnDetailsRaw -> Maybe String
connDatabase :: PostgresConnDetailsRaw -> String
connPassword :: PostgresConnDetailsRaw -> String
connUser :: PostgresConnDetailsRaw -> String
connPort :: PostgresConnDetailsRaw -> Int
connHost :: PostgresConnDetailsRaw -> String
..} =
    [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"host" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
connHost,
        Key
"port" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
connPort,
        Key
"user" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
connUser,
        Key
"password" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
connPassword,
        Key
"database" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
connDatabase
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [(String -> Pair) -> Maybe String -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"options" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) Maybe String
connOptions]

rawConnDetailsToUrlText :: PostgresConnDetailsRaw -> Text
rawConnDetailsToUrlText :: PostgresConnDetailsRaw -> Text
rawConnDetailsToUrlText PostgresConnDetailsRaw {Int
String
Maybe String
connOptions :: Maybe String
connDatabase :: String
connPassword :: String
connUser :: String
connPort :: Int
connHost :: String
connOptions :: PostgresConnDetailsRaw -> Maybe String
connDatabase :: PostgresConnDetailsRaw -> String
connPassword :: PostgresConnDetailsRaw -> String
connUser :: PostgresConnDetailsRaw -> String
connPort :: PostgresConnDetailsRaw -> Int
connHost :: PostgresConnDetailsRaw -> String
..} =
  String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    String
"postgresql://" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
connUser
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
connPassword
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"@"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
connHost
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
connPort
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
connDatabase
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"?options=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) Maybe String
connOptions

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

-- | The HGE Arg parser Command choices.
--
-- This is polymorphic so that we can pack either 'ServeOptionsRaw' or
-- 'ProServeOptionsRaw' in it.
data HGECommand a
  = HCServe a
  | HCExport
  | HCClean
  | HCVersion
  | HCDowngrade !DowngradeOptions
  deriving (Int -> HGECommand a -> ShowS
[HGECommand a] -> ShowS
HGECommand a -> String
(Int -> HGECommand a -> ShowS)
-> (HGECommand a -> String)
-> ([HGECommand a] -> ShowS)
-> Show (HGECommand a)
forall a. Show a => Int -> HGECommand a -> ShowS
forall a. Show a => [HGECommand a] -> ShowS
forall a. Show a => HGECommand a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HGECommand a] -> ShowS
$cshowList :: forall a. Show a => [HGECommand a] -> ShowS
show :: HGECommand a -> String
$cshow :: forall a. Show a => HGECommand a -> String
showsPrec :: Int -> HGECommand a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> HGECommand a -> ShowS
Show, HGECommand a -> HGECommand a -> Bool
(HGECommand a -> HGECommand a -> Bool)
-> (HGECommand a -> HGECommand a -> Bool) -> Eq (HGECommand a)
forall a. Eq a => HGECommand a -> HGECommand a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HGECommand a -> HGECommand a -> Bool
$c/= :: forall a. Eq a => HGECommand a -> HGECommand a -> Bool
== :: HGECommand a -> HGECommand a -> Bool
$c== :: forall a. Eq a => HGECommand a -> HGECommand a -> Bool
Eq)

_HCServe :: Prism' (HGECommand a) a
_HCServe :: p a (f a) -> p (HGECommand a) (f (HGECommand a))
_HCServe = (a -> HGECommand a)
-> (HGECommand a -> Maybe a)
-> Prism (HGECommand a) (HGECommand a) a a
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Lens.prism' a -> HGECommand a
forall a. a -> HGECommand a
HCServe \case
  HCServe a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
  HGECommand a
_ -> Maybe a
forall a. Maybe a
Nothing

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

-- | The Serve Command options accumulated from the Arg and Env parsers.
--
-- NOTE: A 'Nothing' value indicates the absence of a particular
-- flag. Hence types such as 'Maybe (HashSet X)' or 'Maybe Bool'.
data ServeOptionsRaw impl = ServeOptionsRaw
  { ServeOptionsRaw impl -> Maybe Port
rsoPort :: Maybe Port,
    ServeOptionsRaw impl -> Maybe HostPreference
rsoHost :: Maybe Warp.HostPreference,
    ServeOptionsRaw impl -> ConnParamsRaw
rsoConnParams :: ConnParamsRaw,
    ServeOptionsRaw impl -> Maybe TxIsolation
rsoTxIso :: Maybe Query.TxIsolation,
    ServeOptionsRaw impl -> Maybe AdminSecretHash
rsoAdminSecret :: Maybe Auth.AdminSecretHash,
    ServeOptionsRaw impl -> AuthHookRaw
rsoAuthHook :: AuthHookRaw,
    ServeOptionsRaw impl -> Maybe JWTConfig
rsoJwtSecret :: Maybe Auth.JWTConfig,
    ServeOptionsRaw impl -> Maybe RoleName
rsoUnAuthRole :: Maybe Session.RoleName,
    ServeOptionsRaw impl -> Maybe CorsConfig
rsoCorsConfig :: Maybe Cors.CorsConfig,
    ServeOptionsRaw impl -> Bool
rsoEnableConsole :: Bool,
    ServeOptionsRaw impl -> Maybe Text
rsoConsoleAssetsDir :: Maybe Text,
    ServeOptionsRaw impl -> Maybe Bool
rsoEnableTelemetry :: Maybe Bool,
    ServeOptionsRaw impl -> Bool
rsoWsReadCookie :: Bool,
    ServeOptionsRaw impl -> StringifyNumbers
rsoStringifyNum :: Schema.Options.StringifyNumbers,
    ServeOptionsRaw impl -> Maybe DangerouslyCollapseBooleans
rsoDangerousBooleanCollapse :: Maybe Schema.Options.DangerouslyCollapseBooleans,
    ServeOptionsRaw impl -> Maybe (HashSet API)
rsoEnabledAPIs :: Maybe (HashSet API),
    ServeOptionsRaw impl -> Maybe RefetchInterval
rsoMxRefetchInt :: Maybe Subscription.Options.RefetchInterval,
    ServeOptionsRaw impl -> Maybe BatchSize
rsoMxBatchSize :: Maybe Subscription.Options.BatchSize,
    -- We have different config options for livequery and streaming subscriptions
    ServeOptionsRaw impl -> Maybe RefetchInterval
rsoStreamingMxRefetchInt :: Maybe Subscription.Options.RefetchInterval,
    ServeOptionsRaw impl -> Maybe BatchSize
rsoStreamingMxBatchSize :: Maybe Subscription.Options.BatchSize,
    ServeOptionsRaw impl -> Bool
rsoEnableAllowlist :: Bool,
    ServeOptionsRaw impl -> Maybe (HashSet (EngineLogType impl))
rsoEnabledLogTypes :: Maybe (HashSet (Logging.EngineLogType impl)),
    ServeOptionsRaw impl -> Maybe LogLevel
rsoLogLevel :: Maybe Logging.LogLevel,
    ServeOptionsRaw impl -> Bool
rsoDevMode :: Bool,
    ServeOptionsRaw impl -> Maybe Bool
rsoAdminInternalErrors :: Maybe Bool,
    ServeOptionsRaw impl -> Maybe PositiveInt
rsoEventsHttpPoolSize :: Maybe Numeric.PositiveInt,
    ServeOptionsRaw impl -> Maybe (NonNegative Milliseconds)
rsoEventsFetchInterval :: Maybe (Numeric.NonNegative Milliseconds),
    ServeOptionsRaw impl -> Maybe OptionalInterval
rsoAsyncActionsFetchInterval :: Maybe OptionalInterval,
    ServeOptionsRaw impl -> RemoteSchemaPermissions
rsoEnableRemoteSchemaPermissions :: Schema.Options.RemoteSchemaPermissions,
    ServeOptionsRaw impl -> Bool
rsoWebSocketCompression :: Bool,
    ServeOptionsRaw impl -> Maybe KeepAliveDelay
rsoWebSocketKeepAlive :: Maybe KeepAliveDelay,
    ServeOptionsRaw impl -> Maybe InferFunctionPermissions
rsoInferFunctionPermissions :: Maybe Schema.Options.InferFunctionPermissions,
    ServeOptionsRaw impl -> MaintenanceMode ()
rsoEnableMaintenanceMode :: Server.Types.MaintenanceMode (),
    ServeOptionsRaw impl -> Maybe OptionalInterval
rsoSchemaPollInterval :: Maybe OptionalInterval,
    -- | See Note '$experimentalFeatures' at bottom of module
    ServeOptionsRaw impl -> Maybe (HashSet ExperimentalFeature)
rsoExperimentalFeatures :: Maybe (HashSet Server.Types.ExperimentalFeature),
    ServeOptionsRaw impl -> Maybe NonNegativeInt
rsoEventsFetchBatchSize :: Maybe Numeric.NonNegativeInt,
    ServeOptionsRaw impl -> Maybe (NonNegative Seconds)
rsoGracefulShutdownTimeout :: Maybe (Numeric.NonNegative Seconds),
    ServeOptionsRaw impl -> Maybe WSConnectionInitTimeout
rsoWebSocketConnectionInitTimeout :: Maybe WSConnectionInitTimeout,
    ServeOptionsRaw impl -> MetadataQueryLoggingMode
rsoEnableMetadataQueryLoggingEnv :: Server.Logging.MetadataQueryLoggingMode,
    -- | stores global default naming convention
    ServeOptionsRaw impl -> Maybe NamingCase
rsoDefaultNamingConvention :: Maybe NamingCase,
    ServeOptionsRaw impl -> Maybe ExtensionsSchema
rsoExtensionsSchema :: Maybe MonadTx.ExtensionsSchema
  }

-- | An 'Int' representing a Port number in the range 0 to 65536.
newtype Port = Port {Port -> Int
_getPort :: Int}
  deriving stock (Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Port] -> ShowS
$cshowList :: [Port] -> ShowS
show :: Port -> String
$cshow :: Port -> String
showsPrec :: Int -> Port -> ShowS
$cshowsPrec :: Int -> Port -> ShowS
Show, Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Eq Port
Eq Port
-> (Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmax :: Port -> Port -> Port
>= :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c< :: Port -> Port -> Bool
compare :: Port -> Port -> Ordering
$ccompare :: Port -> Port -> Ordering
$cp1Ord :: Eq Port
Ord, (forall x. Port -> Rep Port x)
-> (forall x. Rep Port x -> Port) -> Generic Port
forall x. Rep Port x -> Port
forall x. Port -> Rep Port x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Port x -> Port
$cfrom :: forall x. Port -> Rep Port x
Generic)
  deriving newtype ([Port] -> Value
[Port] -> Encoding
Port -> Value
Port -> Encoding
(Port -> Value)
-> (Port -> Encoding)
-> ([Port] -> Value)
-> ([Port] -> Encoding)
-> ToJSON Port
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Port] -> Encoding
$ctoEncodingList :: [Port] -> Encoding
toJSONList :: [Port] -> Value
$ctoJSONList :: [Port] -> Value
toEncoding :: Port -> Encoding
$ctoEncoding :: Port -> Encoding
toJSON :: Port -> Value
$ctoJSON :: Port -> Value
ToJSON, Port -> ()
(Port -> ()) -> NFData Port
forall a. (a -> ()) -> NFData a
rnf :: Port -> ()
$crnf :: Port -> ()
NFData, Eq Port
Eq Port -> (Accesses -> Port -> Port -> Bool) -> Cacheable Port
Accesses -> Port -> Port -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> Port -> Port -> Bool
$cunchanged :: Accesses -> Port -> Port -> Bool
$cp1Cacheable :: Eq Port
Cacheable, Int -> Port -> Int
Port -> Int
(Int -> Port -> Int) -> (Port -> Int) -> Hashable Port
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Port -> Int
$chash :: Port -> Int
hashWithSalt :: Int -> Port -> Int
$chashWithSalt :: Int -> Port -> Int
Hashable)

mkPort :: Int -> Maybe Port
mkPort :: Int -> Maybe Port
mkPort Int
x = case Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
65536 of
  Bool
True -> Port -> Maybe Port
forall a. a -> Maybe a
Just (Port -> Maybe Port) -> Port -> Maybe Port
forall a b. (a -> b) -> a -> b
$ Int -> Port
Port Int
x
  Bool
False -> Maybe Port
forall a. Maybe a
Nothing

unsafePort :: Int -> Port
unsafePort :: Int -> Port
unsafePort = Int -> Port
Port

instance FromJSON Port where
  parseJSON :: Value -> Parser Port
parseJSON = String -> (Scientific -> Parser Port) -> Value -> Parser Port
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
Aeson.withScientific String
"Int" ((Scientific -> Parser Port) -> Value -> Parser Port)
-> (Scientific -> Parser Port) -> Value -> Parser Port
forall a b. (a -> b) -> a -> b
$ \Scientific
t -> do
    case Scientific
t Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
> Scientific
0 Bool -> Bool -> Bool
&& Scientific
t Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
65536 of
      Bool
True -> Parser Port -> (Int -> Parser Port) -> Maybe Int -> Parser Port
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Port
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"integer passed is out of bounds") (Port -> Parser Port
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Port -> Parser Port) -> (Int -> Port) -> Int -> Parser Port
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Port
Port) (Maybe Int -> Parser Port) -> Maybe Int -> Parser Port
forall a b. (a -> b) -> a -> b
$ Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
t
      Bool
False -> String -> Parser Port
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"integer passed is out of bounds"

data API
  = METADATA
  | GRAPHQL
  | PGDUMP
  | DEVELOPER
  | CONFIG
  | METRICS
  deriving (Int -> API -> ShowS
[API] -> ShowS
API -> String
(Int -> API -> ShowS)
-> (API -> String) -> ([API] -> ShowS) -> Show API
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [API] -> ShowS
$cshowList :: [API] -> ShowS
show :: API -> String
$cshow :: API -> String
showsPrec :: Int -> API -> ShowS
$cshowsPrec :: Int -> API -> ShowS
Show, API -> API -> Bool
(API -> API -> Bool) -> (API -> API -> Bool) -> Eq API
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: API -> API -> Bool
$c/= :: API -> API -> Bool
== :: API -> API -> Bool
$c== :: API -> API -> Bool
Eq, ReadPrec [API]
ReadPrec API
Int -> ReadS API
ReadS [API]
(Int -> ReadS API)
-> ReadS [API] -> ReadPrec API -> ReadPrec [API] -> Read API
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [API]
$creadListPrec :: ReadPrec [API]
readPrec :: ReadPrec API
$creadPrec :: ReadPrec API
readList :: ReadS [API]
$creadList :: ReadS [API]
readsPrec :: Int -> ReadS API
$creadsPrec :: Int -> ReadS API
Read, (forall x. API -> Rep API x)
-> (forall x. Rep API x -> API) -> Generic API
forall x. Rep API x -> API
forall x. API -> Rep API x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep API x -> API
$cfrom :: forall x. API -> Rep API x
Generic)

instance FromJSON API where
  parseJSON :: Value -> Parser API
parseJSON = String -> (Text -> Parser API) -> Value -> Parser API
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"API" \case
    Text
"metadata" -> API -> Parser API
forall (f :: * -> *) a. Applicative f => a -> f a
pure API
METADATA
    Text
"graphql" -> API -> Parser API
forall (f :: * -> *) a. Applicative f => a -> f a
pure API
GRAPHQL
    Text
"pgdump" -> API -> Parser API
forall (f :: * -> *) a. Applicative f => a -> f a
pure API
PGDUMP
    Text
"developer" -> API -> Parser API
forall (f :: * -> *) a. Applicative f => a -> f a
pure API
DEVELOPER
    Text
"config" -> API -> Parser API
forall (f :: * -> *) a. Applicative f => a -> f a
pure API
CONFIG
    Text
"metrics" -> API -> Parser API
forall (f :: * -> *) a. Applicative f => a -> f a
pure API
METRICS
    Text
x -> String -> Parser API
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser API) -> String -> Parser API
forall a b. (a -> b) -> a -> b
$ String
"unexpected string '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'."

instance ToJSON API where
  toJSON :: API -> Value
toJSON = \case
    API
METADATA -> Text -> Value
Aeson.String Text
"metadata"
    API
GRAPHQL -> Text -> Value
Aeson.String Text
"graphql"
    API
PGDUMP -> Text -> Value
Aeson.String Text
"pgdump"
    API
DEVELOPER -> Text -> Value
Aeson.String Text
"developer"
    API
CONFIG -> Text -> Value
Aeson.String Text
"config"
    API
METRICS -> Text -> Value
Aeson.String Text
"metrics"

instance Hashable API

data AuthHookRaw = AuthHookRaw
  { AuthHookRaw -> Maybe Text
ahrUrl :: Maybe Text,
    AuthHookRaw -> Maybe AuthHookType
ahrType :: Maybe Auth.AuthHookType
  }

-- | Sleep time interval for recurring activities such as (@'asyncActionsProcessor')
--   Presently 'msToOptionalInterval' interprets `0` as Skip.
data OptionalInterval
  = -- | No polling
    Skip
  | -- | Interval time
    Interval (Numeric.NonNegative Milliseconds)
  deriving (Int -> OptionalInterval -> ShowS
[OptionalInterval] -> ShowS
OptionalInterval -> String
(Int -> OptionalInterval -> ShowS)
-> (OptionalInterval -> String)
-> ([OptionalInterval] -> ShowS)
-> Show OptionalInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionalInterval] -> ShowS
$cshowList :: [OptionalInterval] -> ShowS
show :: OptionalInterval -> String
$cshow :: OptionalInterval -> String
showsPrec :: Int -> OptionalInterval -> ShowS
$cshowsPrec :: Int -> OptionalInterval -> ShowS
Show, OptionalInterval -> OptionalInterval -> Bool
(OptionalInterval -> OptionalInterval -> Bool)
-> (OptionalInterval -> OptionalInterval -> Bool)
-> Eq OptionalInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionalInterval -> OptionalInterval -> Bool
$c/= :: OptionalInterval -> OptionalInterval -> Bool
== :: OptionalInterval -> OptionalInterval -> Bool
$c== :: OptionalInterval -> OptionalInterval -> Bool
Eq)

msToOptionalInterval :: Numeric.NonNegative Milliseconds -> OptionalInterval
msToOptionalInterval :: NonNegative Milliseconds -> OptionalInterval
msToOptionalInterval = \case
  (NonNegative Milliseconds -> Milliseconds
forall a. NonNegative a -> a
Numeric.getNonNegative -> Milliseconds
0) -> OptionalInterval
Skip
  NonNegative Milliseconds
s -> NonNegative Milliseconds -> OptionalInterval
Interval NonNegative Milliseconds
s

instance FromJSON OptionalInterval where
  parseJSON :: Value -> Parser OptionalInterval
parseJSON Value
v = NonNegative Milliseconds -> OptionalInterval
msToOptionalInterval (NonNegative Milliseconds -> OptionalInterval)
-> Parser (NonNegative Milliseconds) -> Parser OptionalInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (NonNegative Milliseconds)
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v

instance ToJSON OptionalInterval where
  toJSON :: OptionalInterval -> Value
toJSON = \case
    OptionalInterval
Skip -> Milliseconds -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON @Milliseconds Milliseconds
0
    Interval NonNegative Milliseconds
s -> NonNegative Milliseconds -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON NonNegative Milliseconds
s

-- | The Raw configuration data from the Arg and Env parsers needed to
-- construct a 'ConnParams'
data ConnParamsRaw = ConnParamsRaw
  { -- NOTE: Should any of these types be 'PositiveInt'?
    ConnParamsRaw -> Maybe NonNegativeInt
rcpStripes :: Maybe Numeric.NonNegativeInt,
    ConnParamsRaw -> Maybe NonNegativeInt
rcpConns :: Maybe Numeric.NonNegativeInt,
    ConnParamsRaw -> Maybe NonNegativeInt
rcpIdleTime :: Maybe Numeric.NonNegativeInt,
    -- | Time from connection creation after which to destroy a connection and
    -- choose a different/new one.
    ConnParamsRaw -> Maybe (NonNegative NominalDiffTime)
rcpConnLifetime :: Maybe (Numeric.NonNegative Time.NominalDiffTime),
    ConnParamsRaw -> Maybe Bool
rcpAllowPrepare :: Maybe Bool,
    -- | See @HASURA_GRAPHQL_PG_POOL_TIMEOUT@
    ConnParamsRaw -> Maybe (NonNegative NominalDiffTime)
rcpPoolTimeout :: Maybe (Numeric.NonNegative Time.NominalDiffTime)
  }
  deriving (Int -> ConnParamsRaw -> ShowS
[ConnParamsRaw] -> ShowS
ConnParamsRaw -> String
(Int -> ConnParamsRaw -> ShowS)
-> (ConnParamsRaw -> String)
-> ([ConnParamsRaw] -> ShowS)
-> Show ConnParamsRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnParamsRaw] -> ShowS
$cshowList :: [ConnParamsRaw] -> ShowS
show :: ConnParamsRaw -> String
$cshow :: ConnParamsRaw -> String
showsPrec :: Int -> ConnParamsRaw -> ShowS
$cshowsPrec :: Int -> ConnParamsRaw -> ShowS
Show, ConnParamsRaw -> ConnParamsRaw -> Bool
(ConnParamsRaw -> ConnParamsRaw -> Bool)
-> (ConnParamsRaw -> ConnParamsRaw -> Bool) -> Eq ConnParamsRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnParamsRaw -> ConnParamsRaw -> Bool
$c/= :: ConnParamsRaw -> ConnParamsRaw -> Bool
== :: ConnParamsRaw -> ConnParamsRaw -> Bool
$c== :: ConnParamsRaw -> ConnParamsRaw -> Bool
Eq)

newtype KeepAliveDelay = KeepAliveDelay {KeepAliveDelay -> NonNegative Seconds
unKeepAliveDelay :: Numeric.NonNegative Seconds}
  deriving (KeepAliveDelay -> KeepAliveDelay -> Bool
(KeepAliveDelay -> KeepAliveDelay -> Bool)
-> (KeepAliveDelay -> KeepAliveDelay -> Bool) -> Eq KeepAliveDelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeepAliveDelay -> KeepAliveDelay -> Bool
$c/= :: KeepAliveDelay -> KeepAliveDelay -> Bool
== :: KeepAliveDelay -> KeepAliveDelay -> Bool
$c== :: KeepAliveDelay -> KeepAliveDelay -> Bool
Eq, Int -> KeepAliveDelay -> ShowS
[KeepAliveDelay] -> ShowS
KeepAliveDelay -> String
(Int -> KeepAliveDelay -> ShowS)
-> (KeepAliveDelay -> String)
-> ([KeepAliveDelay] -> ShowS)
-> Show KeepAliveDelay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeepAliveDelay] -> ShowS
$cshowList :: [KeepAliveDelay] -> ShowS
show :: KeepAliveDelay -> String
$cshow :: KeepAliveDelay -> String
showsPrec :: Int -> KeepAliveDelay -> ShowS
$cshowsPrec :: Int -> KeepAliveDelay -> ShowS
Show)

instance FromJSON KeepAliveDelay where
  parseJSON :: Value -> Parser KeepAliveDelay
parseJSON = String
-> (Object -> Parser KeepAliveDelay)
-> Value
-> Parser KeepAliveDelay
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"KeepAliveDelay" \Object
o -> do
    NonNegative Seconds
unKeepAliveDelay <- Object
o Object -> Key -> Parser (NonNegative Seconds)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keep_alive_delay"
    KeepAliveDelay -> Parser KeepAliveDelay
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeepAliveDelay -> Parser KeepAliveDelay)
-> KeepAliveDelay -> Parser KeepAliveDelay
forall a b. (a -> b) -> a -> b
$ KeepAliveDelay :: NonNegative Seconds -> KeepAliveDelay
KeepAliveDelay {NonNegative Seconds
unKeepAliveDelay :: NonNegative Seconds
unKeepAliveDelay :: NonNegative Seconds
..}

instance ToJSON KeepAliveDelay where
  toJSON :: KeepAliveDelay -> Value
toJSON KeepAliveDelay {NonNegative Seconds
unKeepAliveDelay :: NonNegative Seconds
unKeepAliveDelay :: KeepAliveDelay -> NonNegative Seconds
..} =
    [Pair] -> Value
Aeson.object [Key
"keep_alive_delay" Key -> NonNegative Seconds -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonNegative Seconds
unKeepAliveDelay]

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

-- | The timeout duration in 'Seconds' for a WebSocket connection.
newtype WSConnectionInitTimeout = WSConnectionInitTimeout {WSConnectionInitTimeout -> NonNegative Seconds
unWSConnectionInitTimeout :: Numeric.NonNegative Seconds}
  deriving newtype (Int -> WSConnectionInitTimeout -> ShowS
[WSConnectionInitTimeout] -> ShowS
WSConnectionInitTimeout -> String
(Int -> WSConnectionInitTimeout -> ShowS)
-> (WSConnectionInitTimeout -> String)
-> ([WSConnectionInitTimeout] -> ShowS)
-> Show WSConnectionInitTimeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WSConnectionInitTimeout] -> ShowS
$cshowList :: [WSConnectionInitTimeout] -> ShowS
show :: WSConnectionInitTimeout -> String
$cshow :: WSConnectionInitTimeout -> String
showsPrec :: Int -> WSConnectionInitTimeout -> ShowS
$cshowsPrec :: Int -> WSConnectionInitTimeout -> ShowS
Show, WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
(WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool)
-> (WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool)
-> Eq WSConnectionInitTimeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
$c/= :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
== :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
$c== :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
Eq, Eq WSConnectionInitTimeout
Eq WSConnectionInitTimeout
-> (WSConnectionInitTimeout -> WSConnectionInitTimeout -> Ordering)
-> (WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool)
-> (WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool)
-> (WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool)
-> (WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool)
-> (WSConnectionInitTimeout
    -> WSConnectionInitTimeout -> WSConnectionInitTimeout)
-> (WSConnectionInitTimeout
    -> WSConnectionInitTimeout -> WSConnectionInitTimeout)
-> Ord WSConnectionInitTimeout
WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
WSConnectionInitTimeout -> WSConnectionInitTimeout -> Ordering
WSConnectionInitTimeout
-> WSConnectionInitTimeout -> WSConnectionInitTimeout
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WSConnectionInitTimeout
-> WSConnectionInitTimeout -> WSConnectionInitTimeout
$cmin :: WSConnectionInitTimeout
-> WSConnectionInitTimeout -> WSConnectionInitTimeout
max :: WSConnectionInitTimeout
-> WSConnectionInitTimeout -> WSConnectionInitTimeout
$cmax :: WSConnectionInitTimeout
-> WSConnectionInitTimeout -> WSConnectionInitTimeout
>= :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
$c>= :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
> :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
$c> :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
<= :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
$c<= :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
< :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
$c< :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Bool
compare :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Ordering
$ccompare :: WSConnectionInitTimeout -> WSConnectionInitTimeout -> Ordering
$cp1Ord :: Eq WSConnectionInitTimeout
Ord)

instance FromJSON WSConnectionInitTimeout where
  parseJSON :: Value -> Parser WSConnectionInitTimeout
parseJSON = String
-> (Object -> Parser WSConnectionInitTimeout)
-> Value
-> Parser WSConnectionInitTimeout
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"WSConnectionInitTimeout" \Object
o -> do
    NonNegative Seconds
unWSConnectionInitTimeout <- Object
o Object -> Key -> Parser (NonNegative Seconds)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"w_s_connection_init_timeout"
    WSConnectionInitTimeout -> Parser WSConnectionInitTimeout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WSConnectionInitTimeout -> Parser WSConnectionInitTimeout)
-> WSConnectionInitTimeout -> Parser WSConnectionInitTimeout
forall a b. (a -> b) -> a -> b
$ WSConnectionInitTimeout :: NonNegative Seconds -> WSConnectionInitTimeout
WSConnectionInitTimeout {NonNegative Seconds
unWSConnectionInitTimeout :: NonNegative Seconds
unWSConnectionInitTimeout :: NonNegative Seconds
..}

instance ToJSON WSConnectionInitTimeout where
  toJSON :: WSConnectionInitTimeout -> Value
toJSON WSConnectionInitTimeout {NonNegative Seconds
unWSConnectionInitTimeout :: NonNegative Seconds
unWSConnectionInitTimeout :: WSConnectionInitTimeout -> NonNegative Seconds
..} =
    [Pair] -> Value
Aeson.object [Key
"w_s_connection_init_timeout" Key -> NonNegative Seconds -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonNegative Seconds
unWSConnectionInitTimeout]

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

-- | The final Serve Command options accummulated from the Arg Parser
-- and the Environment, fully processed and ready to apply when
-- running the server.
data ServeOptions impl = ServeOptions
  { ServeOptions impl -> Port
soPort :: Port,
    ServeOptions impl -> HostPreference
soHost :: Warp.HostPreference,
    ServeOptions impl -> ConnParams
soConnParams :: Query.ConnParams,
    ServeOptions impl -> TxIsolation
soTxIso :: Query.TxIsolation,
    ServeOptions impl -> HashSet AdminSecretHash
soAdminSecret :: HashSet Auth.AdminSecretHash,
    ServeOptions impl -> Maybe AuthHook
soAuthHook :: Maybe Auth.AuthHook,
    ServeOptions impl -> [JWTConfig]
soJwtSecret :: [Auth.JWTConfig],
    ServeOptions impl -> Maybe RoleName
soUnAuthRole :: Maybe Session.RoleName,
    ServeOptions impl -> CorsConfig
soCorsConfig :: Cors.CorsConfig,
    ServeOptions impl -> Bool
soEnableConsole :: Bool,
    ServeOptions impl -> Maybe Text
soConsoleAssetsDir :: Maybe Text,
    ServeOptions impl -> Bool
soEnableTelemetry :: Bool,
    ServeOptions impl -> StringifyNumbers
soStringifyNum :: Schema.Options.StringifyNumbers,
    ServeOptions impl -> DangerouslyCollapseBooleans
soDangerousBooleanCollapse :: Schema.Options.DangerouslyCollapseBooleans,
    ServeOptions impl -> HashSet API
soEnabledAPIs :: HashSet API,
    ServeOptions impl -> LiveQueriesOptions
soLiveQueryOpts :: Subscription.Options.LiveQueriesOptions,
    ServeOptions impl -> LiveQueriesOptions
soStreamingQueryOpts :: Subscription.Options.StreamQueriesOptions,
    ServeOptions impl -> Bool
soEnableAllowlist :: Bool,
    ServeOptions impl -> HashSet (EngineLogType impl)
soEnabledLogTypes :: HashSet (Logging.EngineLogType impl),
    ServeOptions impl -> LogLevel
soLogLevel :: Logging.LogLevel,
    ServeOptions impl -> ResponseInternalErrorsConfig
soResponseInternalErrorsConfig :: ResponseInternalErrorsConfig,
    ServeOptions impl -> PositiveInt
soEventsHttpPoolSize :: Numeric.PositiveInt,
    ServeOptions impl -> NonNegative Milliseconds
soEventsFetchInterval :: Numeric.NonNegative Milliseconds,
    ServeOptions impl -> OptionalInterval
soAsyncActionsFetchInterval :: OptionalInterval,
    ServeOptions impl -> RemoteSchemaPermissions
soEnableRemoteSchemaPermissions :: Schema.Options.RemoteSchemaPermissions,
    ServeOptions impl -> ConnectionOptions
soConnectionOptions :: WebSockets.ConnectionOptions,
    ServeOptions impl -> KeepAliveDelay
soWebSocketKeepAlive :: KeepAliveDelay,
    ServeOptions impl -> InferFunctionPermissions
soInferFunctionPermissions :: Schema.Options.InferFunctionPermissions,
    ServeOptions impl -> MaintenanceMode ()
soEnableMaintenanceMode :: Server.Types.MaintenanceMode (),
    ServeOptions impl -> OptionalInterval
soSchemaPollInterval :: OptionalInterval,
    -- | See note '$experimentalFeatures'
    ServeOptions impl -> HashSet ExperimentalFeature
soExperimentalFeatures :: HashSet Server.Types.ExperimentalFeature,
    ServeOptions impl -> NonNegativeInt
soEventsFetchBatchSize :: Numeric.NonNegativeInt,
    ServeOptions impl -> Bool
soDevMode :: Bool,
    ServeOptions impl -> NonNegative Seconds
soGracefulShutdownTimeout :: Numeric.NonNegative Seconds,
    ServeOptions impl -> WSConnectionInitTimeout
soWebSocketConnectionInitTimeout :: WSConnectionInitTimeout,
    ServeOptions impl -> EventingMode
soEventingMode :: Server.Types.EventingMode,
    -- | See note '$readOnlyMode'
    ServeOptions impl -> ReadOnlyMode
soReadOnlyMode :: Server.Types.ReadOnlyMode,
    ServeOptions impl -> MetadataQueryLoggingMode
soEnableMetadataQueryLogging :: Server.Logging.MetadataQueryLoggingMode,
    ServeOptions impl -> Maybe NamingCase
soDefaultNamingConvention :: Maybe NamingCase,
    ServeOptions impl -> ExtensionsSchema
soExtensionsSchema :: MonadTx.ExtensionsSchema
  }

-- | 'ResponseInternalErrorsConfig' represents the encoding of the
-- internal errors in the response to the client.
--
-- For more details, see this github comment:
-- https://github.com/hasura/graphql-engine/issues/4031#issuecomment-609747705
data ResponseInternalErrorsConfig
  = InternalErrorsAllRequests
  | InternalErrorsAdminOnly
  | InternalErrorsDisabled
  deriving (Int -> ResponseInternalErrorsConfig -> ShowS
[ResponseInternalErrorsConfig] -> ShowS
ResponseInternalErrorsConfig -> String
(Int -> ResponseInternalErrorsConfig -> ShowS)
-> (ResponseInternalErrorsConfig -> String)
-> ([ResponseInternalErrorsConfig] -> ShowS)
-> Show ResponseInternalErrorsConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseInternalErrorsConfig] -> ShowS
$cshowList :: [ResponseInternalErrorsConfig] -> ShowS
show :: ResponseInternalErrorsConfig -> String
$cshow :: ResponseInternalErrorsConfig -> String
showsPrec :: Int -> ResponseInternalErrorsConfig -> ShowS
$cshowsPrec :: Int -> ResponseInternalErrorsConfig -> ShowS
Show, ResponseInternalErrorsConfig
-> ResponseInternalErrorsConfig -> Bool
(ResponseInternalErrorsConfig
 -> ResponseInternalErrorsConfig -> Bool)
-> (ResponseInternalErrorsConfig
    -> ResponseInternalErrorsConfig -> Bool)
-> Eq ResponseInternalErrorsConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseInternalErrorsConfig
-> ResponseInternalErrorsConfig -> Bool
$c/= :: ResponseInternalErrorsConfig
-> ResponseInternalErrorsConfig -> Bool
== :: ResponseInternalErrorsConfig
-> ResponseInternalErrorsConfig -> Bool
$c== :: ResponseInternalErrorsConfig
-> ResponseInternalErrorsConfig -> Bool
Eq)

shouldIncludeInternal :: Session.RoleName -> ResponseInternalErrorsConfig -> Bool
shouldIncludeInternal :: RoleName -> ResponseInternalErrorsConfig -> Bool
shouldIncludeInternal RoleName
role = \case
  ResponseInternalErrorsConfig
InternalErrorsAllRequests -> Bool
True
  ResponseInternalErrorsConfig
InternalErrorsAdminOnly -> RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
Session.adminRoleName
  ResponseInternalErrorsConfig
InternalErrorsDisabled -> Bool
False

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

-- | The Downgrade Command options. These are only sourced from the
-- Arg Parser and are used directly in 'Hasura.Server.Migrate'.
data DowngradeOptions = DowngradeOptions
  { DowngradeOptions -> Text
dgoTargetVersion :: Text,
    DowngradeOptions -> Bool
dgoDryRun :: Bool
  }
  deriving (Int -> DowngradeOptions -> ShowS
[DowngradeOptions] -> ShowS
DowngradeOptions -> String
(Int -> DowngradeOptions -> ShowS)
-> (DowngradeOptions -> String)
-> ([DowngradeOptions] -> ShowS)
-> Show DowngradeOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DowngradeOptions] -> ShowS
$cshowList :: [DowngradeOptions] -> ShowS
show :: DowngradeOptions -> String
$cshow :: DowngradeOptions -> String
showsPrec :: Int -> DowngradeOptions -> ShowS
$cshowsPrec :: Int -> DowngradeOptions -> ShowS
Show, DowngradeOptions -> DowngradeOptions -> Bool
(DowngradeOptions -> DowngradeOptions -> Bool)
-> (DowngradeOptions -> DowngradeOptions -> Bool)
-> Eq DowngradeOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DowngradeOptions -> DowngradeOptions -> Bool
$c/= :: DowngradeOptions -> DowngradeOptions -> Bool
== :: DowngradeOptions -> DowngradeOptions -> Bool
$c== :: DowngradeOptions -> DowngradeOptions -> Bool
Eq)

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

-- $experimentalFeatures
-- Note Experimental features:
--
-- The graphql-engine accepts a list of experimental features that can be
-- enabled at the startup. Experimental features are a way to introduce
-- new, but not stable features to our users in a manner in which they have
-- the choice to enable or disable a certain feature(s).
--
-- The objective of an experimental feature should be that when the feature is disabled,
-- the graphql-engine should work the same way as it worked before adding the said feature.
--
-- The experimental feature's flag is `--experimental-features` and the corresponding
-- environment variable is `HASURA_GRAPHQL_EXPERIMENTAL_FEATURES` which expects a comma-seperated
-- value.
--
-- When an experimental feature is stable enough i.e. it's stable through multiple non-beta releases
-- then we make the feature not experimental i.e. it will always be enabled. Note that when we do this
-- we still have to support parsing of the experimental feature because users of the previous version
-- will have it enabled and when they upgrade an error should not be thrown at the startup. For example:
--
-- The inherited roles was an experimental feature when introduced and it was enabled by
-- setting `--experimental-features` to `inherited_roles` and then it was decided to make the inherited roles
-- a stable feature, so it was removed as an experimental feature but the code was modified such that
-- `--experimental-features inherited_roles` to not throw an error.

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

-- $readOnlyMode
-- Note ReadOnly Mode:
--
-- This mode starts the server in a (database) read-only mode. That is, only
-- read-only queries are allowed on users' database sources, and write
-- queries throw a runtime error. The use-case is for failsafe operations.
-- Metadata APIs are also disabled.
--
-- Following is the precise behaviour -
--   1. For any GraphQL API (relay/hasura; http/websocket) - disable execution of
--   mutations
--   2. Metadata API is disabled
--   3. /v2/query API - insert, delete, update, run_sql are disabled
--   4. /v1/query API - insert, delete, update, run_sql are disabled
--   5. No source catalog migrations are run
--   6. During build schema cache phase, building event triggers are disabled (as
--   they create corresponding database triggers)