hasql-pool 1.2.0.3 → 1.3

raw patch · 6 files changed

+53/−45 lines, 6 filesdep ~hasqlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hasql

API changes (from Hackage documentation)

Files

• hasql-pool.cabal +2/−2
• src/library/exposed/Hasql/Pool.hs +2/−1
• src/library/exposed/Hasql/Pool/Config/Defaults.hs +8/−5
• src/library/other/Hasql/Pool/Config/Config.hs +2/−2
• src/library/other/Hasql/Pool/Config/Setting.hs +3/−3
• src/test/Main.hs +36/−32

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-pool-version: 1.2.0.3+version: 1.3 category: Hasql, Database, PostgreSQL synopsis: Pool of connections for Hasql homepage: https://github.com/nikita-volkov/hasql-pool@@ -88,7 +88,7 @@   build-depends:     base >=4.11 && <5,     bytestring >=0.10 && <0.14,-    hasql >=1.7 && <1.9,+    hasql >=1.9 && <1.10,     stm >=2.5 && <3,     text >=1.2 && <3,     time >=1.9 && <2,

@@ -15,6 +15,7 @@ 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.Pool.Config.Config qualified as Config import Hasql.Pool.Observation import Hasql.Pool.Prelude@@ -42,7 +43,7 @@   { -- | Pool size.     poolSize :: Int,     -- | Connection settings.-    poolFetchConnectionSettings :: IO Connection.Settings,+    poolFetchConnectionSettings :: IO [Connection.Setting.Setting],     -- | Acquisition timeout, in microseconds.     poolAcquisitionTimeout :: Int,     -- | Maximal connection lifetime, in nanoseconds.

@@ -1,6 +1,7 @@ module Hasql.Pool.Config.Defaults where -import Hasql.Connection qualified as Connection+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@@ -27,13 +28,15 @@  -- | -- > "postgresql://postgres:postgres@localhost:5432/postgres"-staticConnectionSettings :: Connection.Settings-staticConnectionSettings = "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.Settings-dynamicConnectionSettings = pure "postgresql://postgres:postgres@localhost:5432/postgres"+dynamicConnectionSettings :: IO [Connection.Setting.Setting]+dynamicConnectionSettings = pure staticConnectionSettings  -- | -- > const (pure ())

@@ -1,6 +1,6 @@ module Hasql.Pool.Config.Config where -import Hasql.Connection qualified as Connection+import Hasql.Connection.Setting qualified as Connection.Setting 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.Settings,+    connectionSettingsProvider :: IO [Connection.Setting.Setting],     observationHandler :: Observation -> IO (),     initSession :: Session.Session ()   }

@@ -1,6 +1,6 @@ module Hasql.Pool.Config.Setting where -import Hasql.Connection qualified as Connection+import Hasql.Connection.Setting qualified as Connection.Setting import Hasql.Pool.Config.Config (Config) import Hasql.Pool.Config.Config qualified as Config import Hasql.Pool.Observation (Observation)@@ -56,7 +56,7 @@ -- By default it is: -- -- > "postgresql://postgres:postgres@localhost:5432/postgres"-staticConnectionSettings :: Connection.Settings -> Setting+staticConnectionSettings :: [Connection.Setting.Setting] -> Setting staticConnectionSettings x =   Setting (\config -> config {Config.connectionSettingsProvider = pure x}) @@ -70,7 +70,7 @@ -- By default it is: -- -- > pure "postgresql://postgres:postgres@localhost:5432/postgres"-dynamicConnectionSettings :: IO Connection.Settings -> Setting+dynamicConnectionSettings :: IO [Connection.Setting.Setting] -> Setting dynamicConnectionSettings x =   Setting (\config -> config {Config.connectionSettingsProvider = x}) 

@@ -1,9 +1,10 @@ module Main where  import Control.Concurrent.Async (race)-import Data.ByteString.Char8 qualified as B8 import Data.Text qualified as Text import Hasql.Connection qualified as Connection+import Hasql.Connection.Setting qualified as Connection.Setting+import Hasql.Connection.Setting.Connection qualified as Connection.Setting.Connection import Hasql.Decoders qualified as Decoders import Hasql.Encoders qualified as Encoders import Hasql.Pool@@ -17,8 +18,8 @@  main :: IO () main = do-  connectionSettings <- getConnectionSettings-  let withPool poolSize acqTimeout maxLifetime maxIdletime connectionSettings =+  connectionString <- getConnectionString+  let withPool poolSize acqTimeout maxLifetime maxIdletime connectionString =         bracket           ( acquire               ( Config.settings@@ -26,13 +27,16 @@                     Config.acquisitionTimeout acqTimeout,                     Config.agingTimeout maxLifetime,                     Config.idlenessTimeout maxIdletime,-                    Config.staticConnectionSettings connectionSettings+                    Config.staticConnectionSettings+                      [ Connection.Setting.connection+                          (Connection.Setting.Connection.string connectionString)+                      ]                   ]               )           )           release       withDefaultPool =-        withPool 3 10 1_800 1_800 connectionSettings+        withPool 3 10 1_800 1_800 connectionString    hspec . describe "" $ do     it "Releases a spot in the pool when there is a query error" $ withDefaultPool $ \pool -> do@@ -44,27 +48,27 @@         Left (SessionUsageError (Session.QueryError _ _ (Session.ClientError _))) -> True         _ -> False     it "Connection errors cause eviction of connection" $ withDefaultPool $ \pool -> do-      res <- use pool $ closeConnSession >> selectOneSession-      res <- use pool $ closeConnSession >> selectOneSession-      res <- use pool $ closeConnSession >> selectOneSession+      _ <- use pool $ closeConnSession >> selectOneSession+      _ <- use pool $ closeConnSession >> selectOneSession+      _ <- use pool $ closeConnSession >> selectOneSession       res <- use pool $ selectOneSession       shouldSatisfy res $ isRight     it "Connection gets returned to the pool after normal use" $ withDefaultPool $ \pool -> do-      res <- use pool $ selectOneSession-      res <- use pool $ selectOneSession-      res <- use pool $ selectOneSession-      res <- use pool $ selectOneSession+      _ <- use pool $ selectOneSession+      _ <- use pool $ selectOneSession+      _ <- use pool $ selectOneSession+      _ <- use pool $ selectOneSession       res <- use pool $ selectOneSession       shouldSatisfy res $ isRight     it "Connection gets returned to the pool after non-connection error" $ withDefaultPool $ \pool -> do-      res <- use pool $ badQuerySession-      res <- use pool $ badQuerySession-      res <- use pool $ badQuerySession-      res <- use pool $ badQuerySession+      _ <- use pool $ badQuerySession+      _ <- use pool $ badQuerySession+      _ <- use pool $ badQuerySession+      _ <- use pool $ badQuerySession       res <- use pool $ selectOneSession       shouldSatisfy res $ isRight     it "The pool remains usable after release" $ withDefaultPool $ \pool -> do-      res <- use pool $ selectOneSession+      _ <- use pool $ selectOneSession       release pool       res <- use pool $ selectOneSession       shouldSatisfy res $ isRight@@ -75,12 +79,12 @@         setSettingSession "testing.foo" "hello world"         getSettingSession "testing.foo"       res `shouldBe` Right (Just "hello world")-    it "Session variables stay set when a connection gets reused" $ withPool 1 10 1_800 1_800 connectionSettings $ \pool -> do+    it "Session variables stay set when a connection gets reused" $ withPool 1 10 1_800 1_800 connectionString $ \pool -> do       res <- use pool $ setSettingSession "testing.foo" "hello world"       res `shouldBe` Right ()       res2 <- use pool $ getSettingSession "testing.foo"       res2 `shouldBe` Right (Just "hello world")-    it "Releasing the pool resets session variables" $ withPool 1 10 1_800 1_800 connectionSettings $ \pool -> do+    it "Releasing the pool resets session variables" $ withPool 1 10 1_800 1_800 connectionString $ \pool -> do       res <- use pool $ setSettingSession "testing.foo" "hello world"       res `shouldBe` Right ()       release pool@@ -89,7 +93,7 @@     it "Times out connection acquisition"       $       -- 1ms timeout-      withPool 1 0.001 1_800 1_800 connectionSettings+      withPool 1 0.001 1_800 1_800 connectionString       $ \pool -> do         sleeping <- newEmptyMVar         t0 <- getCurrentTime@@ -111,7 +115,7 @@     it "Passively times out old connections (maxLifetime)"       $       -- 0.5s connection lifetime-      withPool 1 10 0.5 1_800 connectionSettings+      withPool 1 10 0.5 1_800 connectionString       $ \pool -> do         res <- use pool $ setSettingSession "testing.foo" "hello world"         res `shouldBe` Right ()@@ -121,14 +125,14 @@         res3 <- use pool $ getSettingSession "testing.foo"         res3 `shouldBe` Right Nothing     it "Counts active connections" $ do-      (taggedConnectionSettings, appName) <- tagConnection connectionSettings+      (taggedConnectionSettings, appName) <- tagConnection connectionString       withPool 3 10 1_800 1_800 taggedConnectionSettings $ \pool -> do         res <- use pool $ countConnectionsSession appName         res `shouldBe` Right 1      it "Actively times out old connections (maxLifetime)" $ do       withDefaultPool $ \countPool -> do-        (taggedConnectionSettings, appName) <- tagConnection connectionSettings+        (taggedConnectionSettings, appName) <- tagConnection connectionString         withPool 3 10 0.5 1_800 taggedConnectionSettings $ \limitedPool -> do           res <- use limitedPool $ selectOneSession           res `shouldBe` Right 1@@ -139,13 +143,13 @@           res3 `shouldBe` Right 0     it "Times out old connections (maxIdletime)" $ do       -- 0.5s connection idle time-      withPool 1 10 1_800 0.5 connectionSettings $ \pool -> do+      withPool 1 10 1_800 0.5 connectionString $ \pool -> do         res <- use pool $ setSettingSession "testing.foo" "hello world"         res `shouldBe` Right ()         res2 <- use pool $ getSettingSession "testing.foo"         res2 `shouldBe` Right (Just "hello world")         -- busy sleep, to keep connection alive-        forM_ [1 .. 10] $ \_ -> do+        forM_ [1 :: Int .. 10] $ \_ -> do           r <- use pool $ selectOneSession           r `shouldBe` Right 1           threadDelay 100_000 -- 0.1s@@ -156,9 +160,9 @@         res4 <- use pool $ getSettingSession "testing.foo"         res4 `shouldBe` Right Nothing -getConnectionSettings :: IO Connection.Settings-getConnectionSettings =-  B8.unwords+getConnectionString :: IO Text+getConnectionString =+  Text.unwords     . catMaybes     <$> sequence       [ setting "host" $ defaultEnv "POSTGRES_HOST" "localhost",@@ -168,17 +172,17 @@         setting "dbname" $ defaultEnv "POSTGRES_DBNAME" "postgres"       ]   where-    maybeEnv env = fmap B8.pack <$> System.Environment.lookupEnv env+    maybeEnv env = fmap Text.pack <$> System.Environment.lookupEnv env     defaultEnv env val = Just . fromMaybe val <$> maybeEnv env     setting label getEnv = do       val <- getEnv       return $ (\v -> label <> "=" <> v) <$> val -tagConnection :: Connection.Settings -> IO (Connection.Settings, Text)-tagConnection connectionSettings = do+tagConnection :: Text -> IO (Text, Text)+tagConnection connectionString = do   tag <- Random.uniformWord32 Random.globalStdGen   let appName = "hasql-pool-test-" <> show tag-  return (connectionSettings <> " application_name=" <> B8.pack appName, Text.pack appName)+  return (connectionString <> " application_name=" <> Text.pack appName, Text.pack appName)  selectOneSession :: Session.Session Int64 selectOneSession =