diff --git a/Database/Persist/GenericSql.hs b/Database/Persist/GenericSql.hs
--- a/Database/Persist/GenericSql.hs
+++ b/Database/Persist/GenericSql.hs
@@ -10,6 +10,7 @@
     , Statement
     , runSqlConn
     , runSqlPool
+    , runSqlPoolF
     , Migration
     , parseMigration
     , parseMigration'
@@ -49,6 +50,11 @@
 
 runSqlPool :: MonadCatchIO m => SqlPersist m a -> Pool Connection -> m a
 runSqlPool r pconn = withPool' pconn $ runSqlConn r
+
+runSqlPoolF :: MonadCatchIO m
+            => (m (Maybe b) -> m () -> m (Maybe b))
+            -> SqlPersist m b -> Pool Connection -> m b
+runSqlPoolF finally' r pconn = withPoolF' finally' pconn $ runSqlConn r
 
 runSqlConn :: MonadCatchIO m => SqlPersist m a -> Connection -> m a
 runSqlConn (SqlPersist r) conn = do
diff --git a/Database/Persist/GenericSql/Internal.hs b/Database/Persist/GenericSql/Internal.hs
--- a/Database/Persist/GenericSql/Internal.hs
+++ b/Database/Persist/GenericSql/Internal.hs
@@ -6,6 +6,7 @@
     , Statement (..)
     , withSqlConn
     , withSqlPool
+    , withSqlPoolF
     , RowPopper
     , mkColumns
     , Column (..)
@@ -53,6 +54,11 @@
 withSqlPool :: MonadCatchIO m
             => IO Connection -> Int -> (Pool Connection -> m a) -> m a
 withSqlPool mkConn = createPool mkConn close'
+
+withSqlPoolF :: MonadIO m
+             => (m a -> m () -> m a)
+             -> IO Connection -> Int -> (Pool Connection -> m a) -> m a
+withSqlPoolF finally' mkConn = createPoolF finally' mkConn close'
 
 withSqlConn :: MonadCatchIO m => IO Connection -> (Connection -> m a) -> m a
 withSqlConn open = bracket (liftIO open) (liftIO . close')
diff --git a/Database/Persist/Pool.hs b/Database/Persist/Pool.hs
--- a/Database/Persist/Pool.hs
+++ b/Database/Persist/Pool.hs
@@ -5,6 +5,9 @@
     , withPool
     , withPool'
     , Pool
+    , withPoolF'
+    , withPoolF
+    , createPoolF
     ) where
 
 import Control.Concurrent.STM (atomically)
@@ -12,7 +15,8 @@
     (TVar, newTVarIO, readTVar, writeTVar)
 import Control.Exception (throwIO)
 import Data.Typeable
-import "MonadCatchIO-transformers" Control.Monad.CatchIO
+import "MonadCatchIO-transformers" Control.Monad.CatchIO hiding (finally)
+import qualified "MonadCatchIO-transformers" Control.Monad.CatchIO as C
 import Control.Monad.IO.Class
 import Control.Monad
 
@@ -29,7 +33,12 @@
 
 createPool :: MonadCatchIO m
            => IO a -> (a -> IO ()) -> Int -> (Pool a -> m b) -> m b
-createPool mk fr mx f = do
+createPool = createPoolF C.finally
+
+createPoolF :: MonadIO m
+            => (m b -> m () -> m b)
+            -> IO a -> (a -> IO ()) -> Int -> (Pool a -> m b) -> m b
+createPoolF finally mk fr mx f = do
     pd <- liftIO $ newTVarIO $ PoolData [] 0
     finally (f $ Pool mx pd mk) $ liftIO $ do
         PoolData ress _ <- atomically $ readTVar pd
@@ -46,8 +55,22 @@
         Nothing -> liftIO $ throwIO PoolExhaustedException
         Just x' -> return x'
 
+withPoolF' :: MonadCatchIO m
+           => (m (Maybe b) -> m () -> m (Maybe b))
+           -> Pool a -> (a -> m b) -> m b
+withPoolF' finally p f = do
+    x <- withPoolF finally p f
+    case x of
+        Nothing -> liftIO $ throwIO PoolExhaustedException
+        Just x' -> return x'
+
 withPool :: MonadCatchIO m => Pool a -> (a -> m b) -> m (Maybe b)
-withPool p f = block $ do
+withPool = withPoolF C.finally
+
+withPoolF :: MonadCatchIO m
+          => (m (Maybe b) -> m () -> m (Maybe b))
+          -> Pool a -> (a -> m b) -> m (Maybe b)
+withPoolF finally p f = block $ do
     eres <- liftIO $ atomically $ do
         pd <- readTVar $ poolData p
         let (pd', eres) =
@@ -60,10 +83,11 @@
         Left pc ->
             if pc >= poolMax p
                 then return Nothing
-                else bracket
-                        (liftIO $ poolMake p)
-                        (insertResource 1)
-                        (liftM Just . unblock . f)
+                else do
+                    x <- liftIO $ poolMake p
+                    finally
+                        (liftM Just $ unblock $ f x)
+                        (insertResource 1 x)
         Right res -> finally
                         (liftM Just $ unblock $ f res)
                         (insertResource 0 res)
diff --git a/persistent.cabal b/persistent.cabal
--- a/persistent.cabal
+++ b/persistent.cabal
@@ -1,5 +1,5 @@
 name:            persistent
-version:         0.2.3
+version:         0.2.4
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
