module Hasql.Postgres.Connector where
import Hasql.Postgres.Prelude hiding (Error)
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Builder as BB
import qualified Data.ByteString.Lazy.Builder.ASCII as BB
import qualified Data.ByteString.Lazy as BL
data Settings =
ParamSettings ByteString Word16 ByteString ByteString ByteString |
StringSettings ByteString
deriving (Show)
data Error =
BadStatus (Maybe ByteString) |
UnsupportedVersion Int
deriving (Show)
open :: Settings -> IO (Either Error PQ.Connection)
open s =
runEitherT $ do
c <- lift $ PQ.connectdb (settingsBS s)
do
s <- lift $ PQ.status c
when (s /= PQ.ConnectionOk) $ do
m <- lift $ PQ.errorMessage c
left $ BadStatus m
do
v <- lift $ PQ.serverVersion c
when (v < 80200) $ left $ UnsupportedVersion v
lift $ PQ.exec c $ BL.toStrict $ BB.toLazyByteString $ mconcat $ map (<> BB.char7 ';') $
[
BB.string7 "SET client_encoding = 'UTF8'",
BB.string7 "SET client_min_messages TO WARNING"
]
return c
settingsBS :: Settings -> ByteString
settingsBS =
\case
ParamSettings host port user password database ->
BL.toStrict $ BB.toLazyByteString $ mconcat $ intersperse (BB.char7 ' ') $ catMaybes $
[
mappend (BB.string7 "host=") . BB.byteString <$>
partial (not . B.null) host
,
mappend (BB.string7 "port=") . BB.word16Dec <$>
partial (/= 0) port
,
mappend (BB.string7 "user=") . BB.byteString <$>
partial (not . B.null) user
,
mappend (BB.string7 "password=") . BB.byteString <$>
partial (not . B.null) password
,
mappend (BB.string7 "dbname=") . BB.byteString <$>
partial (not . B.null) database
]
StringSettings x -> x