{-# 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
, PSQL -> NominalDiffTime
psqlPoolIdleTime :: NominalDiffTime
, PSQL -> Int
psqlPoolMaxResources :: Int
, PSQL -> Int
psqlHaxlNumThreads :: Int
}
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