@@ -1,7 +1,7 @@
11{-|
22Module: Squeal.PostgreSQL.Transaction
33Description: Squeal transaction control language
4−Copyright: (c) Eitan Chatav, 2017
4+Copyright: (c) Eitan Chatav, 2019
55Maintainer: eitan@morphism.tech
66Stability: experimental
77
@@ -20,6 +20,7 @@ module Squeal.PostgreSQL.Transaction
2020 ( -- * Transaction
2121 transactionally
2222 , transactionally_
23+ , transactionallyRetry
2324 , begin
2425 , commit
2526 , rollback
@@ -34,47 +35,76 @@ module Squeal.PostgreSQL.Transaction
3435 , DeferrableMode (..)
3536 ) where
3637
38+import Control.Monad
3739import Generics.SOP
38−import UnliftIO (MonadUnliftIO, liftIO, mask, onException)
40+import UnliftIO
3941
4042import qualified Database.PostgreSQL.LibPQ as LibPQ
4143
4244import Squeal.PostgreSQL.Manipulation
4345import Squeal.PostgreSQL.Render
4446import Squeal.PostgreSQL.PQ
45−import Squeal.PostgreSQL.Schema
4647
47−-- | Run a schema invariant computation `transactionally`.
48+{- | Run a computation `transactionally`; first `begin`,
49+then run the computation, then if it raises an exception
50+`rollback`, otherwise `commit` and `return` the result.
51+-}
4852transactionally
4953 :: (MonadUnliftIO tx, MonadPQ schemas tx)
5054 => TransactionMode
5155 -> tx x -- ^ run inside a transaction
5256 -> tx x
5357transactionally mode tx = mask $ \restore -> do
54− _ <- begin mode
58+ begin mode
5559 result <- restore tx `onException` rollback
56− _ <- commit
60+ commit
5761 return result
5862
59−-- | Run a schema invariant computation `transactionally_` in `defaultMode`.
63+-- | Run a computation `transactionally_` in `defaultMode`.
6064transactionally_
6165 :: (MonadUnliftIO tx, MonadPQ schemas tx)
6266 => tx x -- ^ run inside a transaction
6367 -> tx x
6468transactionally_ = transactionally defaultMode
6569
70+{- |
71+`transactionallyRetry` a computation;
72+first `begin`,
73+then `try` the computation,
74+if it raises an serialization failure then `rollback` and restart the transaction,
75+if it raises any other exception then `rollback` and rethrow the exception,
76+otherwise `commit` and `return` the result.
77+-}
78+transactionallyRetry
79+ :: (MonadUnliftIO tx, MonadPQ schemas tx)
80+ => TransactionMode
81+ -> tx x -- ^ run inside a transaction
82+ -> tx x
83+transactionallyRetry mode tx = mask $ \restore ->
84+ loop . try $ do
85+ x <- restore tx
86+ commit
87+ return x
88+ where
89+ loop attempt = do
90+ begin mode
91+ attempt >>= \case
92+ Left (PQException _ (Just "40001") _) -> rollback >> loop attempt
93+ Left err -> rollback >> throwIO err
94+ Right x -> return x
95+
6696-- | @BEGIN@ a transaction.
67−begin :: MonadPQ schemas tx => TransactionMode -> tx (K Result ('[] :: RowType))
68−begin mode = manipulate . UnsafeManipulation $
97+begin :: MonadPQ schemas tx => TransactionMode -> tx ()
98+begin mode = void . manipulate . UnsafeManipulation $
6999 "BEGIN" <+> renderSQL mode <> ";"
70100
71101-- | @COMMIT@ a schema invariant transaction.
72−commit :: MonadPQ schemas tx => tx (K Result ('[] :: RowType))
73−commit = manipulate $ UnsafeManipulation "COMMIT;"
102+commit :: MonadPQ schemas tx => tx ()
103+commit = void . manipulate $ UnsafeManipulation "COMMIT;"
74104
75105-- | @ROLLBACK@ a schema invariant transaction.
76−rollback :: MonadPQ schemas tx => tx (K Result ('[] :: RowType))
77−rollback = manipulate $ UnsafeManipulation "ROLLBACK;"
106+rollback :: MonadPQ schemas tx => tx ()
107+rollback = void . manipulate $ UnsafeManipulation "ROLLBACK;"
78108
79109-- | Run a schema changing computation `transactionallySchema`.
80110transactionallySchema
@@ -108,7 +138,7 @@ data TransactionMode = TransactionMode
108138-- | `TransactionMode` with a `Serializable` `IsolationLevel`,
109139-- `ReadWrite` `AccessMode` and `NotDeferrable` `DeferrableMode`.
110140defaultMode :: TransactionMode
111−defaultMode = TransactionMode Serializable ReadWrite NotDeferrable
141+defaultMode = TransactionMode ReadCommitted ReadWrite NotDeferrable
112142
113143-- | `TransactionMode` with a `Serializable` `IsolationLevel`,
114144-- `ReadOnly` `AccessMode` and `Deferrable` `DeferrableMode`.