module Postgres.Settings ( Settings ( Settings, pgConnection, pgPool, pgQueryTimeout ), ConnectionSettings ( ConnectionSettings, pgDatabase, pgUser, pgHost, pgPassword, pgPort ), PoolSettings ( PoolSettings, pgPoolStripes, pgPoolMaxIdleTime, pgPoolSize ), decoder, decoderWithPrefix, PgDatabase (PgDatabase, unPgDatabase), PgUser (PgUser, unPgUser), PgHost (PgHost, unPgHost), PgPassword (PgPassword, unPgPassword), PgPort (PgPort, unPgPort), PgPoolStripes (PgPoolStripes, unPgPoolStripes), PgPoolMaxIdleTime (PgPoolMaxIdleTime, unPgPoolMaxIdleTime), PgPoolSize (PgPoolSize, unPgPoolSize), defaultSettings, toPGDatabase, ) where import qualified Data.ByteString.Char8 import qualified Data.Text.Encoding import qualified Data.Time import Database.PostgreSQL.Typed ( PGDatabase, defaultPGDatabase, pgDBAddr, pgDBName, pgDBParams, pgDBPass, pgDBUser, ) import qualified Environment import qualified Log import Network.Socket (SockAddr (SockAddrUnix)) import qualified Postgres.Time as Time import System.FilePath (()) import Prelude (Either (Left, Right), pure, realToFrac, round, show) -- | Postgres connection details. You can use 'decoder' to create one of these. data Settings = Settings { pgConnection :: ConnectionSettings, pgPool :: PoolSettings, pgQueryTimeout :: Time.Interval } deriving (Eq, Show) defaultSettings :: Settings defaultSettings = Settings { pgConnection = ConnectionSettings { pgDatabase = PgDatabase "postgres", pgUser = PgUser "postgres", pgHost = PgHost "localhost", pgPassword = PgPassword (Log.mkSecret ""), pgPort = PgPort 5432 }, pgPool = PoolSettings { pgPoolSize = -- Connections in the pool are allocated on demand, so we won't -- create all these connections unless the application can make use -- of them. PgPoolSize 500, pgPoolMaxIdleTime = PgPoolMaxIdleTime (toNominalDiffTime 3600), pgPoolStripes = PgPoolStripes 1 }, pgQueryTimeout = Time.fromSeconds 5 } data ConnectionSettings = ConnectionSettings { pgDatabase :: PgDatabase, pgUser :: PgUser, pgHost :: PgHost, pgPassword :: PgPassword, pgPort :: PgPort } deriving (Eq, Show) data PoolSettings = PoolSettings { pgPoolSize :: PgPoolSize, pgPoolMaxIdleTime :: PgPoolMaxIdleTime, pgPoolStripes :: PgPoolStripes } deriving (Eq, Show) -- | Create a 'Settings' value by reading settings from environment values. -- -- [@environment variable@] PGHOST -- [@default value@] localhost -- -- [@environment variable@] PGPORT -- [@default value@] 5432 -- -- [@environment variable@] PGDATABASE -- [@default value@] postgresql -- -- [@environment variable@] PGUSER -- [@default value@] postgresql -- -- [@environment variable@] PGPASSWORD -- [@default value@] -- -- [@environment variable@] PG_POOL_SIZE -- [@default value@] 500 -- -- [@environment variable@] PG_POOL_STRIPES -- [@default value@] 1 -- -- [@environment variable@] PG_POOL_MAX_IDLE_TIME -- [@default value@] 3600 -- -- [@environment variable@] PG_QUERY_TIMEOUT_SECONDS -- [@default value@] 5 decoder :: Environment.Decoder Settings decoder = decoderWithPrefix "" decoderWithPrefix :: Text -> Environment.Decoder Settings decoderWithPrefix prefix = pure Settings |> andMap (connectionDecoder prefix) |> andMap poolDecoder |> andMap queryTimeoutDecoder connectionDecoder :: Text -> Environment.Decoder ConnectionSettings connectionDecoder prefix = pure ConnectionSettings |> andMap (pgDatabaseDecoder prefix) |> andMap (pgUserDecoder prefix) |> andMap (pgHostDecoder prefix) |> andMap (pgPasswordDecoder prefix) |> andMap (pgPortDecoder prefix) poolDecoder :: Environment.Decoder PoolSettings poolDecoder = pure PoolSettings |> andMap pgPoolSizeDecoder |> andMap pgPoolMaxIdleTimeDecoder |> andMap pgPoolStripesDecoder newtype PgPort = PgPort {unPgPort :: Int} deriving (Eq, Show) pgPortDecoder :: Text -> Environment.Decoder PgPort pgPortDecoder prefix = Environment.variable Environment.Variable { Environment.name = prefix ++ "PGPORT", Environment.description = "The port postgres is running on.", Environment.defaultValue = defaultSettings |> pgConnection |> pgPort |> unPgPort |> show |> Text.fromList } (Environment.int |> map PgPort) newtype PgPassword = PgPassword {unPgPassword :: Log.Secret Text} deriving (Eq, Show) pgPasswordDecoder :: Text -> Environment.Decoder PgPassword pgPasswordDecoder prefix = Environment.variable Environment.Variable { Environment.name = prefix ++ "PGPASSWORD", Environment.description = "The postgres user password.", Environment.defaultValue = defaultSettings |> pgConnection |> pgPassword |> unPgPassword |> Log.unSecret } (Environment.secret Environment.text |> map PgPassword) newtype PgHost = PgHost {unPgHost :: Text} deriving (Eq, Show) pgHostDecoder :: Text -> Environment.Decoder PgHost pgHostDecoder prefix = Environment.variable Environment.Variable { Environment.name = prefix ++ "PGHOST", Environment.description = "The hostname of the postgres server to connect to.", Environment.defaultValue = defaultSettings |> pgConnection |> pgHost |> unPgHost } (Environment.text |> map PgHost) newtype PgUser = PgUser {unPgUser :: Text} deriving (Eq, Show) pgUserDecoder :: Text -> Environment.Decoder PgUser pgUserDecoder prefix = Environment.variable Environment.Variable { Environment.name = prefix ++ "PGUSER", Environment.description = "The postgres user to connect with.", Environment.defaultValue = defaultSettings |> pgConnection |> pgUser |> unPgUser } (Environment.text |> map PgUser) newtype PgDatabase = PgDatabase {unPgDatabase :: Text} deriving (Eq, Show) pgDatabaseDecoder :: Text -> Environment.Decoder PgDatabase pgDatabaseDecoder prefix = Environment.variable Environment.Variable { Environment.name = prefix ++ "PGDATABASE", Environment.description = "The postgres database to connect to.", Environment.defaultValue = defaultSettings |> pgConnection |> pgDatabase |> unPgDatabase } (map PgDatabase Environment.text) newtype PgPoolStripes = PgPoolStripes {unPgPoolStripes :: Int} deriving (Eq, Show) pgPoolStripesDecoder :: Environment.Decoder PgPoolStripes pgPoolStripesDecoder = Environment.variable Environment.Variable { Environment.name = "PG_POOL_STRIPES", Environment.description = "The amount of sub-connection pools to create. Best refer to the resource-pool package for more info on this one. 1 is a good value for most applications.", Environment.defaultValue = defaultSettings |> pgPool |> pgPoolStripes |> unPgPoolStripes |> show |> Text.fromList } (Environment.int |> map PgPoolStripes) newtype PgPoolMaxIdleTime = PgPoolMaxIdleTime {unPgPoolMaxIdleTime :: Data.Time.NominalDiffTime} deriving (Eq, Show) pgPoolMaxIdleTimeDecoder :: Environment.Decoder PgPoolMaxIdleTime pgPoolMaxIdleTimeDecoder = Environment.variable Environment.Variable { Environment.name = "PG_POOL_MAX_IDLE_TIME", Environment.description = "The maximum time a database connection will be able remain idle until it is closed.", Environment.defaultValue = defaultSettings |> pgPool |> pgPoolMaxIdleTime |> unPgPoolMaxIdleTime |> fromNominalDiffTime |> show |> Text.fromList } (Environment.int |> map (PgPoolMaxIdleTime << toNominalDiffTime)) toNominalDiffTime :: Int -> Data.Time.NominalDiffTime toNominalDiffTime = realToFrac fromNominalDiffTime :: Data.Time.NominalDiffTime -> Int fromNominalDiffTime = Prelude.round newtype PgPoolSize = PgPoolSize {unPgPoolSize :: Int} deriving (Eq, Show) pgPoolSizeDecoder :: Environment.Decoder PgPoolSize pgPoolSizeDecoder = Environment.variable Environment.Variable { Environment.name = "PG_POOL_SIZE", Environment.description = "The size of the postgres connection pool. This is the maximum amount of parallel database connections the app will be able to use.", Environment.defaultValue = defaultSettings |> pgPool |> pgPoolSize |> unPgPoolSize |> show |> Text.fromList } (Environment.int |> map PgPoolSize) toPGDatabase :: Settings -> PGDatabase toPGDatabase Settings { pgConnection = ConnectionSettings { pgDatabase, pgUser, pgHost, pgPassword, pgPort }, pgQueryTimeout } = defaultPGDatabase { pgDBName = Data.Text.Encoding.encodeUtf8 (unPgDatabase pgDatabase), pgDBUser = Data.Text.Encoding.encodeUtf8 (unPgUser pgUser), pgDBPass = Data.Text.Encoding.encodeUtf8 <| Log.unSecret (unPgPassword pgPassword), pgDBParams = if Time.milliseconds pgQueryTimeout > 0 then [ -- We configure Postgres to automatically kill queries when they run -- too long. That should offer some protection against queries -- locking up the database. -- https://www.postgresql.org/docs/9.4/runtime-config-client.html ("statement_timeout", pgQueryTimeout |> Time.milliseconds |> floor |> show |> Data.ByteString.Char8.pack) ] else [], pgDBAddr = -- The rule that PostgreSQL/libpq applies to `host`: -- -- If this begins with a slash, it specifies Unix-domain -- communication rather than TCP/IP communication; the value is the -- name of the directory in which the socket file is stored -- -- https://www.postgresql.org/docs/9.6/libpq-connect.html#LIBPQ-CONNECT-HOST if Text.startsWith "/" host then Text.toList host ".s.PGSQL." ++ show port |> SockAddrUnix |> Right else Left (Text.toList host, show port) } where host = unPgHost pgHost port = unPgPort pgPort queryTimeoutDecoder :: Environment.Decoder Time.Interval queryTimeoutDecoder = Environment.variable Environment.Variable { Environment.name = "PG_QUERY_TIMEOUT_SECONDS", Environment.description = "The maximum time a query can run before it is cancelled.", Environment.defaultValue = defaultSettings |> pgQueryTimeout |> Time.seconds |> show |> Text.fromList } (Environment.float |> map Time.fromSeconds)