From ef9209717808ad18facbcbd54801066b66a42b08 Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 16:55:27 -0500 Subject: [PATCH 01/11] persistent-postgresql: add `createPostgresqlPoolTailored` function This change adds a connection pool creation function that is just like the `createPostgresqlPoolModifiedWithVersion` function but that can take a custom `open'`-like connection-creation function. The motivation for this change is that we need to be able to customize the resource creation action dynamically at run-time. --- .../Database/Persist/Postgresql.hs | 32 +++++++++++++++++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 4dd2dcad5..400378db0 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -37,6 +37,7 @@ module Database.Persist.Postgresql , createPostgresqlPool , createPostgresqlPoolModified , createPostgresqlPoolModifiedWithVersion + , createPostgresqlPoolTailored , createPostgresqlPoolWithConf , module Database.Persist.Sql , ConnectionString @@ -270,9 +271,36 @@ createPostgresqlPoolModifiedWithVersion -> ConnectionString -- ^ Connection string to the database. -> Int -- ^ Number of connections to be kept open in the pool. -> m (Pool SqlBackend) -createPostgresqlPoolModifiedWithVersion getVerDouble modConn ci = do +createPostgresqlPoolModifiedWithVersion = createPostgresqlPoolTailored open' + +-- | Same as 'createPostgresqlPoolModifiedWithVersion', but takes a custom connection-creation +-- function. +-- +-- The only time you should reach for this function is if you need to write custom logic for creating +-- a connection to the database. +-- +-- @since 2.13.5.2 +createPostgresqlPoolTailored + :: (MonadUnliftIO m, MonadLoggerIO m) + => + ( (PG.Connection -> IO ()) + -> (PG.Connection -> IO (NonEmpty Word)) + -> ((PG.Connection -> SqlBackend) -> PG.Connection -> SqlBackend) + -- ^ How to construct the actual backend type desired. For most uses, + -- this is just 'id', since the desired backend type is 'SqlBackend'. + -- But some callers want a @'RawPostgresql' 'SqlBackend'@, and will + -- pass in 'withRawConnection'. + -> ConnectionString -> LogFunc -> IO SqlBackend + ) + -- ^ Action that creates a postgresql connection. + -> (PG.Connection -> IO (Maybe Double)) -- ^ Action to perform to get the server version. + -> (PG.Connection -> IO ()) -- ^ Action to perform after connection is created. + -> ConnectionString -- ^ Connection string to the database. + -> Int -- ^ Number of connections to be kept open in the pool. + -> m (Pool SqlBackend) +createPostgresqlPoolTailored createConnection getVerDouble modConn ci = do let getVer = oldGetVersionToNew getVerDouble - createSqlPool $ open' modConn getVer id ci + createSqlPool $ createConnection modConn getVer id ci -- | Same as 'createPostgresqlPool', but can be configured with 'PostgresConf' and 'PostgresConfHooks'. -- From 19417e1ac901bd2a72670de53fe479b84a92093e Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 17:00:10 -0500 Subject: [PATCH 02/11] persistent-postgresql: version `2.13.5.2` -> `2.13.6` This change alters the API surface (via addition) and, as-per `CONTRIBUTING.md`, requires a `C` bump. --- persistent-postgresql/persistent-postgresql.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/persistent-postgresql/persistent-postgresql.cabal b/persistent-postgresql/persistent-postgresql.cabal index 05d4dbb4c..7247d5f56 100644 --- a/persistent-postgresql/persistent-postgresql.cabal +++ b/persistent-postgresql/persistent-postgresql.cabal @@ -1,5 +1,5 @@ name: persistent-postgresql -version: 2.13.5.2 +version: 2.13.6 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman From 49841fa83a9a28c793d6febad73b8a004344b289 Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 17:02:39 -0500 Subject: [PATCH 03/11] persistent-postgresql: update `@since` decl for bumped version --- persistent-postgresql/Database/Persist/Postgresql.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 400378db0..bcbeca87e 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -279,7 +279,7 @@ createPostgresqlPoolModifiedWithVersion = createPostgresqlPoolTailored open' -- The only time you should reach for this function is if you need to write custom logic for creating -- a connection to the database. -- --- @since 2.13.5.2 +-- @since 2.13.6 createPostgresqlPoolTailored :: (MonadUnliftIO m, MonadLoggerIO m) => From b1143bc0e6204b54975f28ac13c68003780d0199 Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 17:05:12 -0500 Subject: [PATCH 04/11] persistent-postgresql: run `stylish-haskell` on `Postgresql.hs` --- persistent-postgresql/Database/Persist/Postgresql.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index bcbeca87e..051df59d5 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -83,8 +83,8 @@ import Control.Monad import Control.Monad.Except import Control.Monad.IO.Unlift (MonadIO(..), MonadUnliftIO) import Control.Monad.Logger (MonadLoggerIO, runNoLoggingT) -import Control.Monad.Trans.Reader (ReaderT(..), asks, runReaderT) import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Reader (ReaderT(..), asks, runReaderT) #if !MIN_VERSION_base(4,12,0) import Control.Monad.Trans.Reader (withReaderT) #endif @@ -103,8 +103,8 @@ import qualified Data.Conduit.List as CL import Data.Data (Data) import Data.Either (partitionEithers) import Data.Function (on) -import Data.IORef import Data.Int (Int64) +import Data.IORef import Data.List (find, foldl', groupBy, sort) import qualified Data.List as List import Data.List.NonEmpty (NonEmpty) @@ -123,12 +123,13 @@ import System.Environment (getEnvironment) #if MIN_VERSION_base(4,12,0) import Database.Persist.Compatible #endif +import qualified Data.Vault.Strict as Vault import Database.Persist.Postgresql.Internal import Database.Persist.Sql import qualified Database.Persist.Sql.Util as Util import Database.Persist.SqlBackend -import Database.Persist.SqlBackend.StatementCache (StatementCache, mkSimpleStatementCache, mkStatementCache) -import qualified Data.Vault.Strict as Vault +import Database.Persist.SqlBackend.StatementCache + (StatementCache, mkSimpleStatementCache, mkStatementCache) import System.IO.Unsafe (unsafePerformIO) -- | A @libpq@ connection string. A simple example of connection From 4a1434c0e6ebd75dc83a243c7fb87bbdc38a6c24 Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 17:09:27 -0500 Subject: [PATCH 05/11] persistent-postgresql: update `ChangeLog.md` --- persistent-postgresql/ChangeLog.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/persistent-postgresql/ChangeLog.md b/persistent-postgresql/ChangeLog.md index 780d4559a..953be846f 100644 --- a/persistent-postgresql/ChangeLog.md +++ b/persistent-postgresql/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog for persistent-postgresql +## 2.13.6 (unreleased) + +* [#1511](https://github.com/yesodweb/persistent/pull/1511) + * Add `createPostgresqlPoolTailored` function to support creating connection + pools with a custom connection creation function. + ## 2.13.5.2 * [#1471](https://github.com/yesodweb/persistent/pull/1471) From 10327e0b1e2b2614c694d7344a280e8524aec238 Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 17:35:23 -0500 Subject: [PATCH 06/11] persistent-postgresql: follow the same comment style --- persistent-postgresql/Database/Persist/Postgresql.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 051df59d5..29f6a577b 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -286,14 +286,9 @@ createPostgresqlPoolTailored => ( (PG.Connection -> IO ()) -> (PG.Connection -> IO (NonEmpty Word)) - -> ((PG.Connection -> SqlBackend) -> PG.Connection -> SqlBackend) - -- ^ How to construct the actual backend type desired. For most uses, - -- this is just 'id', since the desired backend type is 'SqlBackend'. - -- But some callers want a @'RawPostgresql' 'SqlBackend'@, and will - -- pass in 'withRawConnection'. + -> ((PG.Connection -> SqlBackend) -> PG.Connection -> SqlBackend) -- ^ How to construct the actual backend type desired. For most uses, this is just 'id', since the desired backend type is 'SqlBackend'. But some callers want a @'RawPostgresql' 'SqlBackend'@, and will pass in 'withRawConnection'. -> ConnectionString -> LogFunc -> IO SqlBackend - ) - -- ^ Action that creates a postgresql connection. + ) -- ^ Action that creates a postgresql connection. -> (PG.Connection -> IO (Maybe Double)) -- ^ Action to perform to get the server version. -> (PG.Connection -> IO ()) -- ^ Action to perform after connection is created. -> ConnectionString -- ^ Connection string to the database. From 3dd32cf12b9e8d8d6e8420d0e2003c3600bb65af Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 17:40:40 -0500 Subject: [PATCH 07/11] persistent-postgresql: remove comment that offends haddock parser --- persistent-postgresql/Database/Persist/Postgresql.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 29f6a577b..f255c85c1 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -286,9 +286,9 @@ createPostgresqlPoolTailored => ( (PG.Connection -> IO ()) -> (PG.Connection -> IO (NonEmpty Word)) - -> ((PG.Connection -> SqlBackend) -> PG.Connection -> SqlBackend) -- ^ How to construct the actual backend type desired. For most uses, this is just 'id', since the desired backend type is 'SqlBackend'. But some callers want a @'RawPostgresql' 'SqlBackend'@, and will pass in 'withRawConnection'. + -> ((PG.Connection -> SqlBackend) -> PG.Connection -> SqlBackend) -> ConnectionString -> LogFunc -> IO SqlBackend - ) -- ^ Action that creates a postgresql connection. + ) -- ^ Action that creates a postgresql connection (please see documentation on the un-exported @open'@ function in this same module. -> (PG.Connection -> IO (Maybe Double)) -- ^ Action to perform to get the server version. -> (PG.Connection -> IO ()) -- ^ Action to perform after connection is created. -> ConnectionString -- ^ Connection string to the database. From b03fc4fe99c2ce8b1387a81a96d9ac49aa5fe474 Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 18:46:45 -0500 Subject: [PATCH 08/11] persistent-postgresql: expose `createBackend` ... so that users can construct their own `open'`-like function. --- persistent-postgresql/Database/Persist/Postgresql.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index f255c85c1..0593491bb 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -66,6 +66,7 @@ module Database.Persist.Postgresql , createRawPostgresqlPoolModified , createRawPostgresqlPoolModifiedWithVersion , createRawPostgresqlPoolWithConf + , createBackend ) where import qualified Database.PostgreSQL.LibPQ as LibPQ @@ -439,6 +440,8 @@ getSimpleConn = Vault.lookup underlyingConnectionKey <$> getConnVault -- | Create the backend given a logging function, server version, mutable statement cell, -- and connection. +-- +-- @since 2.13.6 createBackend :: LogFunc -> NonEmpty Word -> IORef (Map.Map Text Statement) -> PG.Connection -> SqlBackend createBackend logFunc serverVersion smap conn = From 9788fad1aba92a292061159c2075feed8d38d50b Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 18:57:33 -0500 Subject: [PATCH 09/11] persistent-postgresql: expose `getServerVersion` ... so users don't have to write their own. --- persistent-postgresql/Database/Persist/Postgresql.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 0593491bb..5a513c806 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -53,6 +53,7 @@ module Database.Persist.Postgresql , upsertManyWhere , openSimpleConn , openSimpleConnWithVersion + , getServerVersion , getSimpleConn , tableName , fieldName @@ -358,6 +359,8 @@ open' modConn getVer constructor cstr logFunc = do return $ constructor (createBackend logFunc ver smap) conn -- | Gets the PostgreSQL server version +-- +-- @since 2.13.6 getServerVersion :: PG.Connection -> IO (Maybe Double) getServerVersion conn = do [PG.Only version] <- PG.query_ conn "show server_version"; From f5e6f563a3d577a2b5d58ff1e5665dbc9b359a9f Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Mon, 7 Aug 2023 19:07:19 -0500 Subject: [PATCH 10/11] Update `Changelog.md` to reflect b03fc4f and 9788fad --- persistent-postgresql/ChangeLog.md | 1 + 1 file changed, 1 insertion(+) diff --git a/persistent-postgresql/ChangeLog.md b/persistent-postgresql/ChangeLog.md index 953be846f..7fdd0f0e6 100644 --- a/persistent-postgresql/ChangeLog.md +++ b/persistent-postgresql/ChangeLog.md @@ -5,6 +5,7 @@ * [#1511](https://github.com/yesodweb/persistent/pull/1511) * Add `createPostgresqlPoolTailored` function to support creating connection pools with a custom connection creation function. + * Expose `getServerVersion` and `createBackend` for user's convenience. ## 2.13.5.2 From e59cfab5c7fc4bdc1ca904778208cdca0f14f758 Mon Sep 17 00:00:00 2001 From: Parnell Springmeyer Date: Fri, 8 Sep 2023 13:20:51 -0500 Subject: [PATCH 11/11] Minor improvement to CHANGELOG.md to also trigger CI As requested by @parsonsmatt. --- persistent-postgresql/ChangeLog.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/persistent-postgresql/ChangeLog.md b/persistent-postgresql/ChangeLog.md index 7fdd0f0e6..0a8d9bc49 100644 --- a/persistent-postgresql/ChangeLog.md +++ b/persistent-postgresql/ChangeLog.md @@ -3,8 +3,8 @@ ## 2.13.6 (unreleased) * [#1511](https://github.com/yesodweb/persistent/pull/1511) - * Add `createPostgresqlPoolTailored` function to support creating connection - pools with a custom connection creation function. + * Add the `createPostgresqlPoolTailored` function to support creating + connection pools with a custom connection creation function. * Expose `getServerVersion` and `createBackend` for user's convenience. ## 2.13.5.2