git.iko.soy/typeable/postgresql-simple
on master help sign in
Change withTransactionModeRetry to allow the user to determine when to retry
c96a43dOliver Charles
src/Database/PostgreSQL/Simple.hs+19−13
@@ -663,6 +663,15 @@ withTransactionSerializable =
663 { isolationLevel = Serializable
663 { isolationLevel = Serializable
664 , readWriteMode = ReadWrite
664 , readWriteMode = ReadWrite
665 }
665 }
666+ retryOnNotSerializable
667+ where
668+ retryOnNotSerializable exception =
669+ case exception of
670+ SqlError{..} | sqlState == serialization_failure
671+ -> True
672+ _ -> False
673+ -- http://www.postgresql.org/docs/current/static/errcodes-appendix.html
674+ serialization_failure = "40001"
666
675
667-- | Execute an action inside a SQL transaction with a given isolation level.
676-- | Execute an action inside a SQL transaction with a given isolation level.
668withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a
677withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a
@@ -678,14 +687,15 @@ withTransactionMode mode conn act =
678 commit conn
687 commit conn
679 return r
688 return r
680
689
681−-- | Like 'withTransactionMode', but if a 'SqlError' arises whose 'sqlState' is
690+-- | Like 'withTransactionMode', but also takes a custom callback to
682−-- @\"40001\"@ (@serialization_failure@), this will issue a @ROLLBACK@, then
691+-- determine if a transaction should be retried if an 'SqlError' occurs.
683−-- try the action again. If any other exception arises, this will issue a
692+-- If the callback returns True, then the transaction will be retried.
684−-- @ROLLBACK@, but will propagate the exception instead of retrying.
693+-- If the callback returns False, or an exception other than an 'SqlError'
694+-- occurs then the transaction will be rolled back and the exception rethrown.
685--
695--
686-- This is used to implement 'withTransactionSerializable'.
696-- This is used to implement 'withTransactionSerializable'.
687−withTransactionModeRetry :: TransactionMode -> Connection -> IO a -> IO a
697+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
688−withTransactionModeRetry mode conn act =
698+withTransactionModeRetry mode shouldRetry conn act =
689 mask $ \restore ->
699 mask $ \restore ->
690 retryLoop $ try $ do
700 retryLoop $ try $ do
691 a <- restore act
701 a <- restore act
@@ -699,16 +709,12 @@ withTransactionModeRetry mode conn act =
699 case r of
709 case r of
700 Left e -> do
710 Left e -> do
701 rollback conn
711 rollback conn
702− case fromException e of
712+ case fmap shouldRetry (fromException e) of
703− Just SqlError{..} | sqlState == serialization_failure
704− -> retryLoop act'
713+ Just True -> retryLoop act'
705− _ -> throwIO e
714+ _ -> throwIO e
706 Right a ->
715 Right a ->
707 return a
716 return a
708
717
709− -- http://www.postgresql.org/docs/current/static/errcodes-appendix.html
710− serialization_failure = "40001"
711−
712-- | Rollback a transaction.
718-- | Rollback a transaction.
713rollback :: Connection -> IO ()
719rollback :: Connection -> IO ()
714rollback conn = execute_ conn "ABORT" >> return ()
720rollback conn = execute_ conn "ABORT" >> return ()