{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Postgres Connection Settings
--
-- This module contains types and combinators related to postgres connection,
-- pool, and replica related settings.
module Hasura.Backends.Postgres.Connection.Settings
  ( PostgresPoolSettings (..),
    PostgresSourceConnInfo (..),
    PostgresConnConfiguration (..),
    PGClientCerts (..),
    CertVar (..),
    CertData (..),
    SSLMode (..),
    DefaultPostgresPoolSettings (..),
    ConnectionTemplate (..),
    PostgresConnectionSetMemberName (..),
    PostgresConnectionSet (..),
    PostgresConnectionSetMember (..),
    KritiTemplate (..),
    getDefaultPGPoolSettingIfNotExists,
    defaultPostgresPoolSettings,
    defaultPostgresExtensionsSchema,
    setPostgresPoolSettings,
  )
where

import Autodocodec hiding (object, (.=))
import Autodocodec qualified as AC
import Data.Aeson
import Data.Aeson.Casing (aesonDrop)
import Data.Aeson.Extended (mapWithJSONPath)
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Char (toLower)
import Data.HashMap.Strict.NonEmpty qualified as NEMap
import Data.Hashable (hashWithSalt)
import Data.List.Extended qualified as L (uniques)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Semigroup (Max (..))
import Data.Text (unpack)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Extended (ToTxt (toTxt), dquote, dquoteList)
import Data.Text.NonEmpty
import Data.Time
import Data.Time.Clock.Compat ()
import Database.PG.Query qualified as PG
import Hasura.Base.Instances ()
import Hasura.Prelude
import Hasura.RQL.Types.Common (UrlConf (..))
import Hasura.SQL.Types (ExtensionsSchema (..))
import Hasura.Server.Utils (parseConnLifeTime, readIsoLevel)
import Kriti qualified
import Kriti.Error qualified as Kriti
import Kriti.Parser qualified as Kriti
import Prettyprinter qualified as PP
import Prettyprinter.Render.Text qualified as PP
import Test.QuickCheck.Instances.Semigroup ()
import Test.QuickCheck.Instances.Time ()

data PostgresPoolSettings = PostgresPoolSettings
  { PostgresPoolSettings -> Maybe Int
_ppsMaxConnections :: Maybe Int,
    PostgresPoolSettings -> Maybe Int
_ppsTotalMaxConnections :: Maybe Int,
    PostgresPoolSettings -> Maybe Int
_ppsIdleTimeout :: Maybe Int,
    PostgresPoolSettings -> Maybe Int
_ppsRetries :: Maybe Int,
    PostgresPoolSettings -> Maybe NominalDiffTime
_ppsPoolTimeout :: Maybe NominalDiffTime,
    PostgresPoolSettings -> Maybe NominalDiffTime
_ppsConnectionLifetime :: Maybe NominalDiffTime
  }
  deriving (Int -> PostgresPoolSettings -> ShowS
[PostgresPoolSettings] -> ShowS
PostgresPoolSettings -> String
(Int -> PostgresPoolSettings -> ShowS)
-> (PostgresPoolSettings -> String)
-> ([PostgresPoolSettings] -> ShowS)
-> Show PostgresPoolSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostgresPoolSettings -> ShowS
showsPrec :: Int -> PostgresPoolSettings -> ShowS
$cshow :: PostgresPoolSettings -> String
show :: PostgresPoolSettings -> String
$cshowList :: [PostgresPoolSettings] -> ShowS
showList :: [PostgresPoolSettings] -> ShowS
Show, PostgresPoolSettings -> PostgresPoolSettings -> Bool
(PostgresPoolSettings -> PostgresPoolSettings -> Bool)
-> (PostgresPoolSettings -> PostgresPoolSettings -> Bool)
-> Eq PostgresPoolSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostgresPoolSettings -> PostgresPoolSettings -> Bool
== :: PostgresPoolSettings -> PostgresPoolSettings -> Bool
$c/= :: PostgresPoolSettings -> PostgresPoolSettings -> Bool
/= :: PostgresPoolSettings -> PostgresPoolSettings -> Bool
Eq, (forall x. PostgresPoolSettings -> Rep PostgresPoolSettings x)
-> (forall x. Rep PostgresPoolSettings x -> PostgresPoolSettings)
-> Generic PostgresPoolSettings
forall x. Rep PostgresPoolSettings x -> PostgresPoolSettings
forall x. PostgresPoolSettings -> Rep PostgresPoolSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PostgresPoolSettings -> Rep PostgresPoolSettings x
from :: forall x. PostgresPoolSettings -> Rep PostgresPoolSettings x
$cto :: forall x. Rep PostgresPoolSettings x -> PostgresPoolSettings
to :: forall x. Rep PostgresPoolSettings x -> PostgresPoolSettings
Generic)

instance Hashable PostgresPoolSettings

instance NFData PostgresPoolSettings

instance HasCodec PostgresPoolSettings where
  codec :: JSONCodec PostgresPoolSettings
codec =
    Text
-> JSONCodec PostgresPoolSettings -> JSONCodec PostgresPoolSettings
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
CommentCodec Text
"https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgpoolsettings"
      (JSONCodec PostgresPoolSettings -> JSONCodec PostgresPoolSettings)
-> JSONCodec PostgresPoolSettings -> JSONCodec PostgresPoolSettings
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec PostgresPoolSettings PostgresPoolSettings
-> JSONCodec PostgresPoolSettings
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"PostgresPoolSettings"
      (ObjectCodec PostgresPoolSettings PostgresPoolSettings
 -> JSONCodec PostgresPoolSettings)
-> ObjectCodec PostgresPoolSettings PostgresPoolSettings
-> JSONCodec PostgresPoolSettings
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe NominalDiffTime
-> Maybe NominalDiffTime
-> PostgresPoolSettings
PostgresPoolSettings
      (Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe NominalDiffTime
 -> Maybe NominalDiffTime
 -> PostgresPoolSettings)
-> Codec Object PostgresPoolSettings (Maybe Int)
-> Codec
     Object
     PostgresPoolSettings
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe NominalDiffTime
      -> Maybe NominalDiffTime
      -> PostgresPoolSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec (Maybe Int) (Maybe Int)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"max_connections" Text
maxConnectionsDoc
      ObjectCodec (Maybe Int) (Maybe Int)
-> (PostgresPoolSettings -> Maybe Int)
-> Codec Object PostgresPoolSettings (Maybe Int)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresPoolSettings -> Maybe Int
_ppsMaxConnections
        Codec
  Object
  PostgresPoolSettings
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe NominalDiffTime
   -> Maybe NominalDiffTime
   -> PostgresPoolSettings)
-> Codec Object PostgresPoolSettings (Maybe Int)
-> Codec
     Object
     PostgresPoolSettings
     (Maybe Int
      -> Maybe Int
      -> Maybe NominalDiffTime
      -> Maybe NominalDiffTime
      -> PostgresPoolSettings)
forall a b.
Codec Object PostgresPoolSettings (a -> b)
-> Codec Object PostgresPoolSettings a
-> Codec Object PostgresPoolSettings b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Int) (Maybe Int)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"total_max_connections" Text
totalMaxConnectionsDoc
      ObjectCodec (Maybe Int) (Maybe Int)
-> (PostgresPoolSettings -> Maybe Int)
-> Codec Object PostgresPoolSettings (Maybe Int)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresPoolSettings -> Maybe Int
_ppsTotalMaxConnections
        Codec
  Object
  PostgresPoolSettings
  (Maybe Int
   -> Maybe Int
   -> Maybe NominalDiffTime
   -> Maybe NominalDiffTime
   -> PostgresPoolSettings)
-> Codec Object PostgresPoolSettings (Maybe Int)
-> Codec
     Object
     PostgresPoolSettings
     (Maybe Int
      -> Maybe NominalDiffTime
      -> Maybe NominalDiffTime
      -> PostgresPoolSettings)
forall a b.
Codec Object PostgresPoolSettings (a -> b)
-> Codec Object PostgresPoolSettings a
-> Codec Object PostgresPoolSettings b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Int) (Maybe Int)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"idle_timeout" Text
idleTimeoutDoc
      ObjectCodec (Maybe Int) (Maybe Int)
-> (PostgresPoolSettings -> Maybe Int)
-> Codec Object PostgresPoolSettings (Maybe Int)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresPoolSettings -> Maybe Int
_ppsIdleTimeout
        Codec
  Object
  PostgresPoolSettings
  (Maybe Int
   -> Maybe NominalDiffTime
   -> Maybe NominalDiffTime
   -> PostgresPoolSettings)
-> Codec Object PostgresPoolSettings (Maybe Int)
-> Codec
     Object
     PostgresPoolSettings
     (Maybe NominalDiffTime
      -> Maybe NominalDiffTime -> PostgresPoolSettings)
forall a b.
Codec Object PostgresPoolSettings (a -> b)
-> Codec Object PostgresPoolSettings a
-> Codec Object PostgresPoolSettings b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Int) (Maybe Int)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"retries" Text
retriesDoc
      ObjectCodec (Maybe Int) (Maybe Int)
-> (PostgresPoolSettings -> Maybe Int)
-> Codec Object PostgresPoolSettings (Maybe Int)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresPoolSettings -> Maybe Int
_ppsRetries
        Codec
  Object
  PostgresPoolSettings
  (Maybe NominalDiffTime
   -> Maybe NominalDiffTime -> PostgresPoolSettings)
-> Codec Object PostgresPoolSettings (Maybe NominalDiffTime)
-> Codec
     Object
     PostgresPoolSettings
     (Maybe NominalDiffTime -> PostgresPoolSettings)
forall a b.
Codec Object PostgresPoolSettings (a -> b)
-> Codec Object PostgresPoolSettings a
-> Codec Object PostgresPoolSettings b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text
-> ObjectCodec (Maybe NominalDiffTime) (Maybe NominalDiffTime)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"pool_timeout" Text
poolTimeoutDoc
      ObjectCodec (Maybe NominalDiffTime) (Maybe NominalDiffTime)
-> (PostgresPoolSettings -> Maybe NominalDiffTime)
-> Codec Object PostgresPoolSettings (Maybe NominalDiffTime)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresPoolSettings -> Maybe NominalDiffTime
_ppsPoolTimeout
        Codec
  Object
  PostgresPoolSettings
  (Maybe NominalDiffTime -> PostgresPoolSettings)
-> Codec Object PostgresPoolSettings (Maybe NominalDiffTime)
-> ObjectCodec PostgresPoolSettings PostgresPoolSettings
forall a b.
Codec Object PostgresPoolSettings (a -> b)
-> Codec Object PostgresPoolSettings a
-> Codec Object PostgresPoolSettings b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe NominalDiffTime -> Maybe NominalDiffTime
parseConnLifeTime (Maybe NominalDiffTime -> Maybe NominalDiffTime)
-> ObjectCodec (Maybe NominalDiffTime) (Maybe NominalDiffTime)
-> ObjectCodec (Maybe NominalDiffTime) (Maybe NominalDiffTime)
forall oldOutput newOutput context input.
(oldOutput -> newOutput)
-> Codec context input oldOutput -> Codec context input newOutput
`rmapCodec` Text
-> Text
-> ObjectCodec (Maybe NominalDiffTime) (Maybe NominalDiffTime)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"connection_lifetime" Text
connectionLifetimeDoc)
      ObjectCodec (Maybe NominalDiffTime) (Maybe NominalDiffTime)
-> (PostgresPoolSettings -> Maybe NominalDiffTime)
-> Codec Object PostgresPoolSettings (Maybe NominalDiffTime)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresPoolSettings -> Maybe NominalDiffTime
_ppsConnectionLifetime
    where
      maxConnectionsDoc :: Text
maxConnectionsDoc = Text
"Maximum number of connections to be kept in the pool (default: 50)"
      totalMaxConnectionsDoc :: Text
totalMaxConnectionsDoc = Text
"Total maximum number of connections across all instances (cloud only, default: null)"
      idleTimeoutDoc :: Text
idleTimeoutDoc = Text
"The idle timeout (in seconds) per connection (default: 180)"
      retriesDoc :: Text
retriesDoc = Text
"Number of retries to perform (default: 1)"
      poolTimeoutDoc :: Text
poolTimeoutDoc = Text
"Maximum time to wait while acquiring a Postgres connection from the pool, in seconds (default: forever)"
      connectionLifetimeDoc :: Text
connectionLifetimeDoc =
        [Text] -> Text
T.unwords
          [ Text
"Time from connection creation after which the connection should be",
            Text
"destroyed and a new one created. A value of 0 indicates we should",
            Text
"never destroy an active connection. If 0 is passed, memory from large",
            Text
"query results may not be reclaimed. (default: 600 sec)"
          ]
      infix 8 .==
      .== :: ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(.==) = ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(AC..=)

instance ToJSON PostgresPoolSettings where
  toJSON :: PostgresPoolSettings -> Value
toJSON = Options -> PostgresPoolSettings -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}
  toEncoding :: PostgresPoolSettings -> Encoding
toEncoding = Options -> PostgresPoolSettings -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance FromJSON PostgresPoolSettings where
  parseJSON :: Value -> Parser PostgresPoolSettings
parseJSON = String
-> (Object -> Parser PostgresPoolSettings)
-> Value
-> Parser PostgresPoolSettings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PostgresPoolSettings" ((Object -> Parser PostgresPoolSettings)
 -> Value -> Parser PostgresPoolSettings)
-> (Object -> Parser PostgresPoolSettings)
-> Value
-> Parser PostgresPoolSettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe NominalDiffTime
-> Maybe NominalDiffTime
-> PostgresPoolSettings
PostgresPoolSettings
      (Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe NominalDiffTime
 -> Maybe NominalDiffTime
 -> PostgresPoolSettings)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe NominalDiffTime
      -> Maybe NominalDiffTime
      -> PostgresPoolSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_connections"
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe NominalDiffTime
   -> Maybe NominalDiffTime
   -> PostgresPoolSettings)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe NominalDiffTime
      -> Maybe NominalDiffTime
      -> PostgresPoolSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total_max_connections"
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe NominalDiffTime
   -> Maybe NominalDiffTime
   -> PostgresPoolSettings)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe NominalDiffTime
      -> Maybe NominalDiffTime
      -> PostgresPoolSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"idle_timeout"
      Parser
  (Maybe Int
   -> Maybe NominalDiffTime
   -> Maybe NominalDiffTime
   -> PostgresPoolSettings)
-> Parser (Maybe Int)
-> Parser
     (Maybe NominalDiffTime
      -> Maybe NominalDiffTime -> PostgresPoolSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"retries"
      Parser
  (Maybe NominalDiffTime
   -> Maybe NominalDiffTime -> PostgresPoolSettings)
-> Parser (Maybe NominalDiffTime)
-> Parser (Maybe NominalDiffTime -> PostgresPoolSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe NominalDiffTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pool_timeout"
      Parser (Maybe NominalDiffTime -> PostgresPoolSettings)
-> Parser (Maybe NominalDiffTime) -> Parser PostgresPoolSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o Object -> Key -> Parser (Maybe NominalDiffTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"connection_lifetime") Parser (Maybe NominalDiffTime)
-> (Maybe NominalDiffTime -> Maybe NominalDiffTime)
-> Parser (Maybe NominalDiffTime)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe NominalDiffTime -> Maybe NominalDiffTime
parseConnLifeTime)

data DefaultPostgresPoolSettings = DefaultPostgresPoolSettings
  { DefaultPostgresPoolSettings -> Int
_dppsMaxConnections :: Int,
    DefaultPostgresPoolSettings -> Int
_dppsIdleTimeout :: Int,
    DefaultPostgresPoolSettings -> Int
_dppsRetries :: Int,
    DefaultPostgresPoolSettings -> Maybe NominalDiffTime
_dppsConnectionLifetime :: Maybe NominalDiffTime
  }
  deriving (Int -> DefaultPostgresPoolSettings -> ShowS
[DefaultPostgresPoolSettings] -> ShowS
DefaultPostgresPoolSettings -> String
(Int -> DefaultPostgresPoolSettings -> ShowS)
-> (DefaultPostgresPoolSettings -> String)
-> ([DefaultPostgresPoolSettings] -> ShowS)
-> Show DefaultPostgresPoolSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefaultPostgresPoolSettings -> ShowS
showsPrec :: Int -> DefaultPostgresPoolSettings -> ShowS
$cshow :: DefaultPostgresPoolSettings -> String
show :: DefaultPostgresPoolSettings -> String
$cshowList :: [DefaultPostgresPoolSettings] -> ShowS
showList :: [DefaultPostgresPoolSettings] -> ShowS
Show, DefaultPostgresPoolSettings -> DefaultPostgresPoolSettings -> Bool
(DefaultPostgresPoolSettings
 -> DefaultPostgresPoolSettings -> Bool)
-> (DefaultPostgresPoolSettings
    -> DefaultPostgresPoolSettings -> Bool)
-> Eq DefaultPostgresPoolSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefaultPostgresPoolSettings -> DefaultPostgresPoolSettings -> Bool
== :: DefaultPostgresPoolSettings -> DefaultPostgresPoolSettings -> Bool
$c/= :: DefaultPostgresPoolSettings -> DefaultPostgresPoolSettings -> Bool
/= :: DefaultPostgresPoolSettings -> DefaultPostgresPoolSettings -> Bool
Eq)

defaultPostgresPoolSettings :: DefaultPostgresPoolSettings
defaultPostgresPoolSettings :: DefaultPostgresPoolSettings
defaultPostgresPoolSettings = Int
-> Int
-> Int
-> Maybe NominalDiffTime
-> DefaultPostgresPoolSettings
DefaultPostgresPoolSettings Int
50 Int
180 Int
1 (NominalDiffTime -> Maybe NominalDiffTime
forall a. a -> Maybe a
Just NominalDiffTime
600)

-- Use this when you want to set only few of the PG Pool settings.
-- The values which are not set will use the default values.
setPostgresPoolSettings :: PostgresPoolSettings
setPostgresPoolSettings :: PostgresPoolSettings
setPostgresPoolSettings =
  PostgresPoolSettings
    { _ppsMaxConnections :: Maybe Int
_ppsMaxConnections = (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ DefaultPostgresPoolSettings -> Int
_dppsMaxConnections DefaultPostgresPoolSettings
defaultPostgresPoolSettings),
      _ppsTotalMaxConnections :: Maybe Int
_ppsTotalMaxConnections = Maybe Int
forall a. Maybe a
Nothing,
      _ppsIdleTimeout :: Maybe Int
_ppsIdleTimeout = (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ DefaultPostgresPoolSettings -> Int
_dppsIdleTimeout DefaultPostgresPoolSettings
defaultPostgresPoolSettings),
      _ppsRetries :: Maybe Int
_ppsRetries = (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ DefaultPostgresPoolSettings -> Int
_dppsRetries DefaultPostgresPoolSettings
defaultPostgresPoolSettings),
      _ppsPoolTimeout :: Maybe NominalDiffTime
_ppsPoolTimeout = Maybe NominalDiffTime
forall a. Maybe a
Nothing, -- @Nothing@ is the default value of the pool timeout
      _ppsConnectionLifetime :: Maybe NominalDiffTime
_ppsConnectionLifetime = DefaultPostgresPoolSettings -> Maybe NominalDiffTime
_dppsConnectionLifetime DefaultPostgresPoolSettings
defaultPostgresPoolSettings
    }

-- PG Pool Settings are not given by the user, set defaults
getDefaultPGPoolSettingIfNotExists :: Maybe PostgresPoolSettings -> DefaultPostgresPoolSettings -> (Int, Int, Int)
getDefaultPGPoolSettingIfNotExists :: Maybe PostgresPoolSettings
-> DefaultPostgresPoolSettings -> (Int, Int, Int)
getDefaultPGPoolSettingIfNotExists Maybe PostgresPoolSettings
connSettings DefaultPostgresPoolSettings
defaultPgPoolSettings =
  case Maybe PostgresPoolSettings
connSettings of
    -- Atleast one of the postgres pool settings is set, then set default values to other settings
    Just PostgresPoolSettings
connSettings' ->
      (PostgresPoolSettings -> Int
maxConnections PostgresPoolSettings
connSettings', PostgresPoolSettings -> Int
idleTimeout PostgresPoolSettings
connSettings', PostgresPoolSettings -> Int
retries PostgresPoolSettings
connSettings')
    -- No PG Pool settings provided by user, set default values for all
    Maybe PostgresPoolSettings
Nothing -> (Int
defMaxConnections, Int
defIdleTimeout, Int
defRetries)
  where
    defMaxConnections :: Int
defMaxConnections = DefaultPostgresPoolSettings -> Int
_dppsMaxConnections DefaultPostgresPoolSettings
defaultPgPoolSettings
    defIdleTimeout :: Int
defIdleTimeout = DefaultPostgresPoolSettings -> Int
_dppsIdleTimeout DefaultPostgresPoolSettings
defaultPgPoolSettings
    defRetries :: Int
defRetries = DefaultPostgresPoolSettings -> Int
_dppsRetries DefaultPostgresPoolSettings
defaultPgPoolSettings

    maxConnections :: PostgresPoolSettings -> Int
maxConnections = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defMaxConnections (Maybe Int -> Int)
-> (PostgresPoolSettings -> Maybe Int)
-> PostgresPoolSettings
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostgresPoolSettings -> Maybe Int
_ppsMaxConnections
    idleTimeout :: PostgresPoolSettings -> Int
idleTimeout = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defIdleTimeout (Maybe Int -> Int)
-> (PostgresPoolSettings -> Maybe Int)
-> PostgresPoolSettings
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostgresPoolSettings -> Maybe Int
_ppsIdleTimeout
    retries :: PostgresPoolSettings -> Int
retries = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defRetries (Maybe Int -> Int)
-> (PostgresPoolSettings -> Maybe Int)
-> PostgresPoolSettings
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostgresPoolSettings -> Maybe Int
_ppsRetries

data SSLMode
  = Disable
  | Allow
  | Prefer
  | Require
  | VerifyCA
  | VerifyFull
  deriving (SSLMode -> SSLMode -> Bool
(SSLMode -> SSLMode -> Bool)
-> (SSLMode -> SSLMode -> Bool) -> Eq SSLMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SSLMode -> SSLMode -> Bool
== :: SSLMode -> SSLMode -> Bool
$c/= :: SSLMode -> SSLMode -> Bool
/= :: SSLMode -> SSLMode -> Bool
Eq, Eq SSLMode
Eq SSLMode
-> (SSLMode -> SSLMode -> Ordering)
-> (SSLMode -> SSLMode -> Bool)
-> (SSLMode -> SSLMode -> Bool)
-> (SSLMode -> SSLMode -> Bool)
-> (SSLMode -> SSLMode -> Bool)
-> (SSLMode -> SSLMode -> SSLMode)
-> (SSLMode -> SSLMode -> SSLMode)
-> Ord SSLMode
SSLMode -> SSLMode -> Bool
SSLMode -> SSLMode -> Ordering
SSLMode -> SSLMode -> SSLMode
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
$ccompare :: SSLMode -> SSLMode -> Ordering
compare :: SSLMode -> SSLMode -> Ordering
$c< :: SSLMode -> SSLMode -> Bool
< :: SSLMode -> SSLMode -> Bool
$c<= :: SSLMode -> SSLMode -> Bool
<= :: SSLMode -> SSLMode -> Bool
$c> :: SSLMode -> SSLMode -> Bool
> :: SSLMode -> SSLMode -> Bool
$c>= :: SSLMode -> SSLMode -> Bool
>= :: SSLMode -> SSLMode -> Bool
$cmax :: SSLMode -> SSLMode -> SSLMode
max :: SSLMode -> SSLMode -> SSLMode
$cmin :: SSLMode -> SSLMode -> SSLMode
min :: SSLMode -> SSLMode -> SSLMode
Ord, (forall x. SSLMode -> Rep SSLMode x)
-> (forall x. Rep SSLMode x -> SSLMode) -> Generic SSLMode
forall x. Rep SSLMode x -> SSLMode
forall x. SSLMode -> Rep SSLMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SSLMode -> Rep SSLMode x
from :: forall x. SSLMode -> Rep SSLMode x
$cto :: forall x. Rep SSLMode x -> SSLMode
to :: forall x. Rep SSLMode x -> SSLMode
Generic, Int -> SSLMode
SSLMode -> Int
SSLMode -> [SSLMode]
SSLMode -> SSLMode
SSLMode -> SSLMode -> [SSLMode]
SSLMode -> SSLMode -> SSLMode -> [SSLMode]
(SSLMode -> SSLMode)
-> (SSLMode -> SSLMode)
-> (Int -> SSLMode)
-> (SSLMode -> Int)
-> (SSLMode -> [SSLMode])
-> (SSLMode -> SSLMode -> [SSLMode])
-> (SSLMode -> SSLMode -> [SSLMode])
-> (SSLMode -> SSLMode -> SSLMode -> [SSLMode])
-> Enum SSLMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SSLMode -> SSLMode
succ :: SSLMode -> SSLMode
$cpred :: SSLMode -> SSLMode
pred :: SSLMode -> SSLMode
$ctoEnum :: Int -> SSLMode
toEnum :: Int -> SSLMode
$cfromEnum :: SSLMode -> Int
fromEnum :: SSLMode -> Int
$cenumFrom :: SSLMode -> [SSLMode]
enumFrom :: SSLMode -> [SSLMode]
$cenumFromThen :: SSLMode -> SSLMode -> [SSLMode]
enumFromThen :: SSLMode -> SSLMode -> [SSLMode]
$cenumFromTo :: SSLMode -> SSLMode -> [SSLMode]
enumFromTo :: SSLMode -> SSLMode -> [SSLMode]
$cenumFromThenTo :: SSLMode -> SSLMode -> SSLMode -> [SSLMode]
enumFromThenTo :: SSLMode -> SSLMode -> SSLMode -> [SSLMode]
Enum, SSLMode
SSLMode -> SSLMode -> Bounded SSLMode
forall a. a -> a -> Bounded a
$cminBound :: SSLMode
minBound :: SSLMode
$cmaxBound :: SSLMode
maxBound :: SSLMode
Bounded)

instance Hashable SSLMode

instance NFData SSLMode

instance Show SSLMode where
  show :: SSLMode -> String
show = \case
    SSLMode
Disable -> String
"disable"
    SSLMode
Allow -> String
"allow"
    SSLMode
Prefer -> String
"prefer"
    SSLMode
Require -> String
"require"
    SSLMode
VerifyCA -> String
"verify-ca"
    SSLMode
VerifyFull -> String
"verify-full"

deriving via (Max SSLMode) instance Semigroup SSLMode

instance HasCodec SSLMode where
  codec :: JSONCodec SSLMode
codec =
    Text -> JSONCodec SSLMode -> JSONCodec SSLMode
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"SSLMode"
      (JSONCodec SSLMode -> JSONCodec SSLMode)
-> JSONCodec SSLMode -> JSONCodec SSLMode
forall a b. (a -> b) -> a -> b
$ NonEmpty (SSLMode, Text) -> JSONCodec SSLMode
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec
      (NonEmpty (SSLMode, Text) -> JSONCodec SSLMode)
-> NonEmpty (SSLMode, Text) -> JSONCodec SSLMode
forall a b. (a -> b) -> a -> b
$ [(SSLMode, Text)] -> NonEmpty (SSLMode, Text)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
      ([(SSLMode, Text)] -> NonEmpty (SSLMode, Text))
-> [(SSLMode, Text)] -> NonEmpty (SSLMode, Text)
forall a b. (a -> b) -> a -> b
$ (\SSLMode
m -> (SSLMode
m, SSLMode -> Text
forall a. Show a => a -> Text
tshow SSLMode
m))
      (SSLMode -> (SSLMode, Text)) -> [SSLMode] -> [(SSLMode, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SSLMode
forall a. Bounded a => a
minBound ..]

instance FromJSON SSLMode where
  parseJSON :: Value -> Parser SSLMode
parseJSON = String -> (Text -> Parser SSLMode) -> Value -> Parser SSLMode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SSLMode" ((Text -> Parser SSLMode) -> Value -> Parser SSLMode)
-> (Text -> Parser SSLMode) -> Value -> Parser SSLMode
forall a b. (a -> b) -> a -> b
$ \case
    Text
"disable" -> SSLMode -> Parser SSLMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
Disable
    Text
"allow" -> SSLMode -> Parser SSLMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
Allow
    Text
"prefer" -> SSLMode -> Parser SSLMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
Prefer
    Text
"require" -> SSLMode -> Parser SSLMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
Require
    Text
"verify-ca" -> SSLMode -> Parser SSLMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
VerifyCA
    Text
"verify-full" -> SSLMode -> Parser SSLMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
VerifyFull
    Text
err -> String -> Parser SSLMode
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SSLMode) -> String -> Parser SSLMode
forall a b. (a -> b) -> a -> b
$ String
"Invalid SSL Mode " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
err

newtype CertVar
  = CertVar String
  deriving (Int -> CertVar -> ShowS
[CertVar] -> ShowS
CertVar -> String
(Int -> CertVar -> ShowS)
-> (CertVar -> String) -> ([CertVar] -> ShowS) -> Show CertVar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertVar -> ShowS
showsPrec :: Int -> CertVar -> ShowS
$cshow :: CertVar -> String
show :: CertVar -> String
$cshowList :: [CertVar] -> ShowS
showList :: [CertVar] -> ShowS
Show, CertVar -> CertVar -> Bool
(CertVar -> CertVar -> Bool)
-> (CertVar -> CertVar -> Bool) -> Eq CertVar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertVar -> CertVar -> Bool
== :: CertVar -> CertVar -> Bool
$c/= :: CertVar -> CertVar -> Bool
/= :: CertVar -> CertVar -> Bool
Eq, (forall x. CertVar -> Rep CertVar x)
-> (forall x. Rep CertVar x -> CertVar) -> Generic CertVar
forall x. Rep CertVar x -> CertVar
forall x. CertVar -> Rep CertVar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CertVar -> Rep CertVar x
from :: forall x. CertVar -> Rep CertVar x
$cto :: forall x. Rep CertVar x -> CertVar
to :: forall x. Rep CertVar x -> CertVar
Generic)

instance Hashable CertVar

instance NFData CertVar

instance HasCodec CertVar where
  codec :: JSONCodec CertVar
codec =
    Text -> ObjectCodec CertVar CertVar -> JSONCodec CertVar
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"CertVar" (ObjectCodec CertVar CertVar -> JSONCodec CertVar)
-> ObjectCodec CertVar CertVar -> JSONCodec CertVar
forall a b. (a -> b) -> a -> b
$ String -> CertVar
CertVar (String -> CertVar)
-> Codec Object CertVar String -> ObjectCodec CertVar CertVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"from_env" ObjectCodec String String
-> (CertVar -> String) -> Codec Object CertVar String
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== CertVar -> String
unCertVar
    where
      unCertVar :: CertVar -> String
unCertVar (CertVar String
t) = String
t
      infix 8 .==
      .== :: ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(.==) = ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(AC..=)

instance ToJSON CertVar where
  toJSON :: CertVar -> Value
toJSON (CertVar String
var) = ([Pair] -> Value
object [Key
"from_env" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= String
var])

instance FromJSON CertVar where
  parseJSON :: Value -> Parser CertVar
parseJSON = String -> (Object -> Parser CertVar) -> Value -> Parser CertVar
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CertVar" (\Object
o -> String -> CertVar
CertVar (String -> CertVar) -> Parser String -> Parser CertVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"from_env")

newtype CertData = CertData {CertData -> Text
unCert :: Text}
  deriving (Int -> CertData -> ShowS
[CertData] -> ShowS
CertData -> String
(Int -> CertData -> ShowS)
-> (CertData -> String) -> ([CertData] -> ShowS) -> Show CertData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertData -> ShowS
showsPrec :: Int -> CertData -> ShowS
$cshow :: CertData -> String
show :: CertData -> String
$cshowList :: [CertData] -> ShowS
showList :: [CertData] -> ShowS
Show, CertData -> CertData -> Bool
(CertData -> CertData -> Bool)
-> (CertData -> CertData -> Bool) -> Eq CertData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertData -> CertData -> Bool
== :: CertData -> CertData -> Bool
$c/= :: CertData -> CertData -> Bool
/= :: CertData -> CertData -> Bool
Eq, (forall x. CertData -> Rep CertData x)
-> (forall x. Rep CertData x -> CertData) -> Generic CertData
forall x. Rep CertData x -> CertData
forall x. CertData -> Rep CertData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CertData -> Rep CertData x
from :: forall x. CertData -> Rep CertData x
$cto :: forall x. Rep CertData x -> CertData
to :: forall x. Rep CertData x -> CertData
Generic)

instance HasCodec CertData where
  codec :: JSONCodec CertData
codec = (Text -> CertData)
-> (CertData -> Text)
-> Codec Value Text Text
-> JSONCodec CertData
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> CertData
CertData CertData -> Text
unCert Codec Value Text Text
textCodec

instance ToJSON CertData where
  toJSON :: CertData -> Value
toJSON = Text -> Value
String (Text -> Value) -> (CertData -> Text) -> CertData -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertData -> Text
unCert

data PGClientCerts p a = PGClientCerts
  { forall p a. PGClientCerts p a -> Maybe a
pgcSslCert :: Maybe a,
    forall p a. PGClientCerts p a -> Maybe a
pgcSslKey :: Maybe a,
    forall p a. PGClientCerts p a -> Maybe a
pgcSslRootCert :: Maybe a,
    forall p a. PGClientCerts p a -> SSLMode
pgcSslMode :: SSLMode,
    forall p a. PGClientCerts p a -> Maybe p
pgcSslPassword :: Maybe p
  }
  deriving (Int -> PGClientCerts p a -> ShowS
[PGClientCerts p a] -> ShowS
PGClientCerts p a -> String
(Int -> PGClientCerts p a -> ShowS)
-> (PGClientCerts p a -> String)
-> ([PGClientCerts p a] -> ShowS)
-> Show (PGClientCerts p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show a, Show p) => Int -> PGClientCerts p a -> ShowS
forall p a. (Show a, Show p) => [PGClientCerts p a] -> ShowS
forall p a. (Show a, Show p) => PGClientCerts p a -> String
$cshowsPrec :: forall p a. (Show a, Show p) => Int -> PGClientCerts p a -> ShowS
showsPrec :: Int -> PGClientCerts p a -> ShowS
$cshow :: forall p a. (Show a, Show p) => PGClientCerts p a -> String
show :: PGClientCerts p a -> String
$cshowList :: forall p a. (Show a, Show p) => [PGClientCerts p a] -> ShowS
showList :: [PGClientCerts p a] -> ShowS
Show, PGClientCerts p a -> PGClientCerts p a -> Bool
(PGClientCerts p a -> PGClientCerts p a -> Bool)
-> (PGClientCerts p a -> PGClientCerts p a -> Bool)
-> Eq (PGClientCerts p a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p a.
(Eq a, Eq p) =>
PGClientCerts p a -> PGClientCerts p a -> Bool
$c== :: forall p a.
(Eq a, Eq p) =>
PGClientCerts p a -> PGClientCerts p a -> Bool
== :: PGClientCerts p a -> PGClientCerts p a -> Bool
$c/= :: forall p a.
(Eq a, Eq p) =>
PGClientCerts p a -> PGClientCerts p a -> Bool
/= :: PGClientCerts p a -> PGClientCerts p a -> Bool
Eq, (forall x. PGClientCerts p a -> Rep (PGClientCerts p a) x)
-> (forall x. Rep (PGClientCerts p a) x -> PGClientCerts p a)
-> Generic (PGClientCerts p a)
forall x. Rep (PGClientCerts p a) x -> PGClientCerts p a
forall x. PGClientCerts p a -> Rep (PGClientCerts p a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p a x. Rep (PGClientCerts p a) x -> PGClientCerts p a
forall p a x. PGClientCerts p a -> Rep (PGClientCerts p a) x
$cfrom :: forall p a x. PGClientCerts p a -> Rep (PGClientCerts p a) x
from :: forall x. PGClientCerts p a -> Rep (PGClientCerts p a) x
$cto :: forall p a x. Rep (PGClientCerts p a) x -> PGClientCerts p a
to :: forall x. Rep (PGClientCerts p a) x -> PGClientCerts p a
Generic, (forall a b. (a -> b) -> PGClientCerts p a -> PGClientCerts p b)
-> (forall a b. a -> PGClientCerts p b -> PGClientCerts p a)
-> Functor (PGClientCerts p)
forall a b. a -> PGClientCerts p b -> PGClientCerts p a
forall a b. (a -> b) -> PGClientCerts p a -> PGClientCerts p b
forall p a b. a -> PGClientCerts p b -> PGClientCerts p a
forall p a b. (a -> b) -> PGClientCerts p a -> PGClientCerts p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall p a b. (a -> b) -> PGClientCerts p a -> PGClientCerts p b
fmap :: forall a b. (a -> b) -> PGClientCerts p a -> PGClientCerts p b
$c<$ :: forall p a b. a -> PGClientCerts p b -> PGClientCerts p a
<$ :: forall a b. a -> PGClientCerts p b -> PGClientCerts p a
Functor, (forall m. Monoid m => PGClientCerts p m -> m)
-> (forall m a. Monoid m => (a -> m) -> PGClientCerts p a -> m)
-> (forall m a. Monoid m => (a -> m) -> PGClientCerts p a -> m)
-> (forall a b. (a -> b -> b) -> b -> PGClientCerts p a -> b)
-> (forall a b. (a -> b -> b) -> b -> PGClientCerts p a -> b)
-> (forall b a. (b -> a -> b) -> b -> PGClientCerts p a -> b)
-> (forall b a. (b -> a -> b) -> b -> PGClientCerts p a -> b)
-> (forall a. (a -> a -> a) -> PGClientCerts p a -> a)
-> (forall a. (a -> a -> a) -> PGClientCerts p a -> a)
-> (forall a. PGClientCerts p a -> [a])
-> (forall a. PGClientCerts p a -> Bool)
-> (forall a. PGClientCerts p a -> Int)
-> (forall a. Eq a => a -> PGClientCerts p a -> Bool)
-> (forall a. Ord a => PGClientCerts p a -> a)
-> (forall a. Ord a => PGClientCerts p a -> a)
-> (forall a. Num a => PGClientCerts p a -> a)
-> (forall a. Num a => PGClientCerts p a -> a)
-> Foldable (PGClientCerts p)
forall a. Eq a => a -> PGClientCerts p a -> Bool
forall a. Num a => PGClientCerts p a -> a
forall a. Ord a => PGClientCerts p a -> a
forall m. Monoid m => PGClientCerts p m -> m
forall a. PGClientCerts p a -> Bool
forall a. PGClientCerts p a -> Int
forall a. PGClientCerts p a -> [a]
forall a. (a -> a -> a) -> PGClientCerts p a -> a
forall p a. Eq a => a -> PGClientCerts p a -> Bool
forall p a. Num a => PGClientCerts p a -> a
forall p a. Ord a => PGClientCerts p a -> a
forall m a. Monoid m => (a -> m) -> PGClientCerts p a -> m
forall p m. Monoid m => PGClientCerts p m -> m
forall p a. PGClientCerts p a -> Bool
forall p a. PGClientCerts p a -> Int
forall p a. PGClientCerts p a -> [a]
forall b a. (b -> a -> b) -> b -> PGClientCerts p a -> b
forall a b. (a -> b -> b) -> b -> PGClientCerts p a -> b
forall p a. (a -> a -> a) -> PGClientCerts p a -> a
forall p m a. Monoid m => (a -> m) -> PGClientCerts p a -> m
forall p b a. (b -> a -> b) -> b -> PGClientCerts p a -> b
forall p a b. (a -> b -> b) -> b -> PGClientCerts p 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
$cfold :: forall p m. Monoid m => PGClientCerts p m -> m
fold :: forall m. Monoid m => PGClientCerts p m -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> PGClientCerts p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PGClientCerts p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> PGClientCerts p a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> PGClientCerts p a -> m
$cfoldr :: forall p a b. (a -> b -> b) -> b -> PGClientCerts p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PGClientCerts p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> PGClientCerts p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PGClientCerts p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> PGClientCerts p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PGClientCerts p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> PGClientCerts p a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> PGClientCerts p a -> b
$cfoldr1 :: forall p a. (a -> a -> a) -> PGClientCerts p a -> a
foldr1 :: forall a. (a -> a -> a) -> PGClientCerts p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> PGClientCerts p a -> a
foldl1 :: forall a. (a -> a -> a) -> PGClientCerts p a -> a
$ctoList :: forall p a. PGClientCerts p a -> [a]
toList :: forall a. PGClientCerts p a -> [a]
$cnull :: forall p a. PGClientCerts p a -> Bool
null :: forall a. PGClientCerts p a -> Bool
$clength :: forall p a. PGClientCerts p a -> Int
length :: forall a. PGClientCerts p a -> Int
$celem :: forall p a. Eq a => a -> PGClientCerts p a -> Bool
elem :: forall a. Eq a => a -> PGClientCerts p a -> Bool
$cmaximum :: forall p a. Ord a => PGClientCerts p a -> a
maximum :: forall a. Ord a => PGClientCerts p a -> a
$cminimum :: forall p a. Ord a => PGClientCerts p a -> a
minimum :: forall a. Ord a => PGClientCerts p a -> a
$csum :: forall p a. Num a => PGClientCerts p a -> a
sum :: forall a. Num a => PGClientCerts p a -> a
$cproduct :: forall p a. Num a => PGClientCerts p a -> a
product :: forall a. Num a => PGClientCerts p a -> a
Foldable, Functor (PGClientCerts p)
Foldable (PGClientCerts p)
Functor (PGClientCerts p)
-> Foldable (PGClientCerts p)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PGClientCerts p a -> f (PGClientCerts p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    PGClientCerts p (f a) -> f (PGClientCerts p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PGClientCerts p a -> m (PGClientCerts p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    PGClientCerts p (m a) -> m (PGClientCerts p a))
-> Traversable (PGClientCerts p)
forall p. Functor (PGClientCerts p)
forall p. Foldable (PGClientCerts p)
forall p (m :: * -> *) a.
Monad m =>
PGClientCerts p (m a) -> m (PGClientCerts p a)
forall p (f :: * -> *) a.
Applicative f =>
PGClientCerts p (f a) -> f (PGClientCerts p a)
forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PGClientCerts p a -> m (PGClientCerts p b)
forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PGClientCerts p a -> f (PGClientCerts p 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 =>
PGClientCerts p (m a) -> m (PGClientCerts p a)
forall (f :: * -> *) a.
Applicative f =>
PGClientCerts p (f a) -> f (PGClientCerts p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PGClientCerts p a -> m (PGClientCerts p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PGClientCerts p a -> f (PGClientCerts p b)
$ctraverse :: forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PGClientCerts p a -> f (PGClientCerts p b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PGClientCerts p a -> f (PGClientCerts p b)
$csequenceA :: forall p (f :: * -> *) a.
Applicative f =>
PGClientCerts p (f a) -> f (PGClientCerts p a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PGClientCerts p (f a) -> f (PGClientCerts p a)
$cmapM :: forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PGClientCerts p a -> m (PGClientCerts p b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PGClientCerts p a -> m (PGClientCerts p b)
$csequence :: forall p (m :: * -> *) a.
Monad m =>
PGClientCerts p (m a) -> m (PGClientCerts p a)
sequence :: forall (m :: * -> *) a.
Monad m =>
PGClientCerts p (m a) -> m (PGClientCerts p a)
Traversable)

instance (HasCodec p, HasCodec a) => HasCodec (PGClientCerts p a) where
  codec :: JSONCodec (PGClientCerts p a)
codec =
    Text
-> JSONCodec (PGClientCerts p a) -> JSONCodec (PGClientCerts p a)
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
CommentCodec Text
"https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgcertsettings"
      (JSONCodec (PGClientCerts p a) -> JSONCodec (PGClientCerts p a))
-> JSONCodec (PGClientCerts p a) -> JSONCodec (PGClientCerts p a)
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec (PGClientCerts p a) (PGClientCerts p a)
-> JSONCodec (PGClientCerts p a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"PGClientCerts"
      (ObjectCodec (PGClientCerts p a) (PGClientCerts p a)
 -> JSONCodec (PGClientCerts p a))
-> ObjectCodec (PGClientCerts p a) (PGClientCerts p a)
-> JSONCodec (PGClientCerts p a)
forall a b. (a -> b) -> a -> b
$ Maybe a
-> Maybe a -> Maybe a -> SSLMode -> Maybe p -> PGClientCerts p a
forall p a.
Maybe a
-> Maybe a -> Maybe a -> SSLMode -> Maybe p -> PGClientCerts p a
PGClientCerts
      (Maybe a
 -> Maybe a -> Maybe a -> SSLMode -> Maybe p -> PGClientCerts p a)
-> Codec Object (PGClientCerts p a) (Maybe a)
-> Codec
     Object
     (PGClientCerts p a)
     (Maybe a -> Maybe a -> SSLMode -> Maybe p -> PGClientCerts p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec (Maybe a) (Maybe a)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"sslcert" Text
sslcertDoc
      ObjectCodec (Maybe a) (Maybe a)
-> (PGClientCerts p a -> Maybe a)
-> Codec Object (PGClientCerts p a) (Maybe a)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PGClientCerts p a -> Maybe a
forall p a. PGClientCerts p a -> Maybe a
pgcSslCert
        Codec
  Object
  (PGClientCerts p a)
  (Maybe a -> Maybe a -> SSLMode -> Maybe p -> PGClientCerts p a)
-> Codec Object (PGClientCerts p a) (Maybe a)
-> Codec
     Object
     (PGClientCerts p a)
     (Maybe a -> SSLMode -> Maybe p -> PGClientCerts p a)
forall a b.
Codec Object (PGClientCerts p a) (a -> b)
-> Codec Object (PGClientCerts p a) a
-> Codec Object (PGClientCerts p a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe a) (Maybe a)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"sslkey" Text
sslkeyDoc
      ObjectCodec (Maybe a) (Maybe a)
-> (PGClientCerts p a -> Maybe a)
-> Codec Object (PGClientCerts p a) (Maybe a)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PGClientCerts p a -> Maybe a
forall p a. PGClientCerts p a -> Maybe a
pgcSslKey
        Codec
  Object
  (PGClientCerts p a)
  (Maybe a -> SSLMode -> Maybe p -> PGClientCerts p a)
-> Codec Object (PGClientCerts p a) (Maybe a)
-> Codec
     Object
     (PGClientCerts p a)
     (SSLMode -> Maybe p -> PGClientCerts p a)
forall a b.
Codec Object (PGClientCerts p a) (a -> b)
-> Codec Object (PGClientCerts p a) a
-> Codec Object (PGClientCerts p a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe a) (Maybe a)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"sslrootcert" Text
sslrootcertDoc
      ObjectCodec (Maybe a) (Maybe a)
-> (PGClientCerts p a -> Maybe a)
-> Codec Object (PGClientCerts p a) (Maybe a)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PGClientCerts p a -> Maybe a
forall p a. PGClientCerts p a -> Maybe a
pgcSslRootCert
        Codec
  Object
  (PGClientCerts p a)
  (SSLMode -> Maybe p -> PGClientCerts p a)
-> Codec Object (PGClientCerts p a) SSLMode
-> Codec Object (PGClientCerts p a) (Maybe p -> PGClientCerts p a)
forall a b.
Codec Object (PGClientCerts p a) (a -> b)
-> Codec Object (PGClientCerts p a) a
-> Codec Object (PGClientCerts p a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec SSLMode SSLMode
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"sslmode" Text
sslmodeDoc
      ObjectCodec SSLMode SSLMode
-> (PGClientCerts p a -> SSLMode)
-> Codec Object (PGClientCerts p a) SSLMode
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PGClientCerts p a -> SSLMode
forall p a. PGClientCerts p a -> SSLMode
pgcSslMode
        Codec Object (PGClientCerts p a) (Maybe p -> PGClientCerts p a)
-> Codec Object (PGClientCerts p a) (Maybe p)
-> ObjectCodec (PGClientCerts p a) (PGClientCerts p a)
forall a b.
Codec Object (PGClientCerts p a) (a -> b)
-> Codec Object (PGClientCerts p a) a
-> Codec Object (PGClientCerts p a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe p) (Maybe p)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"sslpassword" Text
sslpasswordDoc
      ObjectCodec (Maybe p) (Maybe p)
-> (PGClientCerts p a -> Maybe p)
-> Codec Object (PGClientCerts p a) (Maybe p)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PGClientCerts p a -> Maybe p
forall p a. PGClientCerts p a -> Maybe p
pgcSslPassword
    where
      sslcertDoc :: Text
sslcertDoc = Text
"Environment variable which stores the client certificate."
      sslkeyDoc :: Text
sslkeyDoc = Text
"Environment variable which stores the client private key."
      sslrootcertDoc :: Text
sslrootcertDoc = Text
"Environment variable which stores trusted certificate authorities."
      sslmodeDoc :: Text
sslmodeDoc = Text
"The SSL connection mode. See the libpq ssl support docs <https://www.postgresql.org/docs/9.1/libpq-ssl.html> for more details."
      sslpasswordDoc :: Text
sslpasswordDoc = Text
"Password in the case where the sslkey is encrypted."
      infix 8 .==
      .== :: ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(.==) = ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(AC..=)

instance (FromJSON p, FromJSON a) => FromJSON (PGClientCerts p a) where
  parseJSON :: Value -> Parser (PGClientCerts p a)
parseJSON = Options -> Value -> Parser (PGClientCerts p a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Int -> ShowS -> Options
aesonDrop Int
3 ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower))

instance (ToJSON p, ToJSON a) => ToJSON (PGClientCerts p a) where
  toJSON :: PGClientCerts p a -> Value
toJSON = Options -> PGClientCerts p a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Int -> ShowS -> Options
aesonDrop Int
3 ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower)) {omitNothingFields :: Bool
omitNothingFields = Bool
True}
  toEncoding :: PGClientCerts p a -> Encoding
toEncoding = Options -> PGClientCerts p a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Int -> ShowS -> Options
aesonDrop Int
3 ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower)) {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance Bifunctor PGClientCerts where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> PGClientCerts a c -> PGClientCerts b d
bimap a -> b
f c -> d
g oldCerts :: PGClientCerts a c
oldCerts@(PGClientCerts {Maybe a
pgcSslPassword :: forall p a. PGClientCerts p a -> Maybe p
pgcSslPassword :: Maybe a
pgcSslPassword}) =
    let certs :: PGClientCerts b c
certs = PGClientCerts a c
oldCerts {pgcSslPassword :: Maybe b
pgcSslPassword = a -> b
f (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
pgcSslPassword}
     in c -> d
g (c -> d) -> PGClientCerts b c -> PGClientCerts b d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PGClientCerts b c
certs

instance Bifoldable PGClientCerts where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> PGClientCerts a b -> m
bifoldMap a -> m
f b -> m
g PGClientCerts {Maybe a
Maybe b
SSLMode
pgcSslCert :: forall p a. PGClientCerts p a -> Maybe a
pgcSslKey :: forall p a. PGClientCerts p a -> Maybe a
pgcSslRootCert :: forall p a. PGClientCerts p a -> Maybe a
pgcSslMode :: forall p a. PGClientCerts p a -> SSLMode
pgcSslPassword :: forall p a. PGClientCerts p a -> Maybe p
pgcSslCert :: Maybe b
pgcSslKey :: Maybe b
pgcSslRootCert :: Maybe b
pgcSslMode :: SSLMode
pgcSslPassword :: Maybe a
..} =
    let gs :: m
gs = (Maybe b -> m) -> [Maybe b] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((b -> m) -> Maybe b -> m
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g) [Maybe b
pgcSslCert, Maybe b
pgcSslKey, Maybe b
pgcSslRootCert]
        fs :: m
fs = (a -> m) -> Maybe a -> m
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Maybe a
pgcSslPassword
     in m
gs m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
fs

instance Bitraversable PGClientCerts where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> PGClientCerts a b -> f (PGClientCerts c d)
bitraverse a -> f c
f b -> f d
g PGClientCerts {Maybe a
Maybe b
SSLMode
pgcSslCert :: forall p a. PGClientCerts p a -> Maybe a
pgcSslKey :: forall p a. PGClientCerts p a -> Maybe a
pgcSslRootCert :: forall p a. PGClientCerts p a -> Maybe a
pgcSslMode :: forall p a. PGClientCerts p a -> SSLMode
pgcSslPassword :: forall p a. PGClientCerts p a -> Maybe p
pgcSslCert :: Maybe b
pgcSslKey :: Maybe b
pgcSslRootCert :: Maybe b
pgcSslMode :: SSLMode
pgcSslPassword :: Maybe a
..} =
    Maybe d
-> Maybe d -> Maybe d -> SSLMode -> Maybe c -> PGClientCerts c d
forall p a.
Maybe a
-> Maybe a -> Maybe a -> SSLMode -> Maybe p -> PGClientCerts p a
PGClientCerts
      (Maybe d
 -> Maybe d -> Maybe d -> SSLMode -> Maybe c -> PGClientCerts c d)
-> f (Maybe d)
-> f (Maybe d
      -> Maybe d -> SSLMode -> Maybe c -> PGClientCerts c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> f d) -> Maybe b -> f (Maybe d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse b -> f d
g Maybe b
pgcSslCert
      f (Maybe d -> Maybe d -> SSLMode -> Maybe c -> PGClientCerts c d)
-> f (Maybe d)
-> f (Maybe d -> SSLMode -> Maybe c -> PGClientCerts c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b -> f d) -> Maybe b -> f (Maybe d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse b -> f d
g Maybe b
pgcSslKey
      f (Maybe d -> SSLMode -> Maybe c -> PGClientCerts c d)
-> f (Maybe d) -> f (SSLMode -> Maybe c -> PGClientCerts c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b -> f d) -> Maybe b -> f (Maybe d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse b -> f d
g Maybe b
pgcSslRootCert
      f (SSLMode -> Maybe c -> PGClientCerts c d)
-> f SSLMode -> f (Maybe c -> PGClientCerts c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SSLMode -> f SSLMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
pgcSslMode
      f (Maybe c -> PGClientCerts c d)
-> f (Maybe c) -> f (PGClientCerts c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> Maybe a -> f (Maybe c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse a -> f c
f Maybe a
pgcSslPassword

instance (Hashable p, Hashable a) => Hashable (PGClientCerts p a)

instance (NFData p, NFData a) => NFData (PGClientCerts p a)

instance ToJSON SSLMode where
  toJSON :: SSLMode -> Value
toJSON = Text -> Value
String (Text -> Value) -> (SSLMode -> Text) -> SSLMode -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSLMode -> Text
forall a. Show a => a -> Text
tshow

deriving instance Generic PG.TxIsolation

instance NFData PG.TxIsolation

instance Hashable PG.TxIsolation

instance HasCodec PG.TxIsolation where
  codec :: JSONCodec TxIsolation
codec =
    Text -> JSONCodec TxIsolation -> JSONCodec TxIsolation
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"TxIsolation"
      (JSONCodec TxIsolation -> JSONCodec TxIsolation)
-> JSONCodec TxIsolation -> JSONCodec TxIsolation
forall a b. (a -> b) -> a -> b
$ NonEmpty (TxIsolation, Text) -> JSONCodec TxIsolation
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec
      (NonEmpty (TxIsolation, Text) -> JSONCodec TxIsolation)
-> NonEmpty (TxIsolation, Text) -> JSONCodec TxIsolation
forall a b. (a -> b) -> a -> b
$ [(TxIsolation, Text)] -> NonEmpty (TxIsolation, Text)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
      ([(TxIsolation, Text)] -> NonEmpty (TxIsolation, Text))
-> [(TxIsolation, Text)] -> NonEmpty (TxIsolation, Text)
forall a b. (a -> b) -> a -> b
$ [ (TxIsolation
PG.ReadCommitted, Text
"read-committed"),
          (TxIsolation
PG.RepeatableRead, Text
"repeatable-read"),
          (TxIsolation
PG.Serializable, Text
"serializable")
        ]

instance FromJSON PG.TxIsolation where
  parseJSON :: Value -> Parser TxIsolation
parseJSON = String
-> (Text -> Parser TxIsolation) -> Value -> Parser TxIsolation
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Q.TxIsolation" ((Text -> Parser TxIsolation) -> Value -> Parser TxIsolation)
-> (Text -> Parser TxIsolation) -> Value -> Parser TxIsolation
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    Either String TxIsolation
-> (String -> Parser TxIsolation) -> Parser TxIsolation
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft (String -> Either String TxIsolation
readIsoLevel (String -> Either String TxIsolation)
-> String -> Either String TxIsolation
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t) String -> Parser TxIsolation
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

instance ToJSON PG.TxIsolation where
  toJSON :: TxIsolation -> Value
toJSON TxIsolation
PG.ReadCommitted = Value
"read-committed"
  toJSON TxIsolation
PG.RepeatableRead = Value
"repeatable-read"
  toJSON TxIsolation
PG.Serializable = Value
"serializable"

data PostgresSourceConnInfo = PostgresSourceConnInfo
  { PostgresSourceConnInfo -> UrlConf
_psciDatabaseUrl :: UrlConf,
    PostgresSourceConnInfo -> Maybe PostgresPoolSettings
_psciPoolSettings :: Maybe PostgresPoolSettings,
    PostgresSourceConnInfo -> Bool
_psciUsePreparedStatements :: Bool,
    PostgresSourceConnInfo -> TxIsolation
_psciIsolationLevel :: PG.TxIsolation,
    PostgresSourceConnInfo -> Maybe (PGClientCerts CertVar CertVar)
_psciSslConfiguration :: Maybe (PGClientCerts CertVar CertVar)
  }
  deriving (Int -> PostgresSourceConnInfo -> ShowS
[PostgresSourceConnInfo] -> ShowS
PostgresSourceConnInfo -> String
(Int -> PostgresSourceConnInfo -> ShowS)
-> (PostgresSourceConnInfo -> String)
-> ([PostgresSourceConnInfo] -> ShowS)
-> Show PostgresSourceConnInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostgresSourceConnInfo -> ShowS
showsPrec :: Int -> PostgresSourceConnInfo -> ShowS
$cshow :: PostgresSourceConnInfo -> String
show :: PostgresSourceConnInfo -> String
$cshowList :: [PostgresSourceConnInfo] -> ShowS
showList :: [PostgresSourceConnInfo] -> ShowS
Show, PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool
(PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool)
-> (PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool)
-> Eq PostgresSourceConnInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool
== :: PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool
$c/= :: PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool
/= :: PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool
Eq, (forall x. PostgresSourceConnInfo -> Rep PostgresSourceConnInfo x)
-> (forall x.
    Rep PostgresSourceConnInfo x -> PostgresSourceConnInfo)
-> Generic PostgresSourceConnInfo
forall x. Rep PostgresSourceConnInfo x -> PostgresSourceConnInfo
forall x. PostgresSourceConnInfo -> Rep PostgresSourceConnInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PostgresSourceConnInfo -> Rep PostgresSourceConnInfo x
from :: forall x. PostgresSourceConnInfo -> Rep PostgresSourceConnInfo x
$cto :: forall x. Rep PostgresSourceConnInfo x -> PostgresSourceConnInfo
to :: forall x. Rep PostgresSourceConnInfo x -> PostgresSourceConnInfo
Generic)

instance Hashable PostgresSourceConnInfo

instance NFData PostgresSourceConnInfo

instance HasCodec PostgresSourceConnInfo where
  codec :: JSONCodec PostgresSourceConnInfo
codec =
    Text
-> JSONCodec PostgresSourceConnInfo
-> JSONCodec PostgresSourceConnInfo
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
CommentCodec Text
"https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgsourceconnectioninfo"
      (JSONCodec PostgresSourceConnInfo
 -> JSONCodec PostgresSourceConnInfo)
-> JSONCodec PostgresSourceConnInfo
-> JSONCodec PostgresSourceConnInfo
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec PostgresSourceConnInfo PostgresSourceConnInfo
-> JSONCodec PostgresSourceConnInfo
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"PostgresSourceConnInfo"
      (ObjectCodec PostgresSourceConnInfo PostgresSourceConnInfo
 -> JSONCodec PostgresSourceConnInfo)
-> ObjectCodec PostgresSourceConnInfo PostgresSourceConnInfo
-> JSONCodec PostgresSourceConnInfo
forall a b. (a -> b) -> a -> b
$ UrlConf
-> Maybe PostgresPoolSettings
-> Bool
-> TxIsolation
-> Maybe (PGClientCerts CertVar CertVar)
-> PostgresSourceConnInfo
PostgresSourceConnInfo
      (UrlConf
 -> Maybe PostgresPoolSettings
 -> Bool
 -> TxIsolation
 -> Maybe (PGClientCerts CertVar CertVar)
 -> PostgresSourceConnInfo)
-> Codec Object PostgresSourceConnInfo UrlConf
-> Codec
     Object
     PostgresSourceConnInfo
     (Maybe PostgresPoolSettings
      -> Bool
      -> TxIsolation
      -> Maybe (PGClientCerts CertVar CertVar)
      -> PostgresSourceConnInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec UrlConf UrlConf
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"database_url" Text
databaseUrlDoc
      ObjectCodec UrlConf UrlConf
-> (PostgresSourceConnInfo -> UrlConf)
-> Codec Object PostgresSourceConnInfo UrlConf
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresSourceConnInfo -> UrlConf
_psciDatabaseUrl
        Codec
  Object
  PostgresSourceConnInfo
  (Maybe PostgresPoolSettings
   -> Bool
   -> TxIsolation
   -> Maybe (PGClientCerts CertVar CertVar)
   -> PostgresSourceConnInfo)
-> Codec Object PostgresSourceConnInfo (Maybe PostgresPoolSettings)
-> Codec
     Object
     PostgresSourceConnInfo
     (Bool
      -> TxIsolation
      -> Maybe (PGClientCerts CertVar CertVar)
      -> PostgresSourceConnInfo)
forall a b.
Codec Object PostgresSourceConnInfo (a -> b)
-> Codec Object PostgresSourceConnInfo a
-> Codec Object PostgresSourceConnInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text
-> ObjectCodec
     (Maybe PostgresPoolSettings) (Maybe PostgresPoolSettings)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"pool_settings" Text
poolSettingsDoc
      ObjectCodec
  (Maybe PostgresPoolSettings) (Maybe PostgresPoolSettings)
-> (PostgresSourceConnInfo -> Maybe PostgresPoolSettings)
-> Codec Object PostgresSourceConnInfo (Maybe PostgresPoolSettings)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresSourceConnInfo -> Maybe PostgresPoolSettings
_psciPoolSettings
        Codec
  Object
  PostgresSourceConnInfo
  (Bool
   -> TxIsolation
   -> Maybe (PGClientCerts CertVar CertVar)
   -> PostgresSourceConnInfo)
-> Codec Object PostgresSourceConnInfo Bool
-> Codec
     Object
     PostgresSourceConnInfo
     (TxIsolation
      -> Maybe (PGClientCerts CertVar CertVar) -> PostgresSourceConnInfo)
forall a b.
Codec Object PostgresSourceConnInfo (a -> b)
-> Codec Object PostgresSourceConnInfo a
-> Codec Object PostgresSourceConnInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Bool -> Text -> ObjectCodec Bool Bool
forall output.
HasCodec output =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithDefault Text
"use_prepared_statements" Bool
False Text
usePreparedStatementsDoc
      ObjectCodec Bool Bool
-> (PostgresSourceConnInfo -> Bool)
-> Codec Object PostgresSourceConnInfo Bool
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresSourceConnInfo -> Bool
_psciUsePreparedStatements
        Codec
  Object
  PostgresSourceConnInfo
  (TxIsolation
   -> Maybe (PGClientCerts CertVar CertVar) -> PostgresSourceConnInfo)
-> Codec Object PostgresSourceConnInfo TxIsolation
-> Codec
     Object
     PostgresSourceConnInfo
     (Maybe (PGClientCerts CertVar CertVar) -> PostgresSourceConnInfo)
forall a b.
Codec Object PostgresSourceConnInfo (a -> b)
-> Codec Object PostgresSourceConnInfo a
-> Codec Object PostgresSourceConnInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> TxIsolation -> Text -> ObjectCodec TxIsolation TxIsolation
forall output.
HasCodec output =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithDefault Text
"isolation_level" TxIsolation
PG.ReadCommitted Text
isolationLevelDoc
      ObjectCodec TxIsolation TxIsolation
-> (PostgresSourceConnInfo -> TxIsolation)
-> Codec Object PostgresSourceConnInfo TxIsolation
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresSourceConnInfo -> TxIsolation
_psciIsolationLevel
        Codec
  Object
  PostgresSourceConnInfo
  (Maybe (PGClientCerts CertVar CertVar) -> PostgresSourceConnInfo)
-> Codec
     Object
     PostgresSourceConnInfo
     (Maybe (PGClientCerts CertVar CertVar))
-> ObjectCodec PostgresSourceConnInfo PostgresSourceConnInfo
forall a b.
Codec Object PostgresSourceConnInfo (a -> b)
-> Codec Object PostgresSourceConnInfo a
-> Codec Object PostgresSourceConnInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text
-> ObjectCodec
     (Maybe (PGClientCerts CertVar CertVar))
     (Maybe (PGClientCerts CertVar CertVar))
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"ssl_configuration" Text
sslConfigurationDoc
      ObjectCodec
  (Maybe (PGClientCerts CertVar CertVar))
  (Maybe (PGClientCerts CertVar CertVar))
-> (PostgresSourceConnInfo
    -> Maybe (PGClientCerts CertVar CertVar))
-> Codec
     Object
     PostgresSourceConnInfo
     (Maybe (PGClientCerts CertVar CertVar))
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresSourceConnInfo -> Maybe (PGClientCerts CertVar CertVar)
_psciSslConfiguration
    where
      databaseUrlDoc :: Text
databaseUrlDoc = Text
"The database connection URL as a string, as an environment variable, or as connection parameters."
      poolSettingsDoc :: Text
poolSettingsDoc = Text
"Connection pool settings"
      usePreparedStatementsDoc :: Text
usePreparedStatementsDoc =
        [Text] -> Text
T.unwords
          [ Text
"If set to true the server prepares statement before executing on the",
            Text
"source database (default: false). For more details, refer to the",
            Text
"Postgres docs"
          ]
      isolationLevelDoc :: Text
isolationLevelDoc =
        [Text] -> Text
T.unwords
          [ Text
"The transaction isolation level in which the queries made to the",
            Text
"source will be run with (default: read-committed)."
          ]
      sslConfigurationDoc :: Text
sslConfigurationDoc = Text
"The client SSL certificate settings for the database (Only available in Cloud)."
      infix 8 .==
      .== :: ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(.==) = ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(AC..=)

instance ToJSON PostgresSourceConnInfo where
  toJSON :: PostgresSourceConnInfo -> Value
toJSON = Options -> PostgresSourceConnInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}
  toEncoding :: PostgresSourceConnInfo -> Encoding
toEncoding = Options -> PostgresSourceConnInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance FromJSON PostgresSourceConnInfo where
  parseJSON :: Value -> Parser PostgresSourceConnInfo
parseJSON = String
-> (Object -> Parser PostgresSourceConnInfo)
-> Value
-> Parser PostgresSourceConnInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PostgresSourceConnInfo" ((Object -> Parser PostgresSourceConnInfo)
 -> Value -> Parser PostgresSourceConnInfo)
-> (Object -> Parser PostgresSourceConnInfo)
-> Value
-> Parser PostgresSourceConnInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    UrlConf
-> Maybe PostgresPoolSettings
-> Bool
-> TxIsolation
-> Maybe (PGClientCerts CertVar CertVar)
-> PostgresSourceConnInfo
PostgresSourceConnInfo
      (UrlConf
 -> Maybe PostgresPoolSettings
 -> Bool
 -> TxIsolation
 -> Maybe (PGClientCerts CertVar CertVar)
 -> PostgresSourceConnInfo)
-> Parser UrlConf
-> Parser
     (Maybe PostgresPoolSettings
      -> Bool
      -> TxIsolation
      -> Maybe (PGClientCerts CertVar CertVar)
      -> PostgresSourceConnInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser UrlConf
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"database_url"
      Parser
  (Maybe PostgresPoolSettings
   -> Bool
   -> TxIsolation
   -> Maybe (PGClientCerts CertVar CertVar)
   -> PostgresSourceConnInfo)
-> Parser (Maybe PostgresPoolSettings)
-> Parser
     (Bool
      -> TxIsolation
      -> Maybe (PGClientCerts CertVar CertVar)
      -> PostgresSourceConnInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe PostgresPoolSettings)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pool_settings"
      Parser
  (Bool
   -> TxIsolation
   -> Maybe (PGClientCerts CertVar CertVar)
   -> PostgresSourceConnInfo)
-> Parser Bool
-> Parser
     (TxIsolation
      -> Maybe (PGClientCerts CertVar CertVar) -> PostgresSourceConnInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"use_prepared_statements"
      Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False -- By default, preparing statements is OFF for postgres source
      Parser
  (TxIsolation
   -> Maybe (PGClientCerts CertVar CertVar) -> PostgresSourceConnInfo)
-> Parser TxIsolation
-> Parser
     (Maybe (PGClientCerts CertVar CertVar) -> PostgresSourceConnInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe TxIsolation)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"isolation_level"
      Parser (Maybe TxIsolation) -> TxIsolation -> Parser TxIsolation
forall a. Parser (Maybe a) -> a -> Parser a
.!= TxIsolation
PG.ReadCommitted
      Parser
  (Maybe (PGClientCerts CertVar CertVar) -> PostgresSourceConnInfo)
-> Parser (Maybe (PGClientCerts CertVar CertVar))
-> Parser PostgresSourceConnInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe (PGClientCerts CertVar CertVar))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ssl_configuration"

defaultPostgresExtensionsSchema :: ExtensionsSchema
defaultPostgresExtensionsSchema :: ExtensionsSchema
defaultPostgresExtensionsSchema = Text -> ExtensionsSchema
ExtensionsSchema Text
"public"

-- | `kriti-lang` template.
data KritiTemplate = KritiTemplate
  { -- TODO: There is redundency here, we should remove the templateSrc field once the renderPretty bug is resolved
    -- (https://github.com/hasura/kriti-lang/issues/77)

    -- | Raw kriti template
    KritiTemplate -> Text
_ktSource :: Text,
    -- | Parsed kriti template
    KritiTemplate -> ValueExt
_ktParsedAST :: Kriti.ValueExt
  }
  deriving (Int -> KritiTemplate -> ShowS
[KritiTemplate] -> ShowS
KritiTemplate -> String
(Int -> KritiTemplate -> ShowS)
-> (KritiTemplate -> String)
-> ([KritiTemplate] -> ShowS)
-> Show KritiTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KritiTemplate -> ShowS
showsPrec :: Int -> KritiTemplate -> ShowS
$cshow :: KritiTemplate -> String
show :: KritiTemplate -> String
$cshowList :: [KritiTemplate] -> ShowS
showList :: [KritiTemplate] -> ShowS
Show, KritiTemplate -> KritiTemplate -> Bool
(KritiTemplate -> KritiTemplate -> Bool)
-> (KritiTemplate -> KritiTemplate -> Bool) -> Eq KritiTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KritiTemplate -> KritiTemplate -> Bool
== :: KritiTemplate -> KritiTemplate -> Bool
$c/= :: KritiTemplate -> KritiTemplate -> Bool
/= :: KritiTemplate -> KritiTemplate -> Bool
Eq, (forall x. KritiTemplate -> Rep KritiTemplate x)
-> (forall x. Rep KritiTemplate x -> KritiTemplate)
-> Generic KritiTemplate
forall x. Rep KritiTemplate x -> KritiTemplate
forall x. KritiTemplate -> Rep KritiTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KritiTemplate -> Rep KritiTemplate x
from :: forall x. KritiTemplate -> Rep KritiTemplate x
$cto :: forall x. Rep KritiTemplate x -> KritiTemplate
to :: forall x. Rep KritiTemplate x -> KritiTemplate
Generic)

instance Hashable KritiTemplate where
  hashWithSalt :: Int -> KritiTemplate -> Int
hashWithSalt Int
salt (KritiTemplate Text
templateSrc ValueExt
_) = Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Text
templateSrc

instance NFData KritiTemplate

instance ToJSON KritiTemplate where
  toJSON :: KritiTemplate -> Value
toJSON (KritiTemplate Text
templateSrc ValueExt
_) = Text -> Value
String Text
templateSrc

instance FromJSON KritiTemplate where
  parseJSON :: Value -> Parser KritiTemplate
parseJSON = String
-> (Text -> Parser KritiTemplate) -> Value -> Parser KritiTemplate
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"KritiTemplate" ((Text -> Parser KritiTemplate) -> Value -> Parser KritiTemplate)
-> (Text -> Parser KritiTemplate) -> Value -> Parser KritiTemplate
forall a b. (a -> b) -> a -> b
$ \Text
templateSrc ->
    Text -> ValueExt -> KritiTemplate
KritiTemplate Text
templateSrc
      (ValueExt -> KritiTemplate)
-> Parser ValueExt -> Parser KritiTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either ParseError ValueExt
Kriti.parser (Text -> ByteString
T.encodeUtf8 Text
templateSrc)
      Either ParseError ValueExt
-> (ParseError -> Parser ValueExt) -> Parser ValueExt
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` \ParseError
err ->
        String -> Parser ValueExt
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ValueExt) -> String -> Parser ValueExt
forall a b. (a -> b) -> a -> b
$ String
"Kriti template parsing failed - " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Text -> String
T.unpack (Text -> String) -> (ParseError -> Text) -> ParseError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializedError -> Text
serializedErrorToString (SerializedError -> Text)
-> (ParseError -> SerializedError) -> ParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> SerializedError
forall e. SerializeError e => e -> SerializedError
Kriti.serialize (ParseError -> String) -> ParseError -> String
forall a b. (a -> b) -> a -> b
$ ParseError
err)

serializedErrorToString :: Kriti.SerializedError -> Text
serializedErrorToString :: SerializedError -> Text
serializedErrorToString (Kriti.SerializedError ErrorCode
code Text
msg Span
errSpan) =
  let prettyText :: ErrorCode -> Text
prettyText = SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
PP.renderStrict (SimpleDocStream Any -> Text)
-> (ErrorCode -> SimpleDocStream Any) -> ErrorCode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
PP.layoutPretty LayoutOptions
PP.defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> (ErrorCode -> Doc Any) -> ErrorCode -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorCode -> Doc Any
forall ann. ErrorCode -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty
      spanToText :: Span -> Text
spanToText (Kriti.Span AlexSourcePos
start AlexSourcePos
end) = Text
"from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AlexSourcePos -> Text
prettySpan AlexSourcePos
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AlexSourcePos -> Text
prettySpan AlexSourcePos
end
      prettySpan :: AlexSourcePos -> Text
prettySpan (Kriti.AlexSourcePos Int
line Int
col) = Text
"line " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
col
   in Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Occured " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Span -> Text
spanToText Span
errSpan Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with error code " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall t. ToTxt t => t -> Text
dquote (ErrorCode -> Text
prettyText ErrorCode
code) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."

instance HasCodec KritiTemplate where
  codec :: JSONCodec KritiTemplate
codec = Text -> JSONCodec KritiTemplate
forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
"KritiTemplate"

-- | Connection template for the dynamic DB connection.
data ConnectionTemplate = ConnectionTemplate
  { -- | Version for the connection template. Please read more about this in the dynamic DB connection RFC (Metadata API > Versioning).
    ConnectionTemplate -> Int
_ctVersion :: Int,
    -- | `kriti-lang` template for the dynamic DB connection.
    ConnectionTemplate -> KritiTemplate
_ctTemplate :: KritiTemplate
  }
  deriving (Int -> ConnectionTemplate -> ShowS
[ConnectionTemplate] -> ShowS
ConnectionTemplate -> String
(Int -> ConnectionTemplate -> ShowS)
-> (ConnectionTemplate -> String)
-> ([ConnectionTemplate] -> ShowS)
-> Show ConnectionTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionTemplate -> ShowS
showsPrec :: Int -> ConnectionTemplate -> ShowS
$cshow :: ConnectionTemplate -> String
show :: ConnectionTemplate -> String
$cshowList :: [ConnectionTemplate] -> ShowS
showList :: [ConnectionTemplate] -> ShowS
Show, ConnectionTemplate -> ConnectionTemplate -> Bool
(ConnectionTemplate -> ConnectionTemplate -> Bool)
-> (ConnectionTemplate -> ConnectionTemplate -> Bool)
-> Eq ConnectionTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionTemplate -> ConnectionTemplate -> Bool
== :: ConnectionTemplate -> ConnectionTemplate -> Bool
$c/= :: ConnectionTemplate -> ConnectionTemplate -> Bool
/= :: ConnectionTemplate -> ConnectionTemplate -> Bool
Eq, (forall x. ConnectionTemplate -> Rep ConnectionTemplate x)
-> (forall x. Rep ConnectionTemplate x -> ConnectionTemplate)
-> Generic ConnectionTemplate
forall x. Rep ConnectionTemplate x -> ConnectionTemplate
forall x. ConnectionTemplate -> Rep ConnectionTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConnectionTemplate -> Rep ConnectionTemplate x
from :: forall x. ConnectionTemplate -> Rep ConnectionTemplate x
$cto :: forall x. Rep ConnectionTemplate x -> ConnectionTemplate
to :: forall x. Rep ConnectionTemplate x -> ConnectionTemplate
Generic)

instance Hashable ConnectionTemplate

instance NFData ConnectionTemplate

-- | All the supported versions for the dynamic DB connection template.
supportedConnectionTemplateVersions :: [Int]
supportedConnectionTemplateVersions :: [Int]
supportedConnectionTemplateVersions = [Int
1]

instance FromJSON ConnectionTemplate where
  parseJSON :: Value -> Parser ConnectionTemplate
parseJSON = String
-> (Object -> Parser ConnectionTemplate)
-> Value
-> Parser ConnectionTemplate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ConnectionTemplate" ((Object -> Parser ConnectionTemplate)
 -> Value -> Parser ConnectionTemplate)
-> (Object -> Parser ConnectionTemplate)
-> Value
-> Parser ConnectionTemplate
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
version <- Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
1
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
version Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
supportedConnectionTemplateVersions)
      (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Supported versions are "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Int] -> String
forall a. Show a => a -> String
show [Int]
supportedConnectionTemplateVersions
    Int -> KritiTemplate -> ConnectionTemplate
ConnectionTemplate Int
version
      (KritiTemplate -> ConnectionTemplate)
-> Parser KritiTemplate -> Parser ConnectionTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser KritiTemplate
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"template"

instance ToJSON ConnectionTemplate where
  toJSON :: ConnectionTemplate -> Value
toJSON ConnectionTemplate {Int
KritiTemplate
_ctVersion :: ConnectionTemplate -> Int
_ctTemplate :: ConnectionTemplate -> KritiTemplate
_ctVersion :: Int
_ctTemplate :: KritiTemplate
..} =
    [Pair] -> Value
object
      [ Key
"version" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Int
_ctVersion,
        Key
"template" Key -> KritiTemplate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= KritiTemplate
_ctTemplate
      ]

instance HasCodec ConnectionTemplate where
  codec :: JSONCodec ConnectionTemplate
codec =
    Text
-> JSONCodec ConnectionTemplate -> JSONCodec ConnectionTemplate
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
CommentCodec Text
"https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgconnectiontemplate"
      (JSONCodec ConnectionTemplate -> JSONCodec ConnectionTemplate)
-> JSONCodec ConnectionTemplate -> JSONCodec ConnectionTemplate
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec ConnectionTemplate ConnectionTemplate
-> JSONCodec ConnectionTemplate
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"ConnectionTemplate"
      (ObjectCodec ConnectionTemplate ConnectionTemplate
 -> JSONCodec ConnectionTemplate)
-> ObjectCodec ConnectionTemplate ConnectionTemplate
-> JSONCodec ConnectionTemplate
forall a b. (a -> b) -> a -> b
$ Int -> KritiTemplate -> ConnectionTemplate
ConnectionTemplate
      (Int -> KritiTemplate -> ConnectionTemplate)
-> Codec Object ConnectionTemplate Int
-> Codec
     Object ConnectionTemplate (KritiTemplate -> ConnectionTemplate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Int -> Text -> ObjectCodec Int Int
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"version" Int
1 Text
ctVersionInfoDoc
      ObjectCodec Int Int
-> (ConnectionTemplate -> Int)
-> Codec Object ConnectionTemplate Int
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ConnectionTemplate -> Int
_ctVersion
        Codec
  Object ConnectionTemplate (KritiTemplate -> ConnectionTemplate)
-> Codec Object ConnectionTemplate KritiTemplate
-> ObjectCodec ConnectionTemplate ConnectionTemplate
forall a b.
Codec Object ConnectionTemplate (a -> b)
-> Codec Object ConnectionTemplate a
-> Codec Object ConnectionTemplate b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec KritiTemplate KritiTemplate
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"template" Text
ctTemplateInfoDoc
      ObjectCodec KritiTemplate KritiTemplate
-> (ConnectionTemplate -> KritiTemplate)
-> Codec Object ConnectionTemplate KritiTemplate
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ConnectionTemplate -> KritiTemplate
_ctTemplate
    where
      ctVersionInfoDoc :: Text
ctVersionInfoDoc = Text
"Optional connection template version (supported versions: [1], default: 1)"
      ctTemplateInfoDoc :: Text
ctTemplateInfoDoc = Text
"Connection kriti template (read more in the docs)"

-- | Name of the member of a connection set.
newtype PostgresConnectionSetMemberName = PostgresConnectionSetMemberName {PostgresConnectionSetMemberName -> NonEmptyText
getPostgresConnectionSetMemberName :: NonEmptyText}
  deriving (Int -> PostgresConnectionSetMemberName -> ShowS
[PostgresConnectionSetMemberName] -> ShowS
PostgresConnectionSetMemberName -> String
(Int -> PostgresConnectionSetMemberName -> ShowS)
-> (PostgresConnectionSetMemberName -> String)
-> ([PostgresConnectionSetMemberName] -> ShowS)
-> Show PostgresConnectionSetMemberName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostgresConnectionSetMemberName -> ShowS
showsPrec :: Int -> PostgresConnectionSetMemberName -> ShowS
$cshow :: PostgresConnectionSetMemberName -> String
show :: PostgresConnectionSetMemberName -> String
$cshowList :: [PostgresConnectionSetMemberName] -> ShowS
showList :: [PostgresConnectionSetMemberName] -> ShowS
Show, PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
(PostgresConnectionSetMemberName
 -> PostgresConnectionSetMemberName -> Bool)
-> (PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName -> Bool)
-> Eq PostgresConnectionSetMemberName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
== :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
$c/= :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
/= :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
Eq, (forall x.
 PostgresConnectionSetMemberName
 -> Rep PostgresConnectionSetMemberName x)
-> (forall x.
    Rep PostgresConnectionSetMemberName x
    -> PostgresConnectionSetMemberName)
-> Generic PostgresConnectionSetMemberName
forall x.
Rep PostgresConnectionSetMemberName x
-> PostgresConnectionSetMemberName
forall x.
PostgresConnectionSetMemberName
-> Rep PostgresConnectionSetMemberName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
PostgresConnectionSetMemberName
-> Rep PostgresConnectionSetMemberName x
from :: forall x.
PostgresConnectionSetMemberName
-> Rep PostgresConnectionSetMemberName x
$cto :: forall x.
Rep PostgresConnectionSetMemberName x
-> PostgresConnectionSetMemberName
to :: forall x.
Rep PostgresConnectionSetMemberName x
-> PostgresConnectionSetMemberName
Generic, Eq PostgresConnectionSetMemberName
Eq PostgresConnectionSetMemberName
-> (PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName -> Ordering)
-> (PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName -> Bool)
-> (PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName -> Bool)
-> (PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName -> Bool)
-> (PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName -> Bool)
-> (PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName)
-> (PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName
    -> PostgresConnectionSetMemberName)
-> Ord PostgresConnectionSetMemberName
PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Ordering
PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
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
$ccompare :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Ordering
compare :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Ordering
$c< :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
< :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
$c<= :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
<= :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
$c> :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
> :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
$c>= :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
>= :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName -> Bool
$cmax :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
max :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
$cmin :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
min :: PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
-> PostgresConnectionSetMemberName
Ord, PostgresConnectionSetMemberName -> Text
(PostgresConnectionSetMemberName -> Text)
-> ToTxt PostgresConnectionSetMemberName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: PostgresConnectionSetMemberName -> Text
toTxt :: PostgresConnectionSetMemberName -> Text
ToTxt)

instance Hashable PostgresConnectionSetMemberName

instance NFData PostgresConnectionSetMemberName

instance ToJSON PostgresConnectionSetMemberName where
  toJSON :: PostgresConnectionSetMemberName -> Value
toJSON (PostgresConnectionSetMemberName NonEmptyText
sName) = NonEmptyText -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmptyText
sName

instance FromJSON PostgresConnectionSetMemberName where
  parseJSON :: Value -> Parser PostgresConnectionSetMemberName
parseJSON Value
val = NonEmptyText -> PostgresConnectionSetMemberName
PostgresConnectionSetMemberName (NonEmptyText -> PostgresConnectionSetMemberName)
-> Parser NonEmptyText -> Parser PostgresConnectionSetMemberName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NonEmptyText
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val

data PostgresConnectionSetMember = PostgresConnectionSetMember
  { PostgresConnectionSetMember -> PostgresConnectionSetMemberName
_pscmName :: PostgresConnectionSetMemberName,
    PostgresConnectionSetMember -> PostgresSourceConnInfo
_pscmConnectionInfo :: PostgresSourceConnInfo
  }
  deriving (Int -> PostgresConnectionSetMember -> ShowS
[PostgresConnectionSetMember] -> ShowS
PostgresConnectionSetMember -> String
(Int -> PostgresConnectionSetMember -> ShowS)
-> (PostgresConnectionSetMember -> String)
-> ([PostgresConnectionSetMember] -> ShowS)
-> Show PostgresConnectionSetMember
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostgresConnectionSetMember -> ShowS
showsPrec :: Int -> PostgresConnectionSetMember -> ShowS
$cshow :: PostgresConnectionSetMember -> String
show :: PostgresConnectionSetMember -> String
$cshowList :: [PostgresConnectionSetMember] -> ShowS
showList :: [PostgresConnectionSetMember] -> ShowS
Show, PostgresConnectionSetMember -> PostgresConnectionSetMember -> Bool
(PostgresConnectionSetMember
 -> PostgresConnectionSetMember -> Bool)
-> (PostgresConnectionSetMember
    -> PostgresConnectionSetMember -> Bool)
-> Eq PostgresConnectionSetMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostgresConnectionSetMember -> PostgresConnectionSetMember -> Bool
== :: PostgresConnectionSetMember -> PostgresConnectionSetMember -> Bool
$c/= :: PostgresConnectionSetMember -> PostgresConnectionSetMember -> Bool
/= :: PostgresConnectionSetMember -> PostgresConnectionSetMember -> Bool
Eq, (forall x.
 PostgresConnectionSetMember -> Rep PostgresConnectionSetMember x)
-> (forall x.
    Rep PostgresConnectionSetMember x -> PostgresConnectionSetMember)
-> Generic PostgresConnectionSetMember
forall x.
Rep PostgresConnectionSetMember x -> PostgresConnectionSetMember
forall x.
PostgresConnectionSetMember -> Rep PostgresConnectionSetMember x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
PostgresConnectionSetMember -> Rep PostgresConnectionSetMember x
from :: forall x.
PostgresConnectionSetMember -> Rep PostgresConnectionSetMember x
$cto :: forall x.
Rep PostgresConnectionSetMember x -> PostgresConnectionSetMember
to :: forall x.
Rep PostgresConnectionSetMember x -> PostgresConnectionSetMember
Generic)

instance FromJSON PostgresConnectionSetMember where
  parseJSON :: Value -> Parser PostgresConnectionSetMember
parseJSON = Options -> Value -> Parser PostgresConnectionSetMember
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance ToJSON PostgresConnectionSetMember where
  toJSON :: PostgresConnectionSetMember -> Value
toJSON = Options -> PostgresConnectionSetMember -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}
  toEncoding :: PostgresConnectionSetMember -> Encoding
toEncoding = Options -> PostgresConnectionSetMember -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance Hashable PostgresConnectionSetMember

instance NFData PostgresConnectionSetMember

-- | HashMap of the connection set. This is used for the dynamic DB connection feature.
newtype PostgresConnectionSet = PostgresConnectionSet {PostgresConnectionSet
-> NEHashMap
     PostgresConnectionSetMemberName PostgresConnectionSetMember
getPostgresConnectionSet :: NEMap.NEHashMap PostgresConnectionSetMemberName PostgresConnectionSetMember}
  deriving (Int -> PostgresConnectionSet -> ShowS
[PostgresConnectionSet] -> ShowS
PostgresConnectionSet -> String
(Int -> PostgresConnectionSet -> ShowS)
-> (PostgresConnectionSet -> String)
-> ([PostgresConnectionSet] -> ShowS)
-> Show PostgresConnectionSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostgresConnectionSet -> ShowS
showsPrec :: Int -> PostgresConnectionSet -> ShowS
$cshow :: PostgresConnectionSet -> String
show :: PostgresConnectionSet -> String
$cshowList :: [PostgresConnectionSet] -> ShowS
showList :: [PostgresConnectionSet] -> ShowS
Show, PostgresConnectionSet -> PostgresConnectionSet -> Bool
(PostgresConnectionSet -> PostgresConnectionSet -> Bool)
-> (PostgresConnectionSet -> PostgresConnectionSet -> Bool)
-> Eq PostgresConnectionSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostgresConnectionSet -> PostgresConnectionSet -> Bool
== :: PostgresConnectionSet -> PostgresConnectionSet -> Bool
$c/= :: PostgresConnectionSet -> PostgresConnectionSet -> Bool
/= :: PostgresConnectionSet -> PostgresConnectionSet -> Bool
Eq, (forall x. PostgresConnectionSet -> Rep PostgresConnectionSet x)
-> (forall x. Rep PostgresConnectionSet x -> PostgresConnectionSet)
-> Generic PostgresConnectionSet
forall x. Rep PostgresConnectionSet x -> PostgresConnectionSet
forall x. PostgresConnectionSet -> Rep PostgresConnectionSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PostgresConnectionSet -> Rep PostgresConnectionSet x
from :: forall x. PostgresConnectionSet -> Rep PostgresConnectionSet x
$cto :: forall x. Rep PostgresConnectionSet x -> PostgresConnectionSet
to :: forall x. Rep PostgresConnectionSet x -> PostgresConnectionSet
Generic, NonEmpty PostgresConnectionSet -> PostgresConnectionSet
PostgresConnectionSet
-> PostgresConnectionSet -> PostgresConnectionSet
(PostgresConnectionSet
 -> PostgresConnectionSet -> PostgresConnectionSet)
-> (NonEmpty PostgresConnectionSet -> PostgresConnectionSet)
-> (forall b.
    Integral b =>
    b -> PostgresConnectionSet -> PostgresConnectionSet)
-> Semigroup PostgresConnectionSet
forall b.
Integral b =>
b -> PostgresConnectionSet -> PostgresConnectionSet
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: PostgresConnectionSet
-> PostgresConnectionSet -> PostgresConnectionSet
<> :: PostgresConnectionSet
-> PostgresConnectionSet -> PostgresConnectionSet
$csconcat :: NonEmpty PostgresConnectionSet -> PostgresConnectionSet
sconcat :: NonEmpty PostgresConnectionSet -> PostgresConnectionSet
$cstimes :: forall b.
Integral b =>
b -> PostgresConnectionSet -> PostgresConnectionSet
stimes :: forall b.
Integral b =>
b -> PostgresConnectionSet -> PostgresConnectionSet
Semigroup)

instance Hashable PostgresConnectionSet

instance NFData PostgresConnectionSet

instance FromJSON PostgresConnectionSet where
  parseJSON :: Value -> Parser PostgresConnectionSet
parseJSON = String
-> (Array -> Parser PostgresConnectionSet)
-> Value
-> Parser PostgresConnectionSet
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"PostgresConnectionSet" \Array
arr -> do
    [PostgresConnectionSetMember]
connectionSet <- (Value -> Parser PostgresConnectionSetMember)
-> [Value] -> Parser [PostgresConnectionSetMember]
forall a b. (a -> Parser b) -> [a] -> Parser [b]
mapWithJSONPath Value -> Parser PostgresConnectionSetMember
forall a. FromJSON a => Value -> Parser a
parseJSON (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
arr)
    let connectionSetMemberNames :: [PostgresConnectionSetMemberName]
connectionSetMemberNames = (PostgresConnectionSetMember -> PostgresConnectionSetMemberName)
-> [PostgresConnectionSetMember]
-> [PostgresConnectionSetMemberName]
forall a b. (a -> b) -> [a] -> [b]
map PostgresConnectionSetMember -> PostgresConnectionSetMemberName
_pscmName [PostgresConnectionSetMember]
connectionSet
        duplicateConnSetMemberNames :: [PostgresConnectionSetMemberName]
duplicateConnSetMemberNames = [PostgresConnectionSetMemberName]
connectionSetMemberNames [PostgresConnectionSetMemberName]
-> [PostgresConnectionSetMemberName]
-> [PostgresConnectionSetMemberName]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([PostgresConnectionSetMemberName]
-> [PostgresConnectionSetMemberName]
forall a. Ord a => [a] -> [a]
L.uniques [PostgresConnectionSetMemberName]
connectionSetMemberNames)
    -- check if members with same name are present in connection set
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PostgresConnectionSetMemberName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PostgresConnectionSetMemberName]
duplicateConnSetMemberNames) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
      String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"connection set members with duplicate names are not allowed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack ([Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList ((PostgresConnectionSetMemberName -> Text)
-> [PostgresConnectionSetMemberName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PostgresConnectionSetMemberName -> Text
forall t. ToTxt t => t -> Text
toTxt [PostgresConnectionSetMemberName]
duplicateConnSetMemberNames))
    let connectionSetTuples :: [(PostgresConnectionSetMemberName, PostgresConnectionSetMember)]
connectionSetTuples = (PostgresConnectionSetMember
 -> (PostgresConnectionSetMemberName, PostgresConnectionSetMember))
-> [PostgresConnectionSetMember]
-> [(PostgresConnectionSetMemberName, PostgresConnectionSetMember)]
forall a b. (a -> b) -> [a] -> [b]
map (PostgresConnectionSetMember -> PostgresConnectionSetMemberName
_pscmName (PostgresConnectionSetMember -> PostgresConnectionSetMemberName)
-> (PostgresConnectionSetMember -> PostgresConnectionSetMember)
-> PostgresConnectionSetMember
-> (PostgresConnectionSetMemberName, PostgresConnectionSetMember)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PostgresConnectionSetMember -> PostgresConnectionSetMember
forall a. a -> a
id) [PostgresConnectionSetMember]
connectionSet
    NEHashMap
  PostgresConnectionSetMemberName PostgresConnectionSetMember
connectionSetHashMap <- [(PostgresConnectionSetMemberName, PostgresConnectionSetMember)]
-> Maybe
     (NEHashMap
        PostgresConnectionSetMemberName PostgresConnectionSetMember)
forall k v. Hashable k => [(k, v)] -> Maybe (NEHashMap k v)
NEMap.fromList [(PostgresConnectionSetMemberName, PostgresConnectionSetMember)]
connectionSetTuples Maybe
  (NEHashMap
     PostgresConnectionSetMemberName PostgresConnectionSetMember)
-> Parser
     (NEHashMap
        PostgresConnectionSetMemberName PostgresConnectionSetMember)
-> Parser
     (NEHashMap
        PostgresConnectionSetMemberName PostgresConnectionSetMember)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` String
-> Parser
     (NEHashMap
        PostgresConnectionSetMemberName PostgresConnectionSetMember)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"connection set cannot be empty"
    PostgresConnectionSet -> Parser PostgresConnectionSet
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PostgresConnectionSet -> Parser PostgresConnectionSet)
-> PostgresConnectionSet -> Parser PostgresConnectionSet
forall a b. (a -> b) -> a -> b
$ NEHashMap
  PostgresConnectionSetMemberName PostgresConnectionSetMember
-> PostgresConnectionSet
PostgresConnectionSet NEHashMap
  PostgresConnectionSetMemberName PostgresConnectionSetMember
connectionSetHashMap

instance ToJSON PostgresConnectionSet where
  toJSON :: PostgresConnectionSet -> Value
toJSON (PostgresConnectionSet NEHashMap
  PostgresConnectionSetMemberName PostgresConnectionSetMember
connSet) = [PostgresConnectionSetMember] -> Value
forall a. ToJSON a => a -> Value
toJSON ([PostgresConnectionSetMember] -> Value)
-> [PostgresConnectionSetMember] -> Value
forall a b. (a -> b) -> a -> b
$ NEHashMap
  PostgresConnectionSetMemberName PostgresConnectionSetMember
-> [PostgresConnectionSetMember]
forall k v. NEHashMap k v -> [v]
NEMap.elems NEHashMap
  PostgresConnectionSetMemberName PostgresConnectionSetMember
connSet

instance HasCodec PostgresConnectionSet where
  codec :: JSONCodec PostgresConnectionSet
codec = Text -> JSONCodec PostgresConnectionSet
forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
"PostgresConnectionSet"

data PostgresConnConfiguration = PostgresConnConfiguration
  { PostgresConnConfiguration -> PostgresSourceConnInfo
_pccConnectionInfo :: PostgresSourceConnInfo,
    PostgresConnConfiguration
-> Maybe (NonEmpty PostgresSourceConnInfo)
_pccReadReplicas :: Maybe (NonEmpty PostgresSourceConnInfo),
    PostgresConnConfiguration -> ExtensionsSchema
_pccExtensionsSchema :: ExtensionsSchema,
    PostgresConnConfiguration -> Maybe ConnectionTemplate
_pccConnectionTemplate :: Maybe ConnectionTemplate,
    PostgresConnConfiguration -> Maybe PostgresConnectionSet
_pccConnectionSet :: Maybe PostgresConnectionSet
  }
  deriving (Int -> PostgresConnConfiguration -> ShowS
[PostgresConnConfiguration] -> ShowS
PostgresConnConfiguration -> String
(Int -> PostgresConnConfiguration -> ShowS)
-> (PostgresConnConfiguration -> String)
-> ([PostgresConnConfiguration] -> ShowS)
-> Show PostgresConnConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostgresConnConfiguration -> ShowS
showsPrec :: Int -> PostgresConnConfiguration -> ShowS
$cshow :: PostgresConnConfiguration -> String
show :: PostgresConnConfiguration -> String
$cshowList :: [PostgresConnConfiguration] -> ShowS
showList :: [PostgresConnConfiguration] -> ShowS
Show, PostgresConnConfiguration -> PostgresConnConfiguration -> Bool
(PostgresConnConfiguration -> PostgresConnConfiguration -> Bool)
-> (PostgresConnConfiguration -> PostgresConnConfiguration -> Bool)
-> Eq PostgresConnConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostgresConnConfiguration -> PostgresConnConfiguration -> Bool
== :: PostgresConnConfiguration -> PostgresConnConfiguration -> Bool
$c/= :: PostgresConnConfiguration -> PostgresConnConfiguration -> Bool
/= :: PostgresConnConfiguration -> PostgresConnConfiguration -> Bool
Eq, (forall x.
 PostgresConnConfiguration -> Rep PostgresConnConfiguration x)
-> (forall x.
    Rep PostgresConnConfiguration x -> PostgresConnConfiguration)
-> Generic PostgresConnConfiguration
forall x.
Rep PostgresConnConfiguration x -> PostgresConnConfiguration
forall x.
PostgresConnConfiguration -> Rep PostgresConnConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
PostgresConnConfiguration -> Rep PostgresConnConfiguration x
from :: forall x.
PostgresConnConfiguration -> Rep PostgresConnConfiguration x
$cto :: forall x.
Rep PostgresConnConfiguration x -> PostgresConnConfiguration
to :: forall x.
Rep PostgresConnConfiguration x -> PostgresConnConfiguration
Generic)

instance Hashable PostgresConnConfiguration

instance NFData PostgresConnConfiguration

instance FromJSON PostgresConnConfiguration where
  parseJSON :: Value -> Parser PostgresConnConfiguration
parseJSON = String
-> (Object -> Parser PostgresConnConfiguration)
-> Value
-> Parser PostgresConnConfiguration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PostgresConnConfiguration" ((Object -> Parser PostgresConnConfiguration)
 -> Value -> Parser PostgresConnConfiguration)
-> (Object -> Parser PostgresConnConfiguration)
-> Value
-> Parser PostgresConnConfiguration
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    PostgresSourceConnInfo
-> Maybe (NonEmpty PostgresSourceConnInfo)
-> ExtensionsSchema
-> Maybe ConnectionTemplate
-> Maybe PostgresConnectionSet
-> PostgresConnConfiguration
PostgresConnConfiguration
      (PostgresSourceConnInfo
 -> Maybe (NonEmpty PostgresSourceConnInfo)
 -> ExtensionsSchema
 -> Maybe ConnectionTemplate
 -> Maybe PostgresConnectionSet
 -> PostgresConnConfiguration)
-> Parser PostgresSourceConnInfo
-> Parser
     (Maybe (NonEmpty PostgresSourceConnInfo)
      -> ExtensionsSchema
      -> Maybe ConnectionTemplate
      -> Maybe PostgresConnectionSet
      -> PostgresConnConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser PostgresSourceConnInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"connection_info"
      Parser
  (Maybe (NonEmpty PostgresSourceConnInfo)
   -> ExtensionsSchema
   -> Maybe ConnectionTemplate
   -> Maybe PostgresConnectionSet
   -> PostgresConnConfiguration)
-> Parser (Maybe (NonEmpty PostgresSourceConnInfo))
-> Parser
     (ExtensionsSchema
      -> Maybe ConnectionTemplate
      -> Maybe PostgresConnectionSet
      -> PostgresConnConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe (NonEmpty PostgresSourceConnInfo))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"read_replicas"
      Parser
  (ExtensionsSchema
   -> Maybe ConnectionTemplate
   -> Maybe PostgresConnectionSet
   -> PostgresConnConfiguration)
-> Parser ExtensionsSchema
-> Parser
     (Maybe ConnectionTemplate
      -> Maybe PostgresConnectionSet -> PostgresConnConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe ExtensionsSchema)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extensions_schema"
      Parser (Maybe ExtensionsSchema)
-> ExtensionsSchema -> Parser ExtensionsSchema
forall a. Parser (Maybe a) -> a -> Parser a
.!= ExtensionsSchema
defaultPostgresExtensionsSchema
      Parser
  (Maybe ConnectionTemplate
   -> Maybe PostgresConnectionSet -> PostgresConnConfiguration)
-> Parser (Maybe ConnectionTemplate)
-> Parser
     (Maybe PostgresConnectionSet -> PostgresConnConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe ConnectionTemplate)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"connection_template"
      Parser (Maybe PostgresConnectionSet -> PostgresConnConfiguration)
-> Parser (Maybe PostgresConnectionSet)
-> Parser PostgresConnConfiguration
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe PostgresConnectionSet)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"connection_set"

instance ToJSON PostgresConnConfiguration where
  toJSON :: PostgresConnConfiguration -> Value
toJSON PostgresConnConfiguration {Maybe (NonEmpty PostgresSourceConnInfo)
Maybe PostgresConnectionSet
Maybe ConnectionTemplate
ExtensionsSchema
PostgresSourceConnInfo
_pccConnectionInfo :: PostgresConnConfiguration -> PostgresSourceConnInfo
_pccReadReplicas :: PostgresConnConfiguration
-> Maybe (NonEmpty PostgresSourceConnInfo)
_pccExtensionsSchema :: PostgresConnConfiguration -> ExtensionsSchema
_pccConnectionTemplate :: PostgresConnConfiguration -> Maybe ConnectionTemplate
_pccConnectionSet :: PostgresConnConfiguration -> Maybe PostgresConnectionSet
_pccConnectionInfo :: PostgresSourceConnInfo
_pccReadReplicas :: Maybe (NonEmpty PostgresSourceConnInfo)
_pccExtensionsSchema :: ExtensionsSchema
_pccConnectionTemplate :: Maybe ConnectionTemplate
_pccConnectionSet :: Maybe PostgresConnectionSet
..} =
    [Pair] -> Value
object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Key
"connection_info" Key -> PostgresSourceConnInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= PostgresSourceConnInfo
_pccConnectionInfo]
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
-> (NonEmpty PostgresSourceConnInfo -> [Pair])
-> Maybe (NonEmpty PostgresSourceConnInfo)
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Pair]
forall a. Monoid a => a
mempty (\NonEmpty PostgresSourceConnInfo
readReplicas -> [Key
"read_replicas" Key -> NonEmpty PostgresSourceConnInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NonEmpty PostgresSourceConnInfo
readReplicas]) Maybe (NonEmpty PostgresSourceConnInfo)
_pccReadReplicas
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair] -> [Pair] -> Bool -> [Pair]
forall a. a -> a -> Bool -> a
bool [Pair]
forall a. Monoid a => a
mempty ([Key
"extensions_schema" Key -> ExtensionsSchema -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ExtensionsSchema
_pccExtensionsSchema]) (ExtensionsSchema
_pccExtensionsSchema ExtensionsSchema -> ExtensionsSchema -> Bool
forall a. Eq a => a -> a -> Bool
/= ExtensionsSchema
defaultPostgresExtensionsSchema)
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
-> (ConnectionTemplate -> [Pair])
-> Maybe ConnectionTemplate
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Pair]
forall a. Monoid a => a
mempty (\ConnectionTemplate
connTemplate -> [Key
"connection_template" Key -> ConnectionTemplate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ConnectionTemplate
connTemplate]) Maybe ConnectionTemplate
_pccConnectionTemplate
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
-> (PostgresConnectionSet -> [Pair])
-> Maybe PostgresConnectionSet
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Pair]
forall a. Monoid a => a
mempty (\PostgresConnectionSet
connSet -> [Key
"connection_set" Key -> [PostgresConnectionSetMember] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NEHashMap
  PostgresConnectionSetMemberName PostgresConnectionSetMember
-> [PostgresConnectionSetMember]
forall k v. NEHashMap k v -> [v]
NEMap.elems (PostgresConnectionSet
-> NEHashMap
     PostgresConnectionSetMemberName PostgresConnectionSetMember
getPostgresConnectionSet PostgresConnectionSet
connSet)]) Maybe PostgresConnectionSet
_pccConnectionSet

instance HasCodec PostgresConnConfiguration where
  codec :: JSONCodec PostgresConnConfiguration
codec =
    Text
-> JSONCodec PostgresConnConfiguration
-> JSONCodec PostgresConnConfiguration
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
CommentCodec Text
"https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgconfiguration"
      (JSONCodec PostgresConnConfiguration
 -> JSONCodec PostgresConnConfiguration)
-> JSONCodec PostgresConnConfiguration
-> JSONCodec PostgresConnConfiguration
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec PostgresConnConfiguration PostgresConnConfiguration
-> JSONCodec PostgresConnConfiguration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"PostgresConnConfiguration"
      (ObjectCodec PostgresConnConfiguration PostgresConnConfiguration
 -> JSONCodec PostgresConnConfiguration)
-> ObjectCodec PostgresConnConfiguration PostgresConnConfiguration
-> JSONCodec PostgresConnConfiguration
forall a b. (a -> b) -> a -> b
$ PostgresSourceConnInfo
-> Maybe (NonEmpty PostgresSourceConnInfo)
-> ExtensionsSchema
-> Maybe ConnectionTemplate
-> Maybe PostgresConnectionSet
-> PostgresConnConfiguration
PostgresConnConfiguration
      (PostgresSourceConnInfo
 -> Maybe (NonEmpty PostgresSourceConnInfo)
 -> ExtensionsSchema
 -> Maybe ConnectionTemplate
 -> Maybe PostgresConnectionSet
 -> PostgresConnConfiguration)
-> Codec Object PostgresConnConfiguration PostgresSourceConnInfo
-> Codec
     Object
     PostgresConnConfiguration
     (Maybe (NonEmpty PostgresSourceConnInfo)
      -> ExtensionsSchema
      -> Maybe ConnectionTemplate
      -> Maybe PostgresConnectionSet
      -> PostgresConnConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Text
-> ObjectCodec PostgresSourceConnInfo PostgresSourceConnInfo
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"connection_info" Text
connectionInfoDoc
      ObjectCodec PostgresSourceConnInfo PostgresSourceConnInfo
-> (PostgresConnConfiguration -> PostgresSourceConnInfo)
-> Codec Object PostgresConnConfiguration PostgresSourceConnInfo
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresConnConfiguration -> PostgresSourceConnInfo
_pccConnectionInfo
        Codec
  Object
  PostgresConnConfiguration
  (Maybe (NonEmpty PostgresSourceConnInfo)
   -> ExtensionsSchema
   -> Maybe ConnectionTemplate
   -> Maybe PostgresConnectionSet
   -> PostgresConnConfiguration)
-> Codec
     Object
     PostgresConnConfiguration
     (Maybe (NonEmpty PostgresSourceConnInfo))
-> Codec
     Object
     PostgresConnConfiguration
     (ExtensionsSchema
      -> Maybe ConnectionTemplate
      -> Maybe PostgresConnectionSet
      -> PostgresConnConfiguration)
forall a b.
Codec Object PostgresConnConfiguration (a -> b)
-> Codec Object PostgresConnConfiguration a
-> Codec Object PostgresConnConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text
-> ObjectCodec
     (Maybe (NonEmpty PostgresSourceConnInfo))
     (Maybe (NonEmpty PostgresSourceConnInfo))
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"read_replicas" Text
readReplicasDoc
      ObjectCodec
  (Maybe (NonEmpty PostgresSourceConnInfo))
  (Maybe (NonEmpty PostgresSourceConnInfo))
-> (PostgresConnConfiguration
    -> Maybe (NonEmpty PostgresSourceConnInfo))
-> Codec
     Object
     PostgresConnConfiguration
     (Maybe (NonEmpty PostgresSourceConnInfo))
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresConnConfiguration
-> Maybe (NonEmpty PostgresSourceConnInfo)
_pccReadReplicas
        Codec
  Object
  PostgresConnConfiguration
  (ExtensionsSchema
   -> Maybe ConnectionTemplate
   -> Maybe PostgresConnectionSet
   -> PostgresConnConfiguration)
-> Codec Object PostgresConnConfiguration ExtensionsSchema
-> Codec
     Object
     PostgresConnConfiguration
     (Maybe ConnectionTemplate
      -> Maybe PostgresConnectionSet -> PostgresConnConfiguration)
forall a b.
Codec Object PostgresConnConfiguration (a -> b)
-> Codec Object PostgresConnConfiguration a
-> Codec Object PostgresConnConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ExtensionsSchema
-> Text
-> ObjectCodec ExtensionsSchema ExtensionsSchema
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"extensions_schema" ExtensionsSchema
defaultPostgresExtensionsSchema Text
extensionsSchemaDoc
      ObjectCodec ExtensionsSchema ExtensionsSchema
-> (PostgresConnConfiguration -> ExtensionsSchema)
-> Codec Object PostgresConnConfiguration ExtensionsSchema
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresConnConfiguration -> ExtensionsSchema
_pccExtensionsSchema
        Codec
  Object
  PostgresConnConfiguration
  (Maybe ConnectionTemplate
   -> Maybe PostgresConnectionSet -> PostgresConnConfiguration)
-> Codec
     Object PostgresConnConfiguration (Maybe ConnectionTemplate)
-> Codec
     Object
     PostgresConnConfiguration
     (Maybe PostgresConnectionSet -> PostgresConnConfiguration)
forall a b.
Codec Object PostgresConnConfiguration (a -> b)
-> Codec Object PostgresConnConfiguration a
-> Codec Object PostgresConnConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text
-> ObjectCodec
     (Maybe ConnectionTemplate) (Maybe ConnectionTemplate)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"connection_template" Text
connectionTemplateDoc
      ObjectCodec (Maybe ConnectionTemplate) (Maybe ConnectionTemplate)
-> (PostgresConnConfiguration -> Maybe ConnectionTemplate)
-> Codec
     Object PostgresConnConfiguration (Maybe ConnectionTemplate)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresConnConfiguration -> Maybe ConnectionTemplate
_pccConnectionTemplate
        Codec
  Object
  PostgresConnConfiguration
  (Maybe PostgresConnectionSet -> PostgresConnConfiguration)
-> Codec
     Object PostgresConnConfiguration (Maybe PostgresConnectionSet)
-> ObjectCodec PostgresConnConfiguration PostgresConnConfiguration
forall a b.
Codec Object PostgresConnConfiguration (a -> b)
-> Codec Object PostgresConnConfiguration a
-> Codec Object PostgresConnConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text
-> ObjectCodec
     (Maybe PostgresConnectionSet) (Maybe PostgresConnectionSet)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"connection_set" Text
connectionSetDoc
      ObjectCodec
  (Maybe PostgresConnectionSet) (Maybe PostgresConnectionSet)
-> (PostgresConnConfiguration -> Maybe PostgresConnectionSet)
-> Codec
     Object PostgresConnConfiguration (Maybe PostgresConnectionSet)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== PostgresConnConfiguration -> Maybe PostgresConnectionSet
_pccConnectionSet
    where
      connectionInfoDoc :: Text
connectionInfoDoc = Text
"Connection parameters for the source"
      readReplicasDoc :: Text
readReplicasDoc = Text
"Optional list of read replica configuration (supported only in cloud/enterprise versions)"
      extensionsSchemaDoc :: Text
extensionsSchemaDoc = Text
"Name of the schema where the graphql-engine will install database extensions (default: public)"
      connectionTemplateDoc :: Text
connectionTemplateDoc = Text
"Optional connection template (supported only for cloud/enterprise edition)"
      connectionSetDoc :: Text
connectionSetDoc = Text
"connection set used for connection template (supported only for cloud/enterprise edition)"
      infix 8 .==
      .== :: ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(.==) = ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(AC..=)