Sessions.hs

module Hasql.Transaction.Private.Sessions where

import Hasql.Errors (ServerError (..), SessionError (..), StatementError (..))
import Hasql.Session
import Hasql.Transaction.Config
import Hasql.Transaction.Private.Prelude
import Hasql.Transaction.Private.Statements qualified as Statements

{-
We may want to
do one transaction retry in case of the 23505 error, and fail if an identical
error is seen.
-}
inRetryingTransaction :: IsolationLevel -> Mode -> Bool -> Session (a, Bool) -> Session a
inRetryingTransaction level mode retryOnError session =
  fix $ \retry -> do
    attemptRes <- tryTransaction level mode retryOnError session
    case attemptRes of
      Just a -> return a
      Nothing -> retry

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 retryOnError $ return Nothing

  case bodyRes of
    Just (res, commit) -> catchError (commitOrAbort commit $> Just res) $ \error -> do
      handleTransactionError error retryOnError $ return Nothing
    Nothing -> return Nothing

commitOrAbort :: Bool -> Session ()
commitOrAbort commit =
  if commit
    then statement () Statements.commitTransaction
    else statement () Statements.abortTransaction

handleTransactionError :: SessionError -> Bool -> Session a -> Session a
handleTransactionError error retryOnError onTransactionError = case error of
  StatementSessionError _ _ _ _ _ statementError -> onStatementError statementError
  ScriptSessionError _ serverError -> onServerError serverError
  _ -> throwError error
  where
    retryOrThrow = if retryOnError then onTransactionError else throwError error
    onStatementError = \case
      ServerStatementError serverError -> onServerError serverError
      _ -> throwError error
    onServerError (ServerError code _ _ _ _) =
      case code of
        "40001" -> retryOrThrow
        "40P01" -> retryOrThrow
        _ -> throwError error