persistent/fix: make loggedClose uninterruptible

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. 

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)

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 <michael@snoyman.com>