hasql-pool 1.0.1 → 1.1

raw patch · 9 files changed

+70/−16 lines, 9 filesbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• diagrams-output/observation-status-model.png binary
• hasql-pool.cabal +9/−4
• src/library/exposed/Hasql/Pool.hs +20/−9
• src/library/exposed/Hasql/Pool/Config.hs +1/−0
• src/library/exposed/Hasql/Pool/Config/Defaults.hs +6/−0
• src/library/exposed/Hasql/Pool/Observation.hs +15/−1
• src/library/other/Hasql/Pool/Config/Config.hs +5/−2
• src/library/other/Hasql/Pool/Config/Setting.hs +9/−0

@@ -1,3 +1,8 @@+# 1.1++- `ReadyForUseConnectionStatus` got extended with the `ConnectionReadyForUseReason` details.+- `initSession` setting added.+ # 1  - Optional observability event stream added. Provides a flexible mechanism for monitoring the healthiness of the pool via logs and metrics.

binary file changed (absent → 16434 bytes)

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-pool-version: 1.0.1+version: 1.1 category: Hasql, Database, PostgreSQL synopsis: Pool of connections for Hasql homepage: https://github.com/nikita-volkov/hasql-pool@@ -10,8 +10,13 @@ copyright: (c) 2015, Nikita Volkov license: MIT license-file: LICENSE-extra-source-files: CHANGELOG.md+extra-source-files:+  CHANGELOG.md+  diagrams-output/*.png +extra-doc-files:+  diagrams-output/*.png+ source-repository head   type: git   location: git://github.com/nikita-volkov/hasql-pool.git@@ -41,6 +46,8 @@     MagicHash     MultiParamTypeClasses     MultiWayIf+    NoImplicitPrelude+    NoMonomorphismRestriction     NumericUnderscores     OverloadedStrings     ParallelListComp@@ -57,8 +64,6 @@     TypeFamilies     TypeOperators     UnboxedTuples-    NoImplicitPrelude-    NoMonomorphismRestriction    default-language: Haskell2010 

@@ -60,7 +60,9 @@     -- | To stop the manager thread via garbage collection.     poolReaperRef :: IORef (),     -- | Action for reporting the observations.-    poolObserver :: Observation -> IO ()+    poolObserver :: Observation -> IO (),+    -- | Initial session to execute upon every established connection.+    poolInitSession :: Session.Session ()   }  -- | Create a connection-pool.@@ -98,7 +100,7 @@     -- When the pool goes out of scope, stop the manager.     killThread managerTid -  return $ Pool (Config.size config) (Config.connectionSettingsProvider config) acqTimeoutMicros agingTimeoutNanos maxIdletimeNanos connectionQueue capVar reuseVar reaperRef (Config.observationHandler config)+  return $ Pool (Config.size config) (Config.connectionSettingsProvider config) acqTimeoutMicros agingTimeoutNanos maxIdletimeNanos connectionQueue capVar reuseVar reaperRef (Config.observationHandler config) (Config.initSession config)   where     acqTimeoutMicros =       div (fromIntegral (diffTimeToPicoseconds (Config.acquisitionTimeout config))) 1_000_000@@ -164,15 +166,24 @@       now <- getMonotonicTimeNSec       id <- Uuid.nextRandom       poolObserver (ConnectionObservation id ConnectingConnectionStatus)-      connRes <- Connection.acquire settings-      case connRes of+      Connection.acquire settings >>= \case         Left connErr -> do           poolObserver (ConnectionObservation id (TerminatedConnectionStatus (NetworkErrorConnectionTerminationReason (fmap (Text.decodeUtf8With Text.lenientDecode) connErr))))           atomically $ modifyTVar' poolCapacity succ           return $ Left $ ConnectionUsageError connErr-        Right entry -> do-          poolObserver (ConnectionObservation id ReadyForUseConnectionStatus)-          onLiveConn reuseVar (Entry entry now now id)+        Right connection -> do+          Session.run poolInitSession connection >>= \case+            Left err -> do+              Connection.release connection+              case err of+                Session.QueryError _ _ (Session.ClientError details) -> do+                  poolObserver (ConnectionObservation id (TerminatedConnectionStatus (NetworkErrorConnectionTerminationReason (fmap (Text.decodeUtf8With Text.lenientDecode) details))))+                _ ->+                  poolObserver (ConnectionObservation id (TerminatedConnectionStatus (InitializationErrorTerminationReason err)))+              return $ Left $ SessionUsageError err+            Right () -> do+              poolObserver (ConnectionObservation id (ReadyForUseConnectionStatus EstablishedConnectionReadyForUseReason))+              onLiveConn reuseVar (Entry connection now now id)      onConn reuseVar entry = do       now <- getMonotonicTimeNSec@@ -206,11 +217,11 @@             return $ Left $ SessionUsageError err           _ -> do             returnConn-            poolObserver (ConnectionObservation (entryId entry) ReadyForUseConnectionStatus)+            poolObserver (ConnectionObservation (entryId entry) (ReadyForUseConnectionStatus (SessionFailedConnectionReadyForUseReason err)))             return $ Left $ SessionUsageError err         Right (Right res) -> do           returnConn-          poolObserver (ConnectionObservation (entryId entry) ReadyForUseConnectionStatus)+          poolObserver (ConnectionObservation (entryId entry) (ReadyForUseConnectionStatus SessionSucceededConnectionReadyForUseReason))           return $ Right res       where         returnConn =

@@ -10,6 +10,7 @@     Setting.staticConnectionSettings,     Setting.dynamicConnectionSettings,     Setting.observationHandler,+    Setting.initSession,   ) where 

@@ -3,6 +3,7 @@ import qualified Hasql.Connection as Connection import Hasql.Pool.Observation (Observation) import Hasql.Pool.Prelude+import qualified Hasql.Session as Session  -- | -- 3 connections.@@ -38,3 +39,8 @@ -- > const (pure ()) observationHandler :: Observation -> IO () observationHandler = const (pure ())++-- |+-- > pure ()+initSession :: Session.Session ()+initSession = pure ()

@@ -5,6 +5,7 @@ module Hasql.Pool.Observation where  import Hasql.Pool.Prelude+import qualified Hasql.Session as Session  -- | An observation of a change of the state of a pool. data Observation@@ -18,13 +19,15 @@   deriving (Show, Eq)  -- | Status of a connection.+--+-- <<diagrams-output/observation-status-model.png>> data ConnectionStatus   = -- | Connection is being established.     --     -- This is the initial status of every connection.     ConnectingConnectionStatus   | -- | Connection is established and not occupied.-    ReadyForUseConnectionStatus+    ReadyForUseConnectionStatus ConnectionReadyForUseReason   | -- | Is being used by some session.     --     -- After it's done the status will transition to 'ReadyForUseConnectionStatus' or 'TerminatedConnectionStatus'.@@ -33,6 +36,15 @@     TerminatedConnectionStatus ConnectionTerminationReason   deriving (Show, Eq) +data ConnectionReadyForUseReason+  = -- | Connection just got established.+    EstablishedConnectionReadyForUseReason+  | -- | Session execution ended with a failure that does not require a connection reset.+    SessionFailedConnectionReadyForUseReason Session.QueryError+  | -- | Session execution ended with success.+    SessionSucceededConnectionReadyForUseReason+  deriving (Show, Eq)+ -- | Explanation of why a connection was terminated. data ConnectionTerminationReason   = -- | The age timeout of the connection has passed.@@ -43,4 +55,6 @@     NetworkErrorConnectionTerminationReason (Maybe Text)   | -- | User has invoked the 'Hasql.Pool.release' procedure.     ReleaseConnectionTerminationReason+  | -- | Initialization session failure.+    InitializationErrorTerminationReason Session.QueryError   deriving (Show, Eq)

@@ -4,6 +4,7 @@ import qualified Hasql.Pool.Config.Defaults as Defaults import Hasql.Pool.Observation (Observation) import Hasql.Pool.Prelude+import qualified Hasql.Session as Session  -- | Configufation for Hasql connection pool. data Config = Config@@ -12,7 +13,8 @@     agingTimeout :: DiffTime,     idlenessTimeout :: DiffTime,     connectionSettingsProvider :: IO Connection.Settings,-    observationHandler :: Observation -> IO ()+    observationHandler :: Observation -> IO (),+    initSession :: Session.Session ()   }  -- | Reasonable defaults, which can be built upon.@@ -24,5 +26,6 @@       agingTimeout = Defaults.agingTimeout,       idlenessTimeout = Defaults.idlenessTimeout,       connectionSettingsProvider = Defaults.dynamicConnectionSettings,-      observationHandler = Defaults.observationHandler+      observationHandler = Defaults.observationHandler,+      initSession = Defaults.initSession     }

@@ -5,6 +5,7 @@ import qualified Hasql.Pool.Config.Config as Config import Hasql.Pool.Observation (Observation) import Hasql.Pool.Prelude+import qualified Hasql.Session as Session  apply :: Setting -> Config -> Config apply (Setting run) = run@@ -86,3 +87,11 @@ observationHandler :: (Observation -> IO ()) -> Setting observationHandler x =   Setting (\config -> config {Config.observationHandler = x})++-- | Initial session.+--+-- Gets executed on every connection upon acquisition.+-- Lets you specify the connection-wide settings.+initSession :: Session.Session () -> Setting+initSession x =+  Setting (\config -> config {Config.initSession = x})