hasql-pool 1.3.0.4 → 1.3.0.5

raw patch · 16 files changed

+102/−30 lines, 16 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +22/−15
• hasql-pool.cabal +1/−1
• src/integration-tests/Helpers/Hooks.hs +1/−1
• src/integration-tests/Helpers/Scripts.hs +34/−1
• src/integration-tests/Specs/BySubject/Config/AgingTimeoutSpec.hs +1/−1
• src/integration-tests/Specs/BySubject/Config/IdlenessTimeoutSpec.hs +16/−1
• src/integration-tests/Specs/BySubject/Config/InitSessionSpec.hs +17/−1
• src/integration-tests/Specs/BySubject/Helpers/Sessions/CountConnectionsSpec.hs +1/−1
• src/integration-tests/Specs/BySubject/Helpers/Sessions/GetSettingSpec.hs +1/−1
• src/integration-tests/Specs/BySubject/ReleaseSpec.hs +1/−1
• src/integration-tests/Specs/BySubject/SpecHook.hs +1/−1
• src/integration-tests/Specs/BySubject/UsageError/AcquisitionTimeoutSpec.hs +1/−1
• src/integration-tests/Specs/BySubject/UsageError/SessionSpec.hs +1/−1
• src/integration-tests/Specs/BySubject/UseSpec.hs +1/−1
• src/library/exposed/Hasql/Pool.hs +2/−1
• src/library/other/Hasql/Pool/Prelude.hs +1/−1

@@ -1,27 +1,34 @@-# 1.3+# v1.3.0.5 +## Fixes++- Fix pool capacity leak when `initSession` fails (#56)+- Fix background reaper never passively evicting idle connections: it used the connection-lifetime timeout instead of the idleness timeout when checking for idle connections++# v1.3+ - Adapt to the new settings model of `hasql-1.9` -# 1.2+# v1.2  - Migrated to `hasql-1.7` - Changed references to `QueryError` in observations to `SessionError` -# 1.1+# v1.1  - `ReadyForUseConnectionStatus` got extended with the `ConnectionReadyForUseReason` details. - `initSession` setting added. -# 1+# v1  - Optional observability event stream added. Provides a flexible mechanism for monitoring the healthiness of the pool via logs and metrics. - Configuration got isolated into a DSL, which will allow to provide new configurations without breaking backward compatibility. -# 0.10.1+# v0.10.1  - Avoid releasing connections on exceptions thrown in session -# 0.9+# v0.9  - Maximal lifetime added for connections. Allows to refresh the connections in time cleaning up the resources. @@ -30,19 +37,19 @@ - The acquisition timeout is now non-optional. - Moved to `DiffTime` for timeouts. -# 0.8.0.7+# v0.8.0.7  Fix excessive connections during releases due to race conditions. -# 0.8.0.5+# v0.8.0.5  Fix connections not returning to the pool on exceptions. -# 0.8.0.2+# v0.8.0.2  Fixed Windows build. -# 0.8+# v0.8  `release` became reusable. You can use it to destroy the whole pool (same as before), but now also you can use it to reset the connections. @@ -54,19 +61,19 @@ - `acquire` extended with the acquisition timeout parameter - `acquireDynamically` extended with the acquisition timeout parameter -# 0.7.2+# v0.7.2  Added support for dynamic connection configuration ([issue #11](https://github.com/nikita-volkov/hasql-pool/issues/11)). -# 0.7.1.2+# v0.7.1.2  Fixed connections not being released if they were in use during the call to `release`. -# 0.7.1+# v0.7.1  Added `Exception` for `UsageError`. -# 0.7+# v0.7  Simplified the implementation a lot by removing the notion of timeout. @@ -74,7 +81,7 @@ - Removed the `Settings` type - Changed the signature of `acquire` -# 0.6+# v0.6  Moved away from "resource-pool" and fixed the handling of lost connections. 

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-pool-version: 1.3.0.4+version: 1.3.0.5 category: Hasql, Database, PostgreSQL synopsis: Pool of connections for Hasql homepage: https://github.com/nikita-volkov/hasql-pool

@@ -2,8 +2,8 @@ module Helpers.Hooks where  import Data.Bool-import TestcontainersPostgresql qualified import Prelude hiding (Handler)+import TestcontainersPostgresql qualified  -- | Testing action in the scope of the host name and port of a running fresh isolated postgres server. type Handler = (Text, Word16) -> IO ()

@@ -5,9 +5,10 @@ import Hasql.Connection.Setting.Connection.Param qualified as Connection.Setting.Connection.Param import Hasql.Pool qualified as Pool import Hasql.Pool.Config qualified as Config+import Hasql.Session qualified as Session+import Prelude import System.Random.Stateful qualified as Random import TextBuilder qualified-import Prelude  -- | -- Parameters provided by the scope.@@ -45,6 +46,38 @@   -- Generate app name   appName <- generateName "hasql-pool-test-"   onTaggedPool poolSize acqTimeout maxLifetime maxIdletime appName (host, port) (cont appName)++onTaggedPoolWithInitSession :: Int -> DiffTime -> DiffTime -> DiffTime -> Session.Session () -> Text -> ScopeParams -> (Pool.Pool -> IO ()) -> IO ()+onTaggedPoolWithInitSession poolSize acqTimeout maxLifetime maxIdletime initSession appName (host, port) =+  bracket+    ( Pool.acquire+        ( Config.settings+            [ Config.size poolSize,+              Config.acquisitionTimeout acqTimeout,+              Config.agingTimeout maxLifetime,+              Config.idlenessTimeout maxIdletime,+              Config.initSession initSession,+              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+                        ]+                    )+                ]+            ]+        )+    )+    Pool.release++onAutotaggedPoolWithInitSession :: Int -> DiffTime -> DiffTime -> DiffTime -> Session.Session () -> ScopeParams -> (Text -> Pool.Pool -> IO ()) -> IO ()+onAutotaggedPoolWithInitSession poolSize acqTimeout maxLifetime maxIdletime initSession (host, port) cont = do+  appName <- generateName "hasql-pool-test-"+  onTaggedPoolWithInitSession poolSize acqTimeout maxLifetime maxIdletime initSession appName (host, port) (cont appName)  onDefaultTaggedPool :: ScopeParams -> (Text -> Pool.Pool -> IO ()) -> IO () onDefaultTaggedPool =

@@ -3,8 +3,8 @@ import Hasql.Pool import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions-import Test.Hspec import Prelude+import Test.Hspec  spec :: SpecWith Scripts.ScopeParams spec = do

@@ -3,8 +3,8 @@ import Hasql.Pool import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions-import Test.Hspec import Prelude+import Test.Hspec  spec :: SpecWith Scripts.ScopeParams spec = do@@ -27,3 +27,18 @@       threadDelay 1_000_000 -- 1s       res4 <- use pool $ Sessions.getSetting varName       res4 `shouldBe` Right Nothing++  it "Passively times out idle connections" \scopeParams -> do+    -- 0.5s connection idle time, large lifetime, so only idleness can explain a passive close.+    Scripts.onAutotaggedPool 3 10 1_800 1_800 scopeParams \_appName1 pool1 -> do+      Scripts.onAutotaggedPool 3 10 1_800 0.5 scopeParams \appName2 pool2 -> do+        res <- use pool2 $ Sessions.selectOne+        res `shouldBe` Right 1+        res2 <- use pool1 $ Sessions.countConnections appName2+        res2 `shouldBe` Right 1+        -- Give the background reaper (1s tick) a chance to passively evict+        -- the now-idle connection, without ever calling `use pool2` again+        -- (which would trigger the separate active idleness check).+        threadDelay 1_500_000 -- 1.5s+        res3 <- use pool1 $ Sessions.countConnections appName2+        res3 `shouldBe` Right 0

@@ -3,8 +3,8 @@ import Hasql.Pool import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions-import Test.Hspec import Prelude+import Test.Hspec  spec :: SpecWith Scripts.ScopeParams spec = do@@ -41,3 +41,19 @@       res <- use pool do         Sessions.getSetting varName       shouldBe res (Right (Just "1"))++  -- https://github.com/nikita-volkov/hasql-pool/issues/56+  it "Does not exhaust the pool capacity when it fails" \scopeParams -> do+    -- Pool of size 1 whose init session always fails, with a short+    -- acquisition timeout so that a leaked capacity slot shows up as+    -- an AcquisitionTimeoutUsageError instead of hanging the test.+    Scripts.onAutotaggedPoolWithInitSession 1 1 60 60 Sessions.badQuery scopeParams \_ pool -> do+      res1 <- use pool Sessions.selectOne+      res1 `shouldSatisfy` \case+        Left (SessionUsageError _) -> True+        _ -> False++      res2 <- use pool Sessions.selectOne+      res2 `shouldSatisfy` \case+        Left (SessionUsageError _) -> True+        _ -> False

@@ -3,8 +3,8 @@ import Hasql.Pool import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions-import Test.Hspec import Prelude+import Test.Hspec  spec :: SpecWith Scripts.ScopeParams spec = do

@@ -3,8 +3,8 @@ import Hasql.Pool import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions-import Test.Hspec import Prelude+import Test.Hspec  spec :: SpecWith Scripts.ScopeParams spec = do

@@ -3,8 +3,8 @@ import Hasql.Pool import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions-import Test.Hspec import Prelude+import Test.Hspec  spec :: SpecWith Scripts.ScopeParams spec = do

@@ -3,8 +3,8 @@  import Helpers.Hooks qualified as Hooks import Helpers.Scripts qualified as Scripts-import Test.Hspec import Prelude+import Test.Hspec  hook :: SpecWith Scripts.ScopeParams -> Spec hook =

@@ -4,8 +4,8 @@ import Hasql.Pool import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions-import Test.Hspec import Prelude+import Test.Hspec  spec :: SpecWith Scripts.ScopeParams spec = do

@@ -4,8 +4,8 @@ import Hasql.Session qualified as Session import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions-import Test.Hspec import Prelude+import Test.Hspec  spec :: SpecWith Scripts.ScopeParams spec = do

@@ -3,8 +3,8 @@ import Hasql.Pool import Helpers.Scripts qualified as Scripts import Helpers.Sessions qualified as Sessions-import Test.Hspec import Prelude+import Test.Hspec  spec :: SpecWith Scripts.ScopeParams spec = do

@@ -86,7 +86,7 @@     join . atomically $ do       entries <- flushTQueue connectionQueue       let (agedEntries, unagedEntries) = partition (entryIsAged agingTimeoutNanos now) entries-          (idleEntries, liveEntries) = partition (entryIsIdle agingTimeoutNanos now) unagedEntries+          (idleEntries, liveEntries) = partition (entryIsIdle maxIdletimeNanos now) unagedEntries       traverse_ (writeTQueue connectionQueue) liveEntries       return $ do         forM_ agedEntries $ \entry -> do@@ -177,6 +177,7 @@           Session.run poolInitSession connection >>= \case             Left err -> do               Connection.release connection+              atomically $ modifyTVar' poolCapacity succ               ErrorsDestruction.reset                 ( \details -> do                     poolObserver (ConnectionObservation id (TerminatedConnectionStatus (NetworkErrorConnectionTerminationReason (fmap (Text.decodeUtf8With Text.lenientDecode) details))))

@@ -61,6 +61,7 @@ import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import Numeric as Exports+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose)@@ -72,4 +73,3 @@ import Text.Printf as Exports (hPrintf, printf) import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports-import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))