postgresql-simple-0.6: src/Database/PostgreSQL/Simple/Transaction.hs
{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
------------------------------------------------------------------------------
-- |
-- Module: Database.PostgreSQL.Simple.Transaction
-- Copyright: (c) 2011-2013 Leon P Smith
-- (c) 2013 Joey Adams
-- License: BSD3
-- Maintainer: Leon P Smith <leon@melding-monads.com>
--
------------------------------------------------------------------------------
module Database.PostgreSQL.Simple.Transaction
(
-- * Transaction handling
withTransaction
, withTransactionLevel
, withTransactionMode
, withTransactionModeRetry
, withTransactionSerializable
, TransactionMode(..)
, IsolationLevel(..)
, ReadWriteMode(..)
, defaultTransactionMode
, defaultIsolationLevel
, defaultReadWriteMode
-- , Base.autocommit
, begin
, beginLevel
, beginMode
, commit
, rollback
-- * Savepoint
, withSavepoint
, Savepoint
, newSavepoint
, releaseSavepoint
, rollbackToSavepoint
, rollbackToAndReleaseSavepoint
-- * Error predicates
, isSerializationError
, isNoActiveTransactionError
, isFailedTransactionError
) where
import qualified Control.Exception as E
import qualified Data.ByteString as B
import Database.PostgreSQL.Simple.Internal
import Database.PostgreSQL.Simple.Types
import Database.PostgreSQL.Simple.Errors
import Database.PostgreSQL.Simple.Compat (mask, (<>))
-- | Of the four isolation levels defined by the SQL standard,
-- these are the three levels distinguished by PostgreSQL as of version 9.0.
-- See <https://www.postgresql.org/docs/9.5/static/transaction-iso.html>
-- for more information. Note that prior to PostgreSQL 9.0, 'RepeatableRead'
-- was equivalent to 'Serializable'.
data IsolationLevel
= DefaultIsolationLevel -- ^ the isolation level will be taken from
-- PostgreSQL's per-connection
-- @default_transaction_isolation@ variable,
-- which is initialized according to the
-- server's config. The default configuration
-- is 'ReadCommitted'.
| ReadCommitted
| RepeatableRead
| Serializable
deriving (Show, Eq, Ord, Enum, Bounded)
data ReadWriteMode
= DefaultReadWriteMode -- ^ the read-write mode will be taken from
-- PostgreSQL's per-connection
-- @default_transaction_read_only@ variable,
-- which is initialized according to the
-- server's config. The default configuration
-- is 'ReadWrite'.
| 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
-- | Execute an action inside a SQL transaction.
--
-- This function initiates a transaction with a \"@begin
-- transaction@\" statement, then executes the supplied action. If
-- the action succeeds, the transaction will be completed with
-- 'Base.commit' before this function returns.
--
-- If the action throws /any/ kind of exception (not just a
-- PostgreSQL-related exception), the transaction will be rolled back using
-- 'rollback', then the exception will be rethrown.
--
-- For nesting transactions, see 'withSavepoint'.
withTransaction :: Connection -> IO a -> IO a
withTransaction = withTransactionMode defaultTransactionMode
-- | Execute an action inside of a 'Serializable' transaction. If a
-- serialization failure occurs, roll back the transaction and try again.
-- Be warned that this may execute the IO action multiple times.
--
-- A 'Serializable' transaction creates the illusion that your program has
-- exclusive access to the database. This means that, even in a concurrent
-- setting, you can perform queries in sequence without having to worry about
-- what might happen between one statement and the next.
--
-- Think of it as STM, but without @retry@.
withTransactionSerializable :: Connection -> IO a -> IO a
withTransactionSerializable =
withTransactionModeRetry
TransactionMode
{ isolationLevel = Serializable
, readWriteMode = ReadWrite
}
isSerializationError
-- | Execute an action inside a SQL transaction with a given isolation level.
withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a
withTransactionLevel lvl
= withTransactionMode defaultTransactionMode { isolationLevel = lvl }
-- | Execute an action inside a SQL transaction with a given transaction mode.
withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a
withTransactionMode mode conn act =
mask $ \restore -> do
beginMode mode conn
r <- restore act `E.onException` rollback_ conn
commit conn
return r
-- | Like 'withTransactionMode', but also takes a custom callback to
-- determine if a transaction should be retried if an 'SqlError' occurs.
-- If the callback returns True, then the transaction will be retried.
-- If the callback returns False, or an exception other than an 'SqlError'
-- occurs then the transaction will be rolled back and the exception rethrown.
--
-- This is used to implement 'withTransactionSerializable'.
withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
withTransactionModeRetry mode shouldRetry conn act =
mask $ \restore ->
retryLoop $ E.try $ do
a <- restore act
commit conn
return a
where
retryLoop :: IO (Either E.SomeException a) -> IO a
retryLoop act' = do
beginMode mode conn
r <- act'
case r of
Left e -> do
rollback_ conn
case fmap shouldRetry (E.fromException e) of
Just True -> retryLoop act'
_ -> E.throwIO e
Right a ->
return a
-- | Rollback a transaction.
rollback :: Connection -> IO ()
rollback conn = execute_ conn "ROLLBACK" >> 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 ()
-- | Begin a transaction.
begin :: Connection -> IO ()
begin = beginMode defaultTransactionMode
-- | Begin a transaction with a given isolation level
beginLevel :: IsolationLevel -> Connection -> IO ()
beginLevel lvl = beginMode defaultTransactionMode { isolationLevel = lvl }
-- | Begin a transaction with a given transaction mode
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"
------------------------------------------------------------------------
-- Savepoint
-- | Create a savepoint, and roll back to it if an error occurs. This may only
-- be used inside of a transaction, and provides a sort of
-- \"nested transaction\".
--
-- See <https://www.postgresql.org/docs/9.5/static/sql-savepoint.html>
withSavepoint :: Connection -> IO a -> IO a
withSavepoint conn body =
mask $ \restore -> do
sp <- newSavepoint conn
r <- restore body `E.onException` rollbackToAndReleaseSavepoint conn sp
releaseSavepoint conn sp `E.catch` \err ->
if isFailedTransactionError err
then rollbackToAndReleaseSavepoint conn sp
else E.throwIO err
return r
-- | Create a new savepoint. This may only be used inside of a transaction.
newSavepoint :: Connection -> IO Savepoint
newSavepoint conn = do
name <- newTempName conn
_ <- execute_ conn ("SAVEPOINT " <> name)
return (Savepoint name)
-- | Destroy a savepoint, but retain its effects.
--
-- Warning: this will throw a 'SqlError' matching 'isFailedTransactionError' if
-- the transaction is aborted due to an error. 'commit' would merely warn and
-- roll back.
releaseSavepoint :: Connection -> Savepoint -> IO ()
releaseSavepoint conn (Savepoint name) =
execute_ conn ("RELEASE SAVEPOINT " <> name) >> return ()
-- | Roll back to a savepoint. This will not release the savepoint.
rollbackToSavepoint :: Connection -> Savepoint -> IO ()
rollbackToSavepoint conn (Savepoint name) =
execute_ conn ("ROLLBACK TO SAVEPOINT " <> name) >> return ()
-- | Roll back to a savepoint and release it. This is like calling
-- 'rollbackToSavepoint' followed by 'releaseSavepoint', but avoids a
-- round trip to the database server.
rollbackToAndReleaseSavepoint :: Connection -> Savepoint -> IO ()
rollbackToAndReleaseSavepoint conn (Savepoint name) =
execute_ conn sql >> return ()
where
sql = "ROLLBACK TO SAVEPOINT " <> name <> "; RELEASE SAVEPOINT " <> name