packages feed

servant-auth-token-0.4.7.0: example/persistent/src/Config.hs

module Config(
    ServerConfig(..)
  , readConfig
  , createPool
  ) where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger
import Data.Aeson
import Data.Monoid
import Data.Text
import Data.Text.Encoding
import Data.Yaml.Config

import Database.Persist.Postgresql

-- | Startup configuration of server
data ServerConfig = ServerConfig {
  -- | Server host name
  serverHost                 :: !Text
  -- | Server port number
, serverPort                 :: !Int
  -- | DB host
, serverDBHost               :: !Text
  -- | DB port
, serverDBPort               :: !Int
  -- | DB user
, serverDBUser               :: !Text
  -- | DB user password
, serverDBPass               :: !Text
  -- | DB database
, serverDBBase               :: !Text
  -- | DB pool size
, serverDBSize               :: !Int
}

instance FromJSON ServerConfig where
  parseJSON (Object o) = ServerConfig
    <$> o .: "host"
    <*> o .: "port"
    <*> o .: "db-host"
    <*> o .: "db-port"
    <*> o .: "db-user"
    <*> o .: "db-pass"
    <*> o .: "db-base"
    <*> o .: "db-size"
  parseJSON _ = mzero

readConfig :: MonadIO m => FilePath -> m ServerConfig
readConfig f = liftIO $ loadYamlSettings [f] [] useEnv

-- | Create connection pool to postgres
createPool :: ServerConfig -> IO ConnectionPool
createPool ServerConfig{..} = runStdoutLoggingT $ createPostgresqlPool constr serverDBSize
  where
    constr = encodeUtf8 $ "host=" <> serverDBHost <> " port=" <> (pack . show $ serverDBPort)
      <> " user=" <> serverDBUser <> " password=" <> serverDBPass <> " database=" <> serverDBBase