Check whether connection succeeded and set encoding in connect

This commit is contained in:
Paul Brinkmeier 2025-07-20 02:48:14 +02:00
parent 2fddc958b9
commit 3379fa9df7
4 changed files with 25 additions and 9 deletions

View File

@ -5,6 +5,7 @@
module Database.PostgreSQL.Opium module Database.PostgreSQL.Opium
-- * Connection Management -- * Connection Management
( Connection ( Connection
, ConnectionError
, connect , connect
, close , close
-- * Queries -- * Queries
@ -40,7 +41,7 @@ import Database.PostgreSQL.LibPQ (Result)
import qualified Data.Text.Encoding as Encoding import qualified Data.Text.Encoding as Encoding
import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Database.PostgreSQL.LibPQ as LibPQ
import Database.PostgreSQL.Opium.Connection (Connection, connect, close, withRawConnection) import Database.PostgreSQL.Opium.Connection (Connection, ConnectionError, connect, close, withRawConnection)
import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..)) import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
import Database.PostgreSQL.Opium.FromField (FromField (..), RawField (..)) import Database.PostgreSQL.Opium.FromField (FromField (..), RawField (..))
import Database.PostgreSQL.Opium.FromRow (FromRow (..), ColumnTable) import Database.PostgreSQL.Opium.FromRow (FromRow (..), ColumnTable)

View File

@ -1,8 +1,10 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.PostgreSQL.Opium.Connection module Database.PostgreSQL.Opium.Connection
( Connection ( Connection
, ConnectionError
, unsafeWithRawConnection , unsafeWithRawConnection
, withRawConnection , withRawConnection
, connect , connect
@ -10,15 +12,21 @@ module Database.PostgreSQL.Opium.Connection
) where ) where
import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, withMVar) import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, withMVar)
import Data.ByteString (ByteString) import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Database.PostgreSQL.LibPQ (ConnStatus (..))
import GHC.Stack (HasCallStack) import GHC.Stack (HasCallStack)
import qualified Data.Text.Encoding as Encoding
import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Database.PostgreSQL.LibPQ as LibPQ
newtype Connection = Connection newtype Connection = Connection
{ rawConnection :: MVar (Maybe LibPQ.Connection) { rawConnection :: MVar (Maybe LibPQ.Connection)
} }
newtype ConnectionError = ConnectionError Text
deriving (Show)
withRawConnection withRawConnection
:: HasCallStack :: HasCallStack
=> (Maybe LibPQ.Connection -> IO a) => (Maybe LibPQ.Connection -> IO a)
@ -35,11 +43,18 @@ unsafeWithRawConnection f = withRawConnection $ \case
Nothing -> error "raw connection is missing! perhaps the connection was already closed." Nothing -> error "raw connection is missing! perhaps the connection was already closed."
Just rawConn -> f rawConn Just rawConn -> f rawConn
connect :: ByteString -> IO Connection connect :: Text -> IO (Either ConnectionError Connection)
connect connectionString = do connect connectionString = do
rawConn <- LibPQ.connectdb connectionString -- Appending the client_encoding setting overrides any previous setting in the connection string.
-- We set the client encoding here to make sure we can use it below for decoding connection
Connection <$> newMVar (Just rawConn) -- error messages.
rawConn <- LibPQ.connectdb $ Encoding.encodeUtf8 $ connectionString <> " client_encoding=UTF8"
status <- LibPQ.status rawConn
if status == ConnectionOk then
Right . Connection <$> newMVar (Just rawConn)
else do
rawError <- fromMaybe "" <$> LibPQ.errorMessage rawConn
pure $ Left $ ConnectionError $ Encoding.decodeUtf8Lenient rawError
close :: Connection -> IO () close :: Connection -> IO ()
close conn = modifyMVar_ conn.rawConnection $ \case close conn = modifyMVar_ conn.rawConnection $ \case

View File

@ -126,6 +126,7 @@ test-suite opium-test
base, base,
opium, opium,
bytestring, bytestring,
containers,
hspec, hspec,
postgresql-libpq, postgresql-libpq,
time, time,

View File

@ -8,7 +8,6 @@ import Test.Hspec (Spec, SpecWith, around)
import Text.Printf (printf) import Text.Printf (printf)
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
import qualified Database.PostgreSQL.Opium as Opium import qualified Database.PostgreSQL.Opium as Opium
@ -20,7 +19,7 @@ setupConnection = do
Just dbPort <- lookupEnv "DB_PORT" Just dbPort <- lookupEnv "DB_PORT"
let dsn = printf "host=localhost user=%s password=%s dbname=%s port=%s" dbUser dbPass dbName dbPort let dsn = printf "host=localhost user=%s password=%s dbname=%s port=%s" dbUser dbPass dbName dbPort
conn <- Opium.connect $ Encoding.encodeUtf8 $ Text.pack dsn Right conn <- Opium.connect $ Text.pack dsn
Right _ <- Opium.execute_ "DROP TABLE IF EXISTS person" conn Right _ <- Opium.execute_ "DROP TABLE IF EXISTS person" conn
Right _ <- Opium.execute_ "CREATE TABLE person (name TEXT NOT NULL, age INT NOT NULL, score DOUBLE PRECISION NOT NULL, motto TEXT)" conn Right _ <- Opium.execute_ "CREATE TABLE person (name TEXT NOT NULL, age INT NOT NULL, score DOUBLE PRECISION NOT NULL, motto TEXT)" conn