{-# LANGUAGE TemplateHaskell #-}
{-# 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 (..),
    getDefaultPGPoolSettingIfNotExists,
    defaultPostgresPoolSettings,
    defaultPostgresExtensionsSchema,
    setPostgresPoolSettings,
    pccConnectionInfo,
    pccReadReplicas,
    pccExtensionsSchema,
    psciDatabaseUrl,
    psciPoolSettings,
    psciUsePreparedStatements,
    psciIsolationLevel,
    psciSslConfiguration,
  )
where

import Autodocodec (HasCodec (codec), named)
import Control.Lens (makeLenses)
import Data.Aeson
import Data.Aeson.Casing (aesonDrop)
import Data.Aeson.TH
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Char (toLower)
import Data.Semigroup (Max (..))
import Data.Text (unpack)
import Data.Text qualified as T
import Data.Time
import Data.Time.Clock.Compat ()
import Database.PG.Query qualified as Q
import Hasura.Base.Instances ()
import Hasura.Incremental (Cacheable (..))
import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
import Hasura.Prelude
import Hasura.RQL.Types.Common (UrlConf (..))
import Hasura.SQL.Types (ExtensionsSchema (..))
import Hasura.Server.Utils (parseConnLifeTime, readIsoLevel)
import Test.QuickCheck.Instances.Semigroup ()
import Test.QuickCheck.Instances.Time ()

data PostgresPoolSettings = PostgresPoolSettings
  { PostgresPoolSettings -> Maybe Int
_ppsMaxConnections :: 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
showList :: [PostgresPoolSettings] -> ShowS
$cshowList :: [PostgresPoolSettings] -> ShowS
show :: PostgresPoolSettings -> String
$cshow :: PostgresPoolSettings -> String
showsPrec :: Int -> PostgresPoolSettings -> ShowS
$cshowsPrec :: Int -> PostgresPoolSettings -> ShowS
Show, PostgresPoolSettings -> PostgresPoolSettings -> Bool
(PostgresPoolSettings -> PostgresPoolSettings -> Bool)
-> (PostgresPoolSettings -> PostgresPoolSettings -> Bool)
-> Eq PostgresPoolSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostgresPoolSettings -> PostgresPoolSettings -> Bool
$c/= :: PostgresPoolSettings -> PostgresPoolSettings -> Bool
== :: PostgresPoolSettings -> PostgresPoolSettings -> Bool
$c== :: 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
$cto :: forall x. Rep PostgresPoolSettings x -> PostgresPoolSettings
$cfrom :: forall x. PostgresPoolSettings -> Rep PostgresPoolSettings x
Generic)

instance Cacheable PostgresPoolSettings

instance Hashable PostgresPoolSettings

instance NFData PostgresPoolSettings

$(deriveToJSON hasuraJSON {omitNothingFields = True} ''PostgresPoolSettings)

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 NominalDiffTime
-> Maybe NominalDiffTime
-> PostgresPoolSettings
PostgresPoolSettings
      (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 (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 NominalDiffTime
   -> Maybe NominalDiffTime
   -> PostgresPoolSettings)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe NominalDiffTime
      -> Maybe NominalDiffTime
      -> PostgresPoolSettings)
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 (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 (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 (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
showList :: [DefaultPostgresPoolSettings] -> ShowS
$cshowList :: [DefaultPostgresPoolSettings] -> ShowS
show :: DefaultPostgresPoolSettings -> String
$cshow :: DefaultPostgresPoolSettings -> String
showsPrec :: Int -> DefaultPostgresPoolSettings -> ShowS
$cshowsPrec :: Int -> DefaultPostgresPoolSettings -> ShowS
Show, DefaultPostgresPoolSettings -> DefaultPostgresPoolSettings -> Bool
(DefaultPostgresPoolSettings
 -> DefaultPostgresPoolSettings -> Bool)
-> (DefaultPostgresPoolSettings
    -> DefaultPostgresPoolSettings -> Bool)
-> Eq DefaultPostgresPoolSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultPostgresPoolSettings -> DefaultPostgresPoolSettings -> Bool
$c/= :: DefaultPostgresPoolSettings -> DefaultPostgresPoolSettings -> Bool
== :: DefaultPostgresPoolSettings -> DefaultPostgresPoolSettings -> Bool
$c== :: 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 :: Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe NominalDiffTime
-> Maybe NominalDiffTime
-> PostgresPoolSettings
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),
      _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
/= :: SSLMode -> SSLMode -> Bool
$c/= :: SSLMode -> SSLMode -> Bool
== :: SSLMode -> SSLMode -> Bool
$c== :: 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
min :: SSLMode -> SSLMode -> SSLMode
$cmin :: SSLMode -> SSLMode -> SSLMode
max :: SSLMode -> SSLMode -> SSLMode
$cmax :: SSLMode -> SSLMode -> SSLMode
>= :: SSLMode -> SSLMode -> Bool
$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
compare :: SSLMode -> SSLMode -> Ordering
$ccompare :: SSLMode -> SSLMode -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep SSLMode x -> SSLMode
$cfrom :: forall x. SSLMode -> Rep SSLMode x
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
enumFromThenTo :: SSLMode -> SSLMode -> SSLMode -> [SSLMode]
$cenumFromThenTo :: SSLMode -> SSLMode -> SSLMode -> [SSLMode]
enumFromTo :: SSLMode -> SSLMode -> [SSLMode]
$cenumFromTo :: SSLMode -> SSLMode -> [SSLMode]
enumFromThen :: SSLMode -> SSLMode -> [SSLMode]
$cenumFromThen :: SSLMode -> SSLMode -> [SSLMode]
enumFrom :: SSLMode -> [SSLMode]
$cenumFrom :: SSLMode -> [SSLMode]
fromEnum :: SSLMode -> Int
$cfromEnum :: SSLMode -> Int
toEnum :: Int -> SSLMode
$ctoEnum :: Int -> SSLMode
pred :: SSLMode -> SSLMode
$cpred :: SSLMode -> SSLMode
succ :: SSLMode -> SSLMode
$csucc :: SSLMode -> SSLMode
Enum, SSLMode
SSLMode -> SSLMode -> Bounded SSLMode
forall a. a -> a -> Bounded a
maxBound :: SSLMode
$cmaxBound :: SSLMode
minBound :: SSLMode
$cminBound :: SSLMode
Bounded)

instance Cacheable SSLMode

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 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 (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
Disable
    Text
"allow" -> SSLMode -> Parser SSLMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
Allow
    Text
"prefer" -> SSLMode -> Parser SSLMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
Prefer
    Text
"require" -> SSLMode -> Parser SSLMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
Require
    Text
"verify-ca" -> SSLMode -> Parser SSLMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
VerifyCA
    Text
"verify-full" -> SSLMode -> Parser SSLMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLMode
VerifyFull
    Text
err -> String -> Parser SSLMode
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
showList :: [CertVar] -> ShowS
$cshowList :: [CertVar] -> ShowS
show :: CertVar -> String
$cshow :: CertVar -> String
showsPrec :: Int -> CertVar -> ShowS
$cshowsPrec :: Int -> CertVar -> ShowS
Show, CertVar -> CertVar -> Bool
(CertVar -> CertVar -> Bool)
-> (CertVar -> CertVar -> Bool) -> Eq CertVar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertVar -> CertVar -> Bool
$c/= :: CertVar -> CertVar -> Bool
== :: CertVar -> CertVar -> Bool
$c== :: 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
$cto :: forall x. Rep CertVar x -> CertVar
$cfrom :: forall x. CertVar -> Rep CertVar x
Generic)

instance Cacheable CertVar

instance Hashable CertVar

instance NFData CertVar

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
.= 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
showList :: [CertData] -> ShowS
$cshowList :: [CertData] -> ShowS
show :: CertData -> String
$cshow :: CertData -> String
showsPrec :: Int -> CertData -> ShowS
$cshowsPrec :: Int -> CertData -> ShowS
Show, CertData -> CertData -> Bool
(CertData -> CertData -> Bool)
-> (CertData -> CertData -> Bool) -> Eq CertData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertData -> CertData -> Bool
$c/= :: CertData -> CertData -> Bool
== :: CertData -> CertData -> Bool
$c== :: 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
$cto :: forall x. Rep CertData x -> CertData
$cfrom :: forall x. CertData -> Rep CertData x
Generic)

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

$(deriveFromJSON (aesonDrop 3 (fmap toLower)) ''PGClientCerts)
$(deriveToJSON (aesonDrop 3 (fmap toLower)) {omitNothingFields = True} ''PGClientCerts)

instance Bifunctor PGClientCerts where
  bimap :: (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 :: Maybe a
pgcSslPassword :: forall p a. PGClientCerts p a -> Maybe p
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 :: (a -> m) -> (b -> m) -> PGClientCerts a b -> m
bifoldMap a -> m
f b -> m
g PGClientCerts {Maybe a
Maybe b
SSLMode
pgcSslPassword :: Maybe a
pgcSslMode :: SSLMode
pgcSslRootCert :: Maybe b
pgcSslKey :: Maybe b
pgcSslCert :: Maybe b
pgcSslPassword :: forall p a. PGClientCerts p a -> Maybe p
pgcSslMode :: forall p a. PGClientCerts p a -> SSLMode
pgcSslRootCert :: forall p a. PGClientCerts p a -> Maybe a
pgcSslKey :: forall p a. PGClientCerts p a -> Maybe a
pgcSslCert :: forall p a. PGClientCerts p a -> Maybe a
..} =
    let gs :: m
gs = (Maybe b -> m) -> [Maybe b] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((b -> m) -> Maybe b -> 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 (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 :: (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
pgcSslPassword :: Maybe a
pgcSslMode :: SSLMode
pgcSslRootCert :: Maybe b
pgcSslKey :: Maybe b
pgcSslCert :: Maybe b
pgcSslPassword :: forall p a. PGClientCerts p a -> Maybe p
pgcSslMode :: forall p a. PGClientCerts p a -> SSLMode
pgcSslRootCert :: forall p a. PGClientCerts p a -> Maybe a
pgcSslKey :: forall p a. PGClientCerts p a -> Maybe a
pgcSslCert :: forall p a. PGClientCerts p a -> 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)
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 (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)
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 (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)
traverse b -> f d
g Maybe b
pgcSslRootCert
      f (SSLMode -> Maybe c -> PGClientCerts c d)
-> f SSLMode -> f (Maybe c -> PGClientCerts c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SSLMode -> f SSLMode
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 (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)
traverse a -> f c
f Maybe a
pgcSslPassword

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

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 Q.TxIsolation

instance Cacheable Q.TxIsolation

instance NFData Q.TxIsolation

instance Hashable Q.TxIsolation

instance FromJSON Q.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 (m :: * -> *) a. MonadFail m => String -> m a
fail

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

data PostgresSourceConnInfo = PostgresSourceConnInfo
  { PostgresSourceConnInfo -> UrlConf
_psciDatabaseUrl :: UrlConf,
    PostgresSourceConnInfo -> Maybe PostgresPoolSettings
_psciPoolSettings :: Maybe PostgresPoolSettings,
    PostgresSourceConnInfo -> Bool
_psciUsePreparedStatements :: Bool,
    PostgresSourceConnInfo -> TxIsolation
_psciIsolationLevel :: Q.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
showList :: [PostgresSourceConnInfo] -> ShowS
$cshowList :: [PostgresSourceConnInfo] -> ShowS
show :: PostgresSourceConnInfo -> String
$cshow :: PostgresSourceConnInfo -> String
showsPrec :: Int -> PostgresSourceConnInfo -> ShowS
$cshowsPrec :: Int -> PostgresSourceConnInfo -> ShowS
Show, PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool
(PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool)
-> (PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool)
-> Eq PostgresSourceConnInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool
$c/= :: PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool
== :: PostgresSourceConnInfo -> PostgresSourceConnInfo -> Bool
$c== :: 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
$cto :: forall x. Rep PostgresSourceConnInfo x -> PostgresSourceConnInfo
$cfrom :: forall x. PostgresSourceConnInfo -> Rep PostgresSourceConnInfo x
Generic)

instance Cacheable PostgresSourceConnInfo

instance Hashable PostgresSourceConnInfo

instance NFData PostgresSourceConnInfo

$(deriveToJSON hasuraJSON {omitNothingFields = True} ''PostgresSourceConnInfo)
$(makeLenses ''PostgresSourceConnInfo)

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 (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 (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 (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
Q.ReadCommitted
      Parser
  (Maybe (PGClientCerts CertVar CertVar) -> PostgresSourceConnInfo)
-> Parser (Maybe (PGClientCerts CertVar CertVar))
-> Parser PostgresSourceConnInfo
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"

data PostgresConnConfiguration = PostgresConnConfiguration
  { PostgresConnConfiguration -> PostgresSourceConnInfo
_pccConnectionInfo :: PostgresSourceConnInfo,
    PostgresConnConfiguration
-> Maybe (NonEmpty PostgresSourceConnInfo)
_pccReadReplicas :: Maybe (NonEmpty PostgresSourceConnInfo),
    PostgresConnConfiguration -> ExtensionsSchema
_pccExtensionsSchema :: ExtensionsSchema
  }
  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
showList :: [PostgresConnConfiguration] -> ShowS
$cshowList :: [PostgresConnConfiguration] -> ShowS
show :: PostgresConnConfiguration -> String
$cshow :: PostgresConnConfiguration -> String
showsPrec :: Int -> PostgresConnConfiguration -> ShowS
$cshowsPrec :: Int -> PostgresConnConfiguration -> ShowS
Show, PostgresConnConfiguration -> PostgresConnConfiguration -> Bool
(PostgresConnConfiguration -> PostgresConnConfiguration -> Bool)
-> (PostgresConnConfiguration -> PostgresConnConfiguration -> Bool)
-> Eq PostgresConnConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostgresConnConfiguration -> PostgresConnConfiguration -> Bool
$c/= :: PostgresConnConfiguration -> PostgresConnConfiguration -> Bool
== :: PostgresConnConfiguration -> PostgresConnConfiguration -> Bool
$c== :: 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
$cto :: forall x.
Rep PostgresConnConfiguration x -> PostgresConnConfiguration
$cfrom :: forall x.
PostgresConnConfiguration -> Rep PostgresConnConfiguration x
Generic)

instance Cacheable PostgresConnConfiguration

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 ->
    PostgresSourceConnInfo
-> Maybe (NonEmpty PostgresSourceConnInfo)
-> ExtensionsSchema
-> PostgresConnConfiguration
PostgresConnConfiguration
      (PostgresSourceConnInfo
 -> Maybe (NonEmpty PostgresSourceConnInfo)
 -> ExtensionsSchema
 -> PostgresConnConfiguration)
-> Parser PostgresSourceConnInfo
-> Parser
     (Maybe (NonEmpty PostgresSourceConnInfo)
      -> ExtensionsSchema -> 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 -> PostgresConnConfiguration)
-> Parser (Maybe (NonEmpty PostgresSourceConnInfo))
-> Parser (ExtensionsSchema -> PostgresConnConfiguration)
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 -> PostgresConnConfiguration)
-> Parser ExtensionsSchema -> Parser PostgresConnConfiguration
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

instance ToJSON PostgresConnConfiguration where
  toJSON :: PostgresConnConfiguration -> Value
toJSON PostgresConnConfiguration {Maybe (NonEmpty PostgresSourceConnInfo)
ExtensionsSchema
PostgresSourceConnInfo
_pccExtensionsSchema :: ExtensionsSchema
_pccReadReplicas :: Maybe (NonEmpty PostgresSourceConnInfo)
_pccConnectionInfo :: PostgresSourceConnInfo
_pccExtensionsSchema :: PostgresConnConfiguration -> ExtensionsSchema
_pccReadReplicas :: PostgresConnConfiguration
-> Maybe (NonEmpty PostgresSourceConnInfo)
_pccConnectionInfo :: PostgresConnConfiguration -> PostgresSourceConnInfo
..} =
    [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
.= 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
.= 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
.= ExtensionsSchema
_pccExtensionsSchema]) (ExtensionsSchema
_pccExtensionsSchema ExtensionsSchema -> ExtensionsSchema -> Bool
forall a. Eq a => a -> a -> Bool
/= ExtensionsSchema
defaultPostgresExtensionsSchema)

instance HasCodec PostgresConnConfiguration where
  codec :: JSONCodec PostgresConnConfiguration
codec = Text
-> JSONCodec PostgresConnConfiguration
-> JSONCodec PostgresConnConfiguration
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"PostgresConnConfiguration" (JSONCodec PostgresConnConfiguration
 -> JSONCodec PostgresConnConfiguration)
-> JSONCodec PostgresConnConfiguration
-> JSONCodec PostgresConnConfiguration
forall a b. (a -> b) -> a -> b
$ JSONCodec PostgresConnConfiguration
forall a. (FromJSON a, ToJSON a) => JSONCodec a
placeholderCodecViaJSON

$(makeLenses ''PostgresConnConfiguration)