hasql-transaction 1.2.0.1 → 1.2.1

raw patch · 5 files changed

+44/−17 lines, 5 files

Files

• conflicts-test/Main.hs +18/−1
• hasql-transaction.cabal +1/−1
• library/Hasql/Transaction/Private/Sessions.hs +12/−11
• library/Hasql/Transaction/Private/Transaction.hs +3/−3
• library/Hasql/Transaction/Sessions.hs +10/−1

@@ -52,7 +52,7 @@         runTest test =           test connection1 connection2         tests =-          [readAndWriteTransactionsTest, transactionsTest, transactionAndQueryTest]+          [readAndWriteTransactionsTest, transactionsTest, transactionsNoRetryTest, transactionAndQueryTest]  session :: A.Connection -> B.Session a -> IO a session connection session =@@ -63,6 +63,10 @@ transaction connection transaction =   session connection (G.transaction G.RepeatableRead G.Write transaction) +transactionNoRetry :: A.Connection -> C.Transaction a -> IO a+transactionNoRetry connection transaction =+  session connection (G.transactionNoRetry G.RepeatableRead G.Write transaction)+ type Test =   A.Connection -> A.Connection -> IO Bool @@ -80,6 +84,19 @@     traceShowM balance1     traceShowM balance2     return (balance1 == Just 2000 && balance2 == Just (-2000))++transactionsNoRetryTest :: Test+transactionsNoRetryTest connection1 connection2 =+  do+    id1 <- session connection1 (B.statement 0 D.createAccount)+    id2 <- session connection1 (B.statement 0 D.createAccount)+    async1 <- F.async (replicateM_ 1000 (transactionNoRetry connection1 (E.transfer id1 id2 1)))+    async2 <- F.async (replicateM_ 1000 (transactionNoRetry connection2 (E.transfer id1 id2 1)))+    result1 <- F.waitCatch async1+    result2 <- F.waitCatch async2+    let serialError = sequenceA [result1, result2]+    traceShowM serialError+    return $ either (("40001" `isInfixOf`) . show) (pure False) serialError  readAndWriteTransactionsTest :: Test readAndWriteTransactionsTest connection1 connection2 =

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-transaction-version: 1.2.0.1+version: 1.2.1 category: Hasql, Database, PostgreSQL synopsis:   Composable abstraction over retryable transactions for Hasql

@@ -10,25 +10,25 @@ do one transaction retry in case of the 23505 error, and fail if an identical error is seen. -}-inRetryingTransaction :: IsolationLevel -> Mode -> Session (a, Bool) -> Session a-inRetryingTransaction level mode session =+inRetryingTransaction :: IsolationLevel -> Mode -> Bool -> Session (a, Bool) -> Session a+inRetryingTransaction level mode retryOnError session =   fix $ \retry -> do-    attemptRes <- tryTransaction level mode session+    attemptRes <- tryTransaction level mode retryOnError session     case attemptRes of       Just a -> return a       Nothing -> retry -tryTransaction :: IsolationLevel -> Mode -> Session (a, Bool) -> Session (Maybe a)-tryTransaction level mode body = do+tryTransaction :: IsolationLevel -> Mode -> Bool -> Session (a, Bool) -> Session (Maybe a)+tryTransaction level mode retryOnError body = do   statement () (Statements.beginTransaction level mode)    bodyRes <- catchError (fmap Just body) $ \error -> do     statement () Statements.abortTransaction-    handleTransactionError error $ return Nothing+    handleTransactionError error retryOnError $ return Nothing    case bodyRes of     Just (res, commit) -> catchError (commitOrAbort commit $> Just res) $ \error -> do-      handleTransactionError error $ return Nothing+      handleTransactionError error retryOnError $ return Nothing     Nothing -> return Nothing  commitOrAbort :: Bool -> Session ()@@ -37,15 +37,16 @@     then statement () Statements.commitTransaction     else statement () Statements.abortTransaction -handleTransactionError :: SessionError -> Session a -> Session a-handleTransactionError error onTransactionError = case error of+handleTransactionError :: SessionError -> Bool -> Session a -> Session a+handleTransactionError error retryOnError onTransactionError = case error of   QueryError _ _ clientError -> onCommandError clientError   PipelineError clientError -> onCommandError clientError   where+    retryOrThrow = if retryOnError then onTransactionError else throwError error     onCommandError = \case       ResultError (ServerError code _ _ _ _) ->         case code of-          "40001" -> onTransactionError-          "40P01" -> onTransactionError+          "40001" -> retryOrThrow+          "40P01" -> retryOrThrow           _ -> throwError error       _ -> throwError error

@@ -25,9 +25,9 @@ -- | -- Execute the transaction using the provided isolation level and mode. {-# INLINE run #-}-run :: Transaction a -> IsolationLevel -> Mode -> B.Session a-run (Transaction session) isolation mode =-  D.inRetryingTransaction isolation mode (runStateT session True)+run :: Transaction a -> IsolationLevel -> Mode -> Bool -> B.Session a+run (Transaction session) isolation mode retryOnError =+  D.inRetryingTransaction isolation mode retryOnError (runStateT session True)  -- | -- Possibly a multi-statement query,

@@ -1,5 +1,6 @@ module Hasql.Transaction.Sessions   ( transaction,+    transactionNoRetry,      -- * Transaction settings     C.Mode (..),@@ -9,6 +10,7 @@  import Hasql.Session qualified as B import Hasql.Transaction.Config qualified as C+import Hasql.Transaction.Private.Prelude import Hasql.Transaction.Private.Transaction qualified as A  -- |@@ -16,4 +18,11 @@ {-# INLINE transaction #-} transaction :: C.IsolationLevel -> C.Mode -> A.Transaction a -> B.Session a transaction isolation mode transaction =-  A.run transaction isolation mode+  A.run transaction isolation mode True++-- |+-- Execute the transaction but do not retry it on errors.+{-# INLINE transactionNoRetry #-}+transactionNoRetry :: C.IsolationLevel -> C.Mode -> A.Transaction a -> B.Session a+transactionNoRetry isolation mode transaction =+  A.run transaction isolation mode False