{-# LANGUAGE Strict #-}

module Database.PostgreSQL.Replicant.Settings where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B

data PgSettings
  = PgSettings
  { PgSettings -> String
pgUser        :: String
  , PgSettings -> Maybe String
pgPassword    :: Maybe String
  , PgSettings -> String
pgDbName      :: String
  , PgSettings -> String
pgHost        :: String
  , PgSettings -> String
pgPort        :: String
  , PgSettings -> String
pgSlotName    :: String
  , PgSettings -> String
pgUpdateDelay :: String -- ^ Controls how frequently the
                            -- primaryKeepAlive thread updates
                            -- PostgresSQL in @ms@
  }
  deriving (PgSettings -> PgSettings -> Bool
(PgSettings -> PgSettings -> Bool)
-> (PgSettings -> PgSettings -> Bool) -> Eq PgSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgSettings -> PgSettings -> Bool
$c/= :: PgSettings -> PgSettings -> Bool
== :: PgSettings -> PgSettings -> Bool
$c== :: PgSettings -> PgSettings -> Bool
Eq, Int -> PgSettings -> ShowS
[PgSettings] -> ShowS
PgSettings -> String
(Int -> PgSettings -> ShowS)
-> (PgSettings -> String)
-> ([PgSettings] -> ShowS)
-> Show PgSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgSettings] -> ShowS
$cshowList :: [PgSettings] -> ShowS
show :: PgSettings -> String
$cshow :: PgSettings -> String
showsPrec :: Int -> PgSettings -> ShowS
$cshowsPrec :: Int -> PgSettings -> ShowS
Show)

pgConnectionString :: PgSettings -> ByteString
pgConnectionString :: PgSettings -> ByteString
pgConnectionString PgSettings {String
Maybe String
pgUpdateDelay :: String
pgSlotName :: String
pgPort :: String
pgHost :: String
pgDbName :: String
pgPassword :: Maybe String
pgUser :: String
pgUpdateDelay :: PgSettings -> String
pgSlotName :: PgSettings -> String
pgPort :: PgSettings -> String
pgHost :: PgSettings -> String
pgDbName :: PgSettings -> String
pgPassword :: PgSettings -> Maybe String
pgUser :: PgSettings -> String
..} = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
" "
  [ ByteString
"user=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
B.pack String
pgUser
  , ByteString -> (String -> ByteString) -> Maybe String -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (\String
pgPass -> ByteString
"pass=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
B.pack String
pgPass) Maybe String
pgPassword
  , ByteString
"dbname=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
B.pack String
pgDbName
  , ByteString
"host=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
B.pack String
pgHost
  , ByteString
"port=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
B.pack String
pgPort
  , ByteString
"replication=database"
  ]