{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Database.PSQL.Config
  ( PSQL (..)
  , genPSQLPool
  ) where

import           Data.Aeson                 (FromJSON, parseJSON, withObject,
                                             (.!=), (.:), (.:?))
import           Data.Pool                  (Pool, createPool)
import           Data.Time                  (NominalDiffTime)
import           Database.PostgreSQL.Simple (ConnectInfo (..), Connection,
                                             close, connect, defaultConnectInfo)
import           GHC.Word                   (Word16)

data PSQL = PSQL
    { PSQL -> String
psqlDBName           :: String
    , PSQL -> String
psqlHost             :: String
    , PSQL -> Word16
psqlPort             :: Word16
    , PSQL -> String
psqlUser             :: String
    , PSQL -> String
psqlPass             :: String
    , PSQL -> Int
psqlPoolNumStrips    :: Int
    -- ^ The number of stripes (distinct sub-pools) to maintain.
    , PSQL -> NominalDiffTime
psqlPoolIdleTime     :: NominalDiffTime
    -- ^ Amount of time for which an unused resource is kept alive.
    , PSQL -> Int
psqlPoolMaxResources :: Int
    -- ^ Maximum number of resources to maintain per stripe.  The
    , PSQL -> Int
psqlHaxlNumThreads   :: Int
    -- numThreads of fetch async for haxl
    }
    deriving (Int -> PSQL -> ShowS
[PSQL] -> ShowS
PSQL -> String
(Int -> PSQL -> ShowS)
-> (PSQL -> String) -> ([PSQL] -> ShowS) -> Show PSQL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PSQL] -> ShowS
$cshowList :: [PSQL] -> ShowS
show :: PSQL -> String
$cshow :: PSQL -> String
showsPrec :: Int -> PSQL -> ShowS
$cshowsPrec :: Int -> PSQL -> ShowS
Show)

instance FromJSON PSQL where
  parseJSON :: Value -> Parser PSQL
parseJSON = String -> (Object -> Parser PSQL) -> Value -> Parser PSQL
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "PSQL" ((Object -> Parser PSQL) -> Value -> Parser PSQL)
-> (Object -> Parser PSQL) -> Value -> Parser PSQL
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
    String
psqlDBName           <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.:  "db"
    String
psqlHost             <- Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "host"         Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= "127.0.0.1"
    Word16
psqlPort             <- Object
o Object -> Text -> Parser (Maybe Word16)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "port"         Parser (Maybe Word16) -> Word16 -> Parser Word16
forall a. Parser (Maybe a) -> a -> Parser a
.!= 5432
    String
psqlUser             <- Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "user"         Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= "postgre"
    String
psqlPass             <- Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "pass"         Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= ""
    Int
psqlPoolNumStrips    <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "numStripes"   Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= 1
    NominalDiffTime
psqlPoolIdleTime     <- Object
o Object -> Text -> Parser (Maybe NominalDiffTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "idleTime"     Parser (Maybe NominalDiffTime)
-> NominalDiffTime -> Parser NominalDiffTime
forall a. Parser (Maybe a) -> a -> Parser a
.!= 0.5
    Int
psqlPoolMaxResources <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "maxResources" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= 1
    Int
psqlHaxlNumThreads   <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "numThreads"   Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= 1
    PSQL -> Parser PSQL
forall (m :: * -> *) a. Monad m => a -> m a
return PSQL :: String
-> String
-> Word16
-> String
-> String
-> Int
-> NominalDiffTime
-> Int
-> Int
-> PSQL
PSQL{..}

genPSQLPool :: PSQL -> IO (Pool Connection)
genPSQLPool :: PSQL -> IO (Pool Connection)
genPSQLPool conf :: PSQL
conf = IO Connection
-> (Connection -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (Pool Connection)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
createPool IO Connection
conn Connection -> IO ()
close Int
numStripes NominalDiffTime
idleTime Int
maxResources
  where conn :: IO Connection
conn = ConnectInfo -> IO Connection
connect ConnectInfo
defaultConnectInfo
                  { connectDatabase :: String
connectDatabase = String
dbName
                  , connectHost :: String
connectHost     = String
dbHost
                  , connectPort :: Word16
connectPort     = Word16
dbPort
                  , connectUser :: String
connectUser     = String
dbUser
                  , connectPassword :: String
connectPassword = String
dbPass
                  }

        dbName :: String
dbName       = PSQL -> String
psqlDBName PSQL
conf
        dbHost :: String
dbHost       = PSQL -> String
psqlHost   PSQL
conf
        dbPort :: Word16
dbPort       = PSQL -> Word16
psqlPort   PSQL
conf
        dbUser :: String
dbUser       = PSQL -> String
psqlUser   PSQL
conf
        dbPass :: String
dbPass       = PSQL -> String
psqlPass   PSQL
conf

        numStripes :: Int
numStripes   = PSQL -> Int
psqlPoolNumStrips    PSQL
conf
        idleTime :: NominalDiffTime
idleTime     = PSQL -> NominalDiffTime
psqlPoolIdleTime     PSQL
conf
        maxResources :: Int
maxResources = PSQL -> Int
psqlPoolMaxResources PSQL
conf