hasql-resource-pool 0.6.0.0 → 1.9.1.2
raw patch · 4 files changed
+172/−73 lines, 4 filesdep +textdep ~clockdep ~hasqldep ~resource-pool
Dependencies added: text
Dependency ranges changed: clock, hasql, resource-pool
Files
- CHANGELOG.md +5/−0
- README.md +7/−1
- hasql-resource-pool.cabal +92/−54
- library/Hasql/Pool.hs +68/−18
CHANGELOG.md view
@@ -1,3 +1,8 @@+# 1.9.1.2++* Breaking change: the API is made compatible with `hasql-1.9.1.2`+* Follow the type errors to correct missing connection settings, they should be self-explanatory.+ # 0.6.0.0 * Upgrade to support [`reasource-pool`](https://github.com/scrive/pool) from the new maintainer.
README.md view
@@ -13,5 +13,11 @@ such as [AWS RDS IAM tokens](https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/UsingWithRDS.IAMDBAuth.html). * Pool interface allows for specifying IO observer actions. These actions are useful for collecting and tracking various pool metrics with tools like [Prometheus](https://prometheus.io/docs/introduction/overview/).-* Decision making on the size of the stripes is delegated to the upgraded `resource-pool` (which has slightly different semantics compared to v0.2.x).+* Decision making on the size of the pool stripes is delegated to the upgraded `resource-pool` (it has slightly different semantics compared to v0.2.x). * No reliance on Stack tooling.+++```+nix-shell+make build-local+```
hasql-resource-pool.cabal view
@@ -1,63 +1,101 @@-name: hasql-resource-pool-version: 0.6.0.0-category: Hasql, Database, PostgreSQL-synopsis: A pool of connections for Hasql based on resource-pool.-description: This package is originally derived from hasql-pool v0.5.2.2 and continues using `resource-pool` for its pool implementation.-homepage: https://github.com/avanov/hasql-resource-pool-bug-reports: https://github.com/avanov/hasql-resource-pool/issues-author: Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer: Maxim Avanov <maxim.avanov@gmail.com>-copyright: (c) 2023, Maxim Avanov-license: MIT-license-file: LICENSE-build-type: Simple-cabal-version: >=1.10+cabal-version: 3.6 +name: hasql-resource-pool+version: 1.9.1.2+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.+homepage: https://github.com/avanov/hasql-resource-pool+bug-reports: https://github.com/avanov/hasql-resource-pool/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Maxim Avanov <maxim.avanov@gmail.com>+copyright: (c) 2025, Maxim Avanov+license: MIT+license-file: LICENSE+build-type: Simple+ extra-source-files:- CHANGELOG.md- README.md+ CHANGELOG.md+ README.md source-repository head- type: git- location: git://github.com/avanov/hasql-resource-pool.git+ type: git+ location: git://github.com/avanov/hasql-resource-pool.git+ branch: master library- hs-source-dirs: library- ghc-options:- default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language:- Haskell2010- exposed-modules:- Hasql.Pool- Hasql.Pool.Observer- other-modules:- Hasql.Pool.Prelude- build-depends:- -- resources:- resource-pool >= 0.4.0.0,- -- database:- hasql >= 1.6.3,- -- data:- time >= 1.5 && < 2,- clock >= 0.8,- -- general:- base-prelude >= 1 && < 2+ hs-source-dirs: library+ ghc-options:+ default-extensions:+ Arrows,+ BangPatterns,+ ConstraintKinds,+ DataKinds,+ DefaultSignatures,+ DeriveDataTypeable,+ DeriveFoldable,+ DeriveFunctor,+ DeriveGeneric,+ DeriveTraversable,+ EmptyDataDecls,+ FlexibleContexts,+ FlexibleInstances,+ FunctionalDependencies,+ GADTs,+ GeneralizedNewtypeDeriving,+ LambdaCase,+ LiberalTypeSynonyms,+ MagicHash,+ MultiParamTypeClasses,+ MultiWayIf,+ NoImplicitPrelude,+ NoMonomorphismRestriction,+ OverloadedStrings,+ PatternGuards,+ ParallelListComp,+ QuasiQuotes,+ RankNTypes,+ RecordWildCards,+ ScopedTypeVariables,+ StandaloneDeriving,+ TemplateHaskell,+ TupleSections,+ TypeFamilies,+ TypeOperators,+ UnboxedTuples+ default-language:+ Haskell2010+ exposed-modules:+ Hasql.Pool+ Hasql.Pool.Observer+ other-modules:+ Hasql.Pool.Prelude+ build-depends:+ -- resources:+ , resource-pool >= 0.4.0.0 && < 1+ -- database:+ , hasql >= 1.9.1.2 && < 2+ -- data:+ , time >= 1.5 && < 2+ , clock >= 0.8 && < 1+ , text >= 2.0 && < 3+ -- general:+ , base-prelude >= 1 && < 2 test-suite test- type:- exitcode-stdio-1.0- hs-source-dirs:- test- main-is:- Main.hs- default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language:- Haskell2010- build-depends:- base-prelude,- hasql,- hasql-resource-pool,- hspec >= 2.6 && < 3+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ test+ main-is:+ Main.hs+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ , base-prelude+ , hasql+ , hasql-resource-pool+ , hspec >= 2.6 && < 3
library/Hasql/Pool.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE OverloadedRecordDot #-} module Hasql.Pool ( Pool-, Settings(..)+, PoolSize+, Settings+, ConnectionSettings(..) , UsageError(..) , ConnectionGetter , Stats(..)@@ -12,17 +15,22 @@ , use , useWithObserver , withResourceOnEither+, extendedConnectionSettings ) where -import qualified Data.Pool as ResourcePool-import qualified Data.Pool.Internal as Unstable-import System.Clock (Clock(Monotonic), diffTimeSpec, getTime, toNanoSecs)+import qualified Data.Pool as ResourcePool+import qualified Data.Text as T+import qualified Data.Pool.Internal as Unstable+import System.Clock (Clock(Monotonic), diffTimeSpec, getTime, toNanoSecs) -import Hasql.Pool.Prelude-import qualified Hasql.Connection-import qualified Hasql.Session-import Hasql.Pool.Observer (Observed(..), ObserverAction)+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.Session+import Hasql.Pool.Observer (Observed(..), ObserverAction) -- |@@ -33,7 +41,6 @@ type PoolSize = Int-type PoolStripes = Int type ResidenceTimeout = NominalDiffTime -- |@@ -52,32 +59,75 @@ -- -- * Connection settings. ---type Settings =- (PoolSize, ResidenceTimeout, Hasql.Connection.Settings)+type Settings = (PoolSize, ResidenceTimeout, ConnectionSettings) +-- | 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+ }++-- | 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/17/libpq-connect.html#LIBPQ-CONNECT-SSLMODE+sslmode = Hasql.Connection.Setting.Connection.Param.other "sslmode"++-- | https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-CONNECT-SSLROOTCERT+sslrootcert = Hasql.Connection.Setting.Connection.Param.other "sslrootcert"++ -- | -- Given the pool-size, timeout and connection settings -- create a connection-pool. acquire :: Settings -> IO Pool-acquire settings@(_size, _timeout, connectionSettings) =- acquireWith (Hasql.Connection.acquire connectionSettings) settings+acquire settings@(_, _, cset) =+ acquireWith+ (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 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+ ]+ )++ -- | -- Similar to 'acquire', allows for finer configuration. acquireWith :: ConnectionGetter -> Settings -> IO Pool-acquireWith connGetter (maxSize, timeout, connectionSettings) =- fmap Pool $ createPool connGetter release timeout maxSize+acquireWith connGetter (maxSize, sTimeout, _connectionSettings) =+ Pool <$> createPool connGetter releaseConn sTimeout maxSize where- release = either (const (pure ())) Hasql.Connection.release+ releaseConn = either (const (pure ())) Hasql.Connection.release createPool :: IO a -> (a -> IO ()) -> NominalDiffTime- -> Int+ -> PoolSize -> IO (ResourcePool.Pool a) createPool create free idleTime maxResources = ResourcePool.newPool cfg where -- defaultPoolConfig create free cacheTTL maxResources = PoolConfig@@ -95,7 +145,7 @@ -- A union over the connection establishment error and the session error. data UsageError = ConnectionError Hasql.Connection.ConnectionError- | SessionError Hasql.Session.QueryError+ | SessionError Hasql.Session.SessionError deriving (Show, Eq) -- |