diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 +``` diff --git a/hasql-resource-pool.cabal b/hasql-resource-pool.cabal --- a/hasql-resource-pool.cabal +++ b/hasql-resource-pool.cabal @@ -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 -maintainer: Maxim Avanov -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 +maintainer: Maxim Avanov +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 diff --git a/library/Hasql/Pool.hs b/library/Hasql/Pool.hs --- a/library/Hasql/Pool.hs +++ b/library/Hasql/Pool.hs @@ -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) -- |