From 71b40803736ec681057ddb20eca78ed29b0eb997 Mon Sep 17 00:00:00 2001
From: Leon P Smith <leon@melding-monads.com>
Date: Tue, 28 Jun 2016 14:08:04 -0400
Subject: [PATCH] Ignore IOError on transaction rollback

This should fix the timeout/withTransaction problem reported in #177
---
 src/Database/PostgreSQL/Simple/Transaction.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/src/Database/PostgreSQL/Simple/Transaction.hs b/src/Database/PostgreSQL/Simple/Transaction.hs
index f682e93e..bd26f942 100644
--- a/src/Database/PostgreSQL/Simple/Transaction.hs
+++ b/src/Database/PostgreSQL/Simple/Transaction.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
 
 ------------------------------------------------------------------------------
 -- |
@@ -142,7 +142,7 @@ withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a
 withTransactionMode mode conn act =
   mask $ \restore -> do
     beginMode mode conn
-    r <- restore act `E.onException` rollback conn
+    r <- restore act `E.onException` rollback_ conn
     commit conn
     return r
 
@@ -167,7 +167,7 @@ withTransactionModeRetry mode shouldRetry conn act =
         r <- act'
         case r of
             Left e -> do
-                rollback conn
+                rollback_ conn
                 case fmap shouldRetry (E.fromException e) of
                   Just True -> retryLoop act'
                   _ -> E.throwIO e
@@ -178,6 +178,10 @@ withTransactionModeRetry mode shouldRetry conn act =
 rollback :: Connection -> IO ()
 rollback conn = execute_ conn "ABORT" >> return ()
 
+-- | Rollback a transaction, ignoring any @IOErrors@
+rollback_ :: Connection -> IO ()
+rollback_ conn = rollback conn `E.catch` \(_ :: IOError) -> return ()
+
 -- | Commit a transaction.
 commit :: Connection -> IO ()
 commit conn = execute_ conn "COMMIT" >> return ()