hasql-resource-pool 1.9.1.3 → 1.10.1.0
raw patch · 3 files changed
+92/−45 lines, 3 filesdep ~hasqldep ~resource-pool
Dependency ranges changed: hasql, resource-pool
Files
- CHANGELOG.md +5/−1
- hasql-resource-pool.cabal +4/−4
- library/Hasql/Pool.hs +83/−40
CHANGELOG.md view
@@ -1,7 +1,11 @@+# 1.10.1.0++* Migrate to `Hasql-1.10`+* Require explicit `idle_in_transaction_session_timeout` and `statement_timeout` setting+ # 1.9.1.3 * Support for `resource-pool-0.5.0.0`- # 1.9.1.2
hasql-resource-pool.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.6 name: hasql-resource-pool-version: 1.9.1.3+version: 1.10.1.0 category: Hasql, Database, PostgreSQL synopsis: A pool of connections for Hasql based on resource-pool. description: This package was originally derived from hasql-pool v0.5.2.2. It continues using `resource-pool` for its pool implementation.@@ -20,7 +20,7 @@ source-repository head type: git- location: git://github.com/avanov/hasql-resource-pool.git+ location: https://github.com/avanov/hasql-resource-pool.git branch: master @@ -73,9 +73,9 @@ Hasql.Pool.Prelude build-depends: -- resources:- , resource-pool >= 0.5.0.0 && < 1+ , resource-pool >= 0.5.0.0 && < 0.6 -- database:- , hasql >= 1.9.1.2 && < 2+ , hasql >= 1.10.1 -- data: , time >= 1.5 && < 2 , clock >= 0.8 && < 1
library/Hasql/Pool.hs view
@@ -7,6 +7,10 @@ , UsageError(..) , ConnectionGetter , Stats(..)+, TimeoutSetting(..)+, TimeUnit(..)+, errorToDetailedMsg+, errorIsTransient , stats , getPoolUsageStat , acquire@@ -26,9 +30,8 @@ import Hasql.Pool.Prelude import qualified Hasql.Connection-import qualified Hasql.Connection.Setting-import qualified Hasql.Connection.Setting.Connection-import qualified Hasql.Connection.Setting.Connection.Param+import qualified Hasql.Connection.Settings+import qualified Hasql.Errors import qualified Hasql.Session import Hasql.Pool.Observer (Observed(..), ObserverAction) @@ -36,7 +39,7 @@ -- | -- A pool of open DB connections. newtype Pool =- Pool (ResourcePool.Pool (Either Hasql.Connection.ConnectionError Hasql.Connection.Connection))+ Pool (ResourcePool.Pool (Either Hasql.Errors.ConnectionError Hasql.Connection.Connection)) @@ -46,7 +49,7 @@ -- | -- Connection getter action that allows for obtaining Postgres connection settings -- via external resources such as AWS tokens etc.-type ConnectionGetter = IO (Either Hasql.Connection.ConnectionError Hasql.Connection.Connection)+type ConnectionGetter = IO (Either Hasql.Errors.ConnectionError Hasql.Connection.Connection) -- | -- Settings of the connection pool. Consist of:@@ -61,58 +64,94 @@ -- type Settings = (PoolSize, ResidenceTimeout, ConnectionSettings) ++data TimeUnit+ = Microseconds+ | Milliseconds+ | Seconds+ | Minutes+ | Hours+ | Days++-- https://www.postgresql.org/docs/18/config-setting.html#CONFIG-SETTING-NAMES-VALUES+instance Show TimeUnit where+ show Microseconds = "us"+ show Milliseconds = "ms"+ show Seconds = "s"+ show Minutes = "min"+ show Hours = "h"+ show Days = "d"+++data TimeoutSetting = TimeoutSetting Word16 TimeUnit++instance Show TimeoutSetting where+ show (TimeoutSetting v u) = show v <> show u++ -- | Extended connection settings data ConnectionSettings = ConnectionSettings- { host :: T.Text- , port :: Word16- , user :: T.Text- , password :: T.Text- , dbName :: T.Text- , connAcqTimeout :: Word16 -- ^ Zero, negative, or not specified means wait indefinitely.- , sslMode :: T.Text -- ^ See https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-CONNECT-SSLMODE- , sslRootCert :: T.Text -- ^ See https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-CONNECT-SSLROOTCERT+ { host :: T.Text+ , port :: Word16+ , user :: T.Text+ , password :: T.Text+ , dbName :: T.Text+ , connAcqTimeout :: Word16 -- ^ In seconds: zero, negative, or not specified means wait indefinitely. Doesn't support unit suffixes.+ , txIdleTimeout :: TimeoutSetting -- ^ Sets explicit `idle_in_transaction_session_timeout`: zero, negative, or not specified means wait indefinitely.+ , stmtTimeout :: TimeoutSetting -- ^ Sets explicit `statement_timeout`: zero, negative, or not specified means wait indefinitely.+ , sslMode :: T.Text -- ^ See https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-CONNECT-SSLMODE+ , sslRootCert :: T.Text -- ^ See https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-CONNECT-SSLROOTCERT } --- | https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-CONNECT-CONNECT-TIMEOUT-connectTimeout = Hasql.Connection.Setting.Connection.Param.other "connect_timeout"+-- | https://www.postgresql.org/docs/18/libpq-connect.html#LIBPQ-CONNECT-CONNECT-TIMEOUT+connectTimeout = Hasql.Connection.Settings.other "connect_timeout" --- | https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-CONNECT-SSLMODE-sslmode = Hasql.Connection.Setting.Connection.Param.other "sslmode"+-- | https://www.postgresql.org/docs/18/runtime-config-client.html#GUC-TRANSACTION-TIMEOUT+serverOptions = Hasql.Connection.Settings.other "options" --- | https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-CONNECT-SSLROOTCERT-sslrootcert = Hasql.Connection.Setting.Connection.Param.other "sslrootcert"+-- | https://www.postgresql.org/docs/18/libpq-connect.html#LIBPQ-CONNECT-SSLMODE+sslmode = Hasql.Connection.Settings.other "sslmode" +-- | https://www.postgresql.org/docs/18/libpq-connect.html#LIBPQ-CONNECT-SSLROOTCERT+sslrootcert = Hasql.Connection.Settings.other "sslrootcert" + -- | -- Given the pool-size, timeout and connection settings -- create a connection-pool. acquire :: Settings -> IO Pool acquire settings@(_, _, cset) = acquireWith- (Hasql.Connection.acquire- [ extendedConnectionSettings cset- ]- )+ (Hasql.Connection.acquire . extendedConnectionSettings $ cset) settings -- | Produce connection settings suitable for acquiring a connection, from an extended set of parameters covering ssl options.-extendedConnectionSettings :: ConnectionSettings -> Hasql.Connection.Setting.Setting+extendedConnectionSettings :: ConnectionSettings -> Hasql.Connection.Settings.Settings extendedConnectionSettings cset = - Hasql.Connection.Setting.connection- ( Hasql.Connection.Setting.Connection.params- [ Hasql.Connection.Setting.Connection.Param.host cset.host- , Hasql.Connection.Setting.Connection.Param.port cset.port- , Hasql.Connection.Setting.Connection.Param.user cset.user- , Hasql.Connection.Setting.Connection.Param.password cset.password- , Hasql.Connection.Setting.Connection.Param.dbname cset.dbName- , (connectTimeout . T.pack . show) cset.connAcqTimeout- , sslmode cset.sslMode- , sslrootcert cset.sslRootCert- ]- )+ foldl' (<>) mempty+ [ Hasql.Connection.Settings.hostAndPort cset.host cset.port+ , Hasql.Connection.Settings.user cset.user+ , Hasql.Connection.Settings.password cset.password+ , Hasql.Connection.Settings.dbname cset.dbName+ , (connectTimeout . T.pack . show) cset.connAcqTimeout + , sslmode cset.sslMode+ , sslrootcert cset.sslRootCert+ , serverOptions+ (serverOpts+ -- https://www.postgresql.org/docs/18/runtime-config-client.html#GUC-IDLE-IN-TRANSACTION-SESSION-TIMEOUT+ [ ("idle_in_transaction_session_timeout", T.pack $ show cset.txIdleTimeout)+ -- https://www.postgresql.org/docs/18/runtime-config-client.html#GUC-STATEMENT-TIMEOUT+ , ("statement_timeout", T.pack $ show cset.stmtTimeout)+ ]+ )+ ] +serverOpts :: [(T.Text, T.Text)] -> T.Text+serverOpts = foldl' (\acc (k ,v) -> acc <> " -c " <> k <> "=" <> v) mempty++ -- | -- Similar to 'acquire', allows for finer configuration. acquireWith :: ConnectionGetter@@ -144,8 +183,8 @@ -- | -- A union over the connection establishment error and the session error. data UsageError- = ConnectionError Hasql.Connection.ConnectionError- | SessionError Hasql.Session.SessionError+ = ConnectionError Hasql.Errors.ConnectionError+ | SessionError Hasql.Errors.SessionError deriving (Show, Eq) -- |@@ -167,7 +206,7 @@ where runQuery dbConn = maybe action (runWithObserver action) observer where- action = Hasql.Session.run session dbConn+ action = Hasql.Connection.use dbConn session runWithObserver action doObserve = do let measure = getTime Monotonic@@ -224,4 +263,8 @@ getPoolUsageStat :: Pool -> IO PoolSize-getPoolUsageStat pool = stats pool >>= (pure . currentUsage)+getPoolUsageStat pool = currentUsage <$> stats pool+++errorToDetailedMsg = Hasql.Errors.toDetailedText+errorIsTransient = Hasql.Errors.isTransient