hasql-pool 1.3.0.4 → 1.4

raw patch · 13 files changed

+116/−104 lines, 13 filesdep +postgresql-libpqdep ~hasqldep ~testcontainers-postgresql

Dependencies added: postgresql-libpq

Dependency ranges changed: hasql, testcontainers-postgresql

Files

• CHANGELOG.md +10/−0
• hasql-pool.cabal +5/−4
• src/integration-tests/Helpers/Hooks.hs +1/−1
• src/integration-tests/Helpers/Scripts.hs +10/−14
• src/integration-tests/Helpers/Sessions.hs +10/−9
• src/integration-tests/Specs/BySubject/UsageError/SessionSpec.hs +3/−4
• src/library/exposed/Hasql/Pool.hs +15/−11
• src/library/exposed/Hasql/Pool/Config/Defaults.hs +0/−49
• src/library/exposed/Hasql/Pool/Observation.hs +3/−3
• src/library/other/Hasql/Pool/Config/Config.hs +2/−2
• src/library/other/Hasql/Pool/Config/Defaults.hs +47/−0
• src/library/other/Hasql/Pool/Config/Setting.hs +7/−3
• src/library/other/Hasql/Pool/SessionErrorDestructors.hs +3/−4

@@ -1,3 +1,13 @@+# 1.4++- Migrated to `hasql-1.10`+- Updated connection settings API to use monoid-based `Settings` instead of list-based `[Setting]`+- Updated error types to use `Hasql.Errors` module instead of `Hasql.Session` and `Hasql.Connection`+- Changed session execution API from `Session.run session connection` to `Connection.use connection session`+- Error handling now uses `ConnectionSessionError` for connection-level issues instead of `ClientError`+- Updated statement construction to use `Statement.preparable` and `Statement.unpreparable` instead of direct constructor+- Hid the `Defaults` module from the public API+ # 1.3  - Adapt to the new settings model of `hasql-1.9`

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-pool-version: 1.3.0.4+version: 1.4 category: Hasql, Database, PostgreSQL synopsis: Pool of connections for Hasql homepage: https://github.com/nikita-volkov/hasql-pool@@ -75,12 +75,12 @@   exposed-modules:     Hasql.Pool     Hasql.Pool.Config-    Hasql.Pool.Config.Defaults     Hasql.Pool.Observation    -- cabal-gild: discover src/library/other   other-modules:     Hasql.Pool.Config.Config+    Hasql.Pool.Config.Defaults     Hasql.Pool.Config.Setting     Hasql.Pool.Prelude     Hasql.Pool.SessionErrorDestructors@@ -88,7 +88,7 @@   build-depends:     base >=4.11 && <5,     bytestring >=0.10 && <0.14,-    hasql >=1.9 && <1.10,+    hasql >=1.10 && <1.11,     stm >=2.5 && <3,     text >=1.2 && <3,     time >=1.9 && <2,@@ -123,8 +123,9 @@     hasql,     hasql-pool,     hspec >=2.6 && <3,+    postgresql-libpq >=0.10 && <0.12,     random >=1.2 && <2,     rerebase >=1.15 && <2,-    testcontainers-postgresql >=0.0.2 && <0.1,+    testcontainers-postgresql >=0.2 && <0.3,     text-builder >=1 && <1.1,     tuple ^>=0.3.0.2,

@@ -13,7 +13,7 @@   TestcontainersPostgresql.run     TestcontainersPostgresql.Config       { forwardLogs = False,-        distro = TestcontainersPostgresql.Distro17,+        tagName = "postgres:17",         auth = TestcontainersPostgresql.TrustAuth       }     (\(host, portInt) -> handler (host, fromIntegral portInt))

@@ -1,8 +1,6 @@ module Helpers.Scripts where -import Hasql.Connection.Setting qualified as Connection.Setting-import Hasql.Connection.Setting.Connection qualified as Connection.Setting.Connection-import Hasql.Connection.Setting.Connection.Param qualified as Connection.Setting.Connection.Param+import Hasql.Connection.Settings qualified as Connection.Settings import Hasql.Pool qualified as Pool import Hasql.Pool.Config qualified as Config import System.Random.Stateful qualified as Random@@ -24,17 +22,14 @@               Config.agingTimeout maxLifetime,               Config.idlenessTimeout maxIdletime,               Config.staticConnectionSettings-                [ Connection.Setting.connection-                    ( Connection.Setting.Connection.params-                        [ Connection.Setting.Connection.Param.host host,-                          Connection.Setting.Connection.Param.port (fromIntegral port),-                          Connection.Setting.Connection.Param.user "postgres",-                          Connection.Setting.Connection.Param.password "",-                          Connection.Setting.Connection.Param.dbname "postgres",-                          Connection.Setting.Connection.Param.other "application_name" appName-                        ]-                    )-                ]+                ( mconcat+                    [ Connection.Settings.hostAndPort host (fromIntegral port),+                      Connection.Settings.user "postgres",+                      Connection.Settings.password "",+                      Connection.Settings.dbname "postgres",+                      Connection.Settings.applicationName appName+                    ]+                )             ]         )     )@@ -59,6 +54,7 @@     $ mconcat     $ [ TextBuilder.text prefix,         TextBuilder.decimal uniqueNum1,+        "-",         TextBuilder.decimal uniqueNum2       ] 

@@ -9,7 +9,7 @@ where  import Data.Tuple.All-import Hasql.Connection qualified as Connection+import Database.PostgreSQL.LibPQ qualified as Pq import Hasql.Decoders qualified as Decoders import Hasql.Encoders qualified as Encoders import Hasql.Session qualified as Session@@ -20,7 +20,7 @@ selectOne =   Session.statement () statement   where-    statement = Statement.Statement "SELECT 1" Encoders.noParams decoder True+    statement = Statement.preparable "SELECT 1::int8" Encoders.noParams decoder     decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8))  badQuery :: Session.Session ()@@ -28,19 +28,20 @@   Session.statement () statement   where     statement =-      Statement.Statement "zzz" Encoders.noParams Decoders.noResult True+      Statement.preparable "zzz" Encoders.noParams Decoders.noResult  closeConn :: Session.Session ()-closeConn = do-  conn <- ask-  liftIO $ Connection.release conn+closeConn =+  Session.onLibpqConnection \conn -> do+    Pq.finish conn+    pure (Right (), conn)  setSetting :: Text -> Text -> Session.Session () setSetting name value = do   Session.statement (name, value) statement   where     statement =-      Statement.Statement "SELECT set_config($1, $2, false)" encoder Decoders.noResult True+      Statement.preparable "SELECT set_config($1, $2, false)" encoder Decoders.noResult     encoder =       mconcat         [ sel1 >$< Encoders.param (Encoders.nonNullable Encoders.text),@@ -51,7 +52,7 @@ getSetting name = do   Session.statement name statement   where-    statement = Statement.Statement "SELECT current_setting($1, true)" encoder decoder True+    statement = Statement.preparable "SELECT current_setting($1, true)" encoder decoder     encoder = Encoders.param (Encoders.nonNullable Encoders.text)     decoder = Decoders.singleRow (Decoders.column (Decoders.nullable Decoders.text)) @@ -59,6 +60,6 @@ countConnections appName = do   Session.statement appName statement   where-    statement = Statement.Statement "SELECT count(*) FROM pg_stat_activity WHERE application_name = $1" encoder decoder True+    statement = Statement.preparable "SELECT count(*) FROM pg_stat_activity WHERE application_name = $1" encoder decoder     encoder = Encoders.param (Encoders.nonNullable Encoders.text)     decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8))

@@ -1,7 +1,6 @@ module Specs.BySubject.UsageError.SessionSpec where  import Hasql.Pool-import Hasql.Session qualified as Session import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions import Test.Hspec@@ -9,9 +8,9 @@  spec :: SpecWith Scripts.ScopeParams spec = do-  it "Simulation of connection error works" \scopeParams ->+  it "Bad SQL query triggers error" \scopeParams ->     Scripts.onAutotaggedPool 1 10 1_800 1_800 scopeParams \_ pool -> do-      res <- use pool $ Sessions.closeConn >> Sessions.selectOne+      res <- use pool Sessions.badQuery       shouldSatisfy res $ \case-        Left (SessionUsageError (Session.QueryError _ _ (Session.ClientError _))) -> True+        Left (SessionUsageError _) -> True         _ -> False

@@ -10,12 +10,11 @@   ) where -import Data.Text.Encoding qualified as Text-import Data.Text.Encoding.Error qualified as Text import Data.UUID.V4 qualified as Uuid import Hasql.Connection (Connection) import Hasql.Connection qualified as Connection-import Hasql.Connection.Setting qualified as Connection.Setting+import Hasql.Connection.Settings qualified as Connection.Settings+import Hasql.Errors qualified as Errors import Hasql.Pool.Config.Config qualified as Config import Hasql.Pool.Observation import Hasql.Pool.Prelude@@ -43,7 +42,7 @@   { -- | Pool size.     poolSize :: Int,     -- | Connection settings.-    poolFetchConnectionSettings :: IO [Connection.Setting.Setting],+    poolFetchConnectionSettings :: IO Connection.Settings.Settings,     -- | Acquisition timeout, in microseconds.     poolAcquisitionTimeout :: Int,     -- | Maximal connection lifetime, in nanoseconds.@@ -170,16 +169,21 @@       poolObserver (ConnectionObservation id ConnectingConnectionStatus)       Connection.acquire settings >>= \case         Left connErr -> do-          poolObserver (ConnectionObservation id (TerminatedConnectionStatus (NetworkErrorConnectionTerminationReason (fmap (Text.decodeUtf8With Text.lenientDecode) connErr))))+          let connErrText = case connErr of+                Errors.NetworkingConnectionError details -> Just details+                Errors.AuthenticationConnectionError details -> Just details+                Errors.CompatibilityConnectionError details -> Just details+                Errors.OtherConnectionError details -> if details == "" then Nothing else Just details+          poolObserver (ConnectionObservation id (TerminatedConnectionStatus (NetworkErrorConnectionTerminationReason connErrText)))           atomically $ modifyTVar' poolCapacity succ           return $ Left $ ConnectionUsageError connErr         Right connection -> do-          Session.run poolInitSession connection >>= \case+          Connection.use connection poolInitSession >>= \case             Left err -> do               Connection.release connection               ErrorsDestruction.reset                 ( \details -> do-                    poolObserver (ConnectionObservation id (TerminatedConnectionStatus (NetworkErrorConnectionTerminationReason (fmap (Text.decodeUtf8With Text.lenientDecode) details))))+                    poolObserver (ConnectionObservation id (TerminatedConnectionStatus (NetworkErrorConnectionTerminationReason (Just details))))                 )                 (poolObserver (ConnectionObservation id (TerminatedConnectionStatus (InitializationErrorTerminationReason err))))                 err@@ -206,7 +210,7 @@      onLiveConn reuseVar entry = do       poolObserver (ConnectionObservation (entryId entry) InUseConnectionStatus)-      sessRes <- try @SomeException (Session.run sess (entryConnection entry))+      sessRes <- try @SomeException (Connection.use (entryConnection entry) sess)        case sessRes of         Left exc -> do@@ -217,7 +221,7 @@             ( \details -> do                 Connection.release (entryConnection entry)                 atomically $ modifyTVar' poolCapacity succ-                poolObserver (ConnectionObservation (entryId entry) (TerminatedConnectionStatus (NetworkErrorConnectionTerminationReason (fmap (Text.decodeUtf8With Text.lenientDecode) details))))+                poolObserver (ConnectionObservation (entryId entry) (TerminatedConnectionStatus (NetworkErrorConnectionTerminationReason (Just details))))                 return $ Left $ SessionUsageError err             )             ( do@@ -244,9 +248,9 @@ -- | Union over all errors that 'use' can result in. data UsageError   = -- | Attempt to establish a connection failed.-    ConnectionUsageError Connection.ConnectionError+    ConnectionUsageError Errors.ConnectionError   | -- | Session execution failed.-    SessionUsageError Session.SessionError+    SessionUsageError Errors.SessionError   | -- | Timeout acquiring a connection.     AcquisitionTimeoutUsageError   deriving (Show, Eq)

@@ -1,49 +0,0 @@-module Hasql.Pool.Config.Defaults where--import Hasql.Connection.Setting qualified as Connection.Setting-import Hasql.Connection.Setting.Connection qualified as Connection.Setting.Connection-import Hasql.Pool.Observation (Observation)-import Hasql.Pool.Prelude-import Hasql.Session qualified as Session---- |--- 3 connections.-size :: Int-size = 3---- |--- 10 seconds.-acquisitionTimeout :: DiffTime-acquisitionTimeout = 10---- |--- 1 day.-agingTimeout :: DiffTime-agingTimeout = 60 * 60 * 24---- |--- 10 minutes.-idlenessTimeout :: DiffTime-idlenessTimeout = 60 * 10---- |--- > "postgresql://postgres:postgres@localhost:5432/postgres"-staticConnectionSettings :: [Connection.Setting.Setting]-staticConnectionSettings =-  [ Connection.Setting.connection (Connection.Setting.Connection.string "postgresql://postgres:postgres@localhost:5432/postgres")-  ]---- |--- > pure "postgresql://postgres:postgres@localhost:5432/postgres"-dynamicConnectionSettings :: IO [Connection.Setting.Setting]-dynamicConnectionSettings = pure staticConnectionSettings---- |--- > const (pure ())-observationHandler :: Observation -> IO ()-observationHandler = const (pure ())---- |--- > pure ()-initSession :: Session.Session ()-initSession = pure ()

@@ -4,8 +4,8 @@ -- Specific interpreters are encouraged to be created as extension libraries. module Hasql.Pool.Observation where +import Hasql.Errors qualified as Errors import Hasql.Pool.Prelude-import Hasql.Session qualified as Session  -- | An observation of a change of the state of a pool. data Observation@@ -40,7 +40,7 @@   = -- | Connection just got established.     EstablishedConnectionReadyForUseReason   | -- | Session execution ended with a failure that does not require a connection reset.-    SessionFailedConnectionReadyForUseReason Session.SessionError+    SessionFailedConnectionReadyForUseReason Errors.SessionError   | -- | Session execution ended with success.     SessionSucceededConnectionReadyForUseReason   deriving (Show, Eq)@@ -56,5 +56,5 @@   | -- | User has invoked the 'Hasql.Pool.release' procedure.     ReleaseConnectionTerminationReason   | -- | Initialization session failure.-    InitializationErrorTerminationReason Session.SessionError+    InitializationErrorTerminationReason Errors.SessionError   deriving (Show, Eq)

@@ -1,6 +1,6 @@ module Hasql.Pool.Config.Config where -import Hasql.Connection.Setting qualified as Connection.Setting+import Hasql.Connection.Settings qualified as Connection.Settings import Hasql.Pool.Config.Defaults qualified as Defaults import Hasql.Pool.Observation (Observation) import Hasql.Pool.Prelude@@ -12,7 +12,7 @@     acquisitionTimeout :: DiffTime,     agingTimeout :: DiffTime,     idlenessTimeout :: DiffTime,-    connectionSettingsProvider :: IO [Connection.Setting.Setting],+    connectionSettingsProvider :: IO Connection.Settings.Settings,     observationHandler :: Observation -> IO (),     initSession :: Session.Session ()   }

@@ -0,0 +1,47 @@+module Hasql.Pool.Config.Defaults where++import Hasql.Connection.Settings qualified as Connection.Settings+import Hasql.Pool.Observation (Observation)+import Hasql.Pool.Prelude+import Hasql.Session qualified as Session++-- |+-- 3 connections.+size :: Int+size = 3++-- |+-- 10 seconds.+acquisitionTimeout :: DiffTime+acquisitionTimeout = 10++-- |+-- 1 day.+agingTimeout :: DiffTime+agingTimeout = 60 * 60 * 24++-- |+-- 10 minutes.+idlenessTimeout :: DiffTime+idlenessTimeout = 60 * 10++-- |+-- > "postgresql://postgres:postgres@localhost:5432/postgres"+staticConnectionSettings :: Connection.Settings.Settings+staticConnectionSettings =+  "postgresql://postgres:postgres@localhost:5432/postgres"++-- |+-- > pure "postgresql://postgres:postgres@localhost:5432/postgres"+dynamicConnectionSettings :: IO Connection.Settings.Settings+dynamicConnectionSettings = pure staticConnectionSettings++-- |+-- > const (pure ())+observationHandler :: Observation -> IO ()+observationHandler = const (pure ())++-- |+-- > pure ()+initSession :: Session.Session ()+initSession = pure ()

@@ -1,6 +1,6 @@ module Hasql.Pool.Config.Setting where -import Hasql.Connection.Setting qualified as Connection.Setting+import Hasql.Connection.Settings qualified as Connection.Settings import Hasql.Pool.Config.Config (Config) import Hasql.Pool.Config.Config qualified as Config import Hasql.Pool.Observation (Observation)@@ -54,7 +54,7 @@ -- By default it is: -- -- > "postgresql://postgres:postgres@localhost:5432/postgres"-staticConnectionSettings :: [Connection.Setting.Setting] -> Setting+staticConnectionSettings :: Connection.Settings.Settings -> Setting staticConnectionSettings x =   Setting (\config -> config {Config.connectionSettingsProvider = pure x}) @@ -66,7 +66,7 @@ -- By default it is: -- -- > pure "postgresql://postgres:postgres@localhost:5432/postgres"-dynamicConnectionSettings :: IO [Connection.Setting.Setting] -> Setting+dynamicConnectionSettings :: IO Connection.Settings.Settings -> Setting dynamicConnectionSettings x =   Setting (\config -> config {Config.connectionSettingsProvider = x}) @@ -88,6 +88,10 @@ -- -- Gets executed on every connection upon acquisition. -- Lets you specify the connection-wide settings.+--+-- E.g., you can set the search path for all the sessions executed by the pool by executing the following:+--+-- > initSession (Session.sql "SET search_path TO schema1, schema2, public;") initSession :: Session.Session () -> Setting initSession x =   Setting (\config -> config {Config.initSession = x})

@@ -1,10 +1,9 @@ module Hasql.Pool.SessionErrorDestructors where +import Hasql.Errors qualified as Errors import Hasql.Pool.Prelude-import Hasql.Session qualified as Session -reset :: (Maybe ByteString -> x) -> x -> Session.SessionError -> x+reset :: (Text -> x) -> x -> Errors.SessionError -> x reset onReset onNoReset = \case-  Session.QueryError _ _ (Session.ClientError details) -> onReset details-  Session.PipelineError (Session.ClientError details) -> onReset details+  Errors.ConnectionSessionError details -> onReset details   _ -> onNoReset