module Database.PostgreSQL.Simple.Transaction
(
withTransaction
, withTransactionLevel
, withTransactionMode
, withTransactionModeRetry
, withTransactionSerializable
, isSerializationError
, TransactionMode(..)
, IsolationLevel(..)
, ReadWriteMode(..)
, defaultTransactionMode
, defaultIsolationLevel
, defaultReadWriteMode
, begin
, beginLevel
, beginMode
, commit
, rollback
) where
import Control.Exception hiding (mask)
import qualified Data.ByteString as B
import Database.PostgreSQL.Simple.Internal
import Database.PostgreSQL.Simple.Types
import Database.PostgreSQL.Simple.Compat(mask)
data IsolationLevel
= DefaultIsolationLevel
| ReadCommitted
| RepeatableRead
| Serializable
deriving (Show, Eq, Ord, Enum, Bounded)
data ReadWriteMode
= DefaultReadWriteMode
| ReadWrite
| ReadOnly
deriving (Show, Eq, Ord, Enum, Bounded)
data TransactionMode = TransactionMode {
isolationLevel :: !IsolationLevel,
readWriteMode :: !ReadWriteMode
} deriving (Show, Eq)
defaultTransactionMode :: TransactionMode
defaultTransactionMode = TransactionMode
defaultIsolationLevel
defaultReadWriteMode
defaultIsolationLevel :: IsolationLevel
defaultIsolationLevel = DefaultIsolationLevel
defaultReadWriteMode :: ReadWriteMode
defaultReadWriteMode = DefaultReadWriteMode
withTransaction :: Connection -> IO a -> IO a
withTransaction = withTransactionMode defaultTransactionMode
withTransactionSerializable :: Connection -> IO a -> IO a
withTransactionSerializable =
withTransactionModeRetry
TransactionMode
{ isolationLevel = Serializable
, readWriteMode = ReadWrite
}
isSerializationError
isSerializationError :: SqlError -> Bool
isSerializationError exception =
case exception of
SqlError{..} | sqlState == serialization_failure
-> True
_ -> False
where
serialization_failure = "40001"
withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a
withTransactionLevel lvl
= withTransactionMode defaultTransactionMode { isolationLevel = lvl }
withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a
withTransactionMode mode conn act =
mask $ \restore -> do
beginMode mode conn
r <- restore act `onException` rollback conn
commit conn
return r
withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
withTransactionModeRetry mode shouldRetry conn act =
mask $ \restore ->
retryLoop $ try $ do
a <- restore act
commit conn
return a
where
retryLoop :: IO (Either SomeException a) -> IO a
retryLoop act' = do
beginMode mode conn
r <- act'
case r of
Left e -> do
rollback conn
case fmap shouldRetry (fromException e) of
Just True -> retryLoop act'
_ -> throwIO e
Right a ->
return a
rollback :: Connection -> IO ()
rollback conn = execute_ conn "ABORT" >> return ()
commit :: Connection -> IO ()
commit conn = execute_ conn "COMMIT" >> return ()
begin :: Connection -> IO ()
begin = beginMode defaultTransactionMode
beginLevel :: IsolationLevel -> Connection -> IO ()
beginLevel lvl = beginMode defaultTransactionMode { isolationLevel = lvl }
beginMode :: TransactionMode -> Connection -> IO ()
beginMode mode conn = do
_ <- execute_ conn $! Query (B.concat ["BEGIN", isolevel, readmode])
return ()
where
isolevel = case isolationLevel mode of
DefaultIsolationLevel -> ""
ReadCommitted -> " ISOLATION LEVEL READ COMMITTED"
RepeatableRead -> " ISOLATION LEVEL REPEATABLE READ"
Serializable -> " ISOLATION LEVEL SERIALIZABLE"
readmode = case readWriteMode mode of
DefaultReadWriteMode -> ""
ReadWrite -> " READ WRITE"
ReadOnly -> " READ ONLY"