diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index a7703759e..f90f5933f 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for persistent +# 2.18.1.1 +* [#1637](https://github.com/yesodweb/persistent/pull/1637) + * Fixes interruptible logging on connection closing inside `createSqlPoolWithConfig` since `resource-pool-0.5.x`. + # 2.18.1.0 * [#1616](https://github.com/yesodweb/persistent/pull/1616) * Allow overriding the default cascade option for foreign keys. diff --git a/persistent/Database/Persist/Sql/Run.hs b/persistent/Database/Persist/Sql/Run.hs index 62e699c1b..2b6dcb1a3 100644 --- a/persistent/Database/Persist/Sql/Run.hs +++ b/persistent/Database/Persist/Sql/Run.hs @@ -280,16 +280,17 @@ createSqlPoolWithConfig -> m (Pool backend) createSqlPoolWithConfig mkConn config = do logFunc <- askLoggerIO - -- Resource pool will swallow any exceptions from close. We want to log - -- them instead. + -- NOTE: resource-pool >= 0.5 no longer runs the pool's free action + -- uninterruptibly, and no longer swallows its exceptions. let loggedClose :: backend -> IO () loggedClose backend = - close' backend `UE.catchAny` \e -> do - runLoggingT - (logError $ T.pack $ "Error closing database connection in pool: " ++ show e) - logFunc - UE.throwIO e + UE.uninterruptibleMask_ $ + close' backend `UE.catchAny` \e -> do + runLoggingT + (logError $ T.pack $ "Error closing database connection in pool: " ++ show e) + logFunc + UE.throwIO e liftIO $ createPool (mkConn logFunc) diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal index d30976467..4d83673d5 100644 --- a/persistent/persistent.cabal +++ b/persistent/persistent.cabal @@ -1,5 +1,5 @@ name: persistent -version: 2.18.1.0 +version: 2.18.1.1 license: MIT license-file: LICENSE author: Michael Snoyman