module Hasql.Transaction.Private.Sessions where

import Hasql.Session
import Hasql.Transaction.Config
import Hasql.Transaction.Private.Prelude
import qualified Hasql.Transaction.Private.Statements 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 -> Session (a, Bool) -> Bool -> Session a
inRetryingTransaction :: forall a.
IsolationLevel -> Mode -> Session (a, Bool) -> Bool -> Session a
inRetryingTransaction IsolationLevel
level Mode
mode Session (a, Bool)
session Bool
preparable =
  (Session a -> Session a) -> Session a
forall a. (a -> a) -> a
fix ((Session a -> Session a) -> Session a)
-> (Session a -> Session a) -> Session a
forall a b. (a -> b) -> a -> b
$ \Session a
retry -> do
    Maybe a
attemptRes <- IsolationLevel
-> Mode -> Session (a, Bool) -> Bool -> Session (Maybe a)
forall a.
IsolationLevel
-> Mode -> Session (a, Bool) -> Bool -> Session (Maybe a)
tryTransaction IsolationLevel
level Mode
mode Session (a, Bool)
session Bool
preparable
    case Maybe a
attemptRes of
      Just a
a -> a -> Session a
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
      Maybe a
Nothing -> Session a
retry

tryTransaction :: IsolationLevel -> Mode -> Session (a, Bool) -> Bool -> Session (Maybe a)
tryTransaction :: forall a.
IsolationLevel
-> Mode -> Session (a, Bool) -> Bool -> Session (Maybe a)
tryTransaction IsolationLevel
level Mode
mode Session (a, Bool)
body Bool
preparable = do
  () -> Statement () () -> Session ()
forall params result.
params -> Statement params result -> Session result
statement () (IsolationLevel -> Mode -> Bool -> Statement () ()
Statements.beginTransaction IsolationLevel
level Mode
mode Bool
preparable)

  Maybe (a, Bool)
bodyRes <- Session (Maybe (a, Bool))
-> (QueryError -> Session (Maybe (a, Bool)))
-> Session (Maybe (a, Bool))
forall a. Session a -> (QueryError -> Session a) -> Session a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (((a, Bool) -> Maybe (a, Bool))
-> Session (a, Bool) -> Session (Maybe (a, Bool))
forall a b. (a -> b) -> Session a -> Session b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Bool) -> Maybe (a, Bool)
forall a. a -> Maybe a
Just Session (a, Bool)
body) ((QueryError -> Session (Maybe (a, Bool)))
 -> Session (Maybe (a, Bool)))
-> (QueryError -> Session (Maybe (a, Bool)))
-> Session (Maybe (a, Bool))
forall a b. (a -> b) -> a -> b
$ \QueryError
error -> do
    () -> Statement () () -> Session ()
forall params result.
params -> Statement params result -> Session result
statement () (Bool -> Statement () ()
Statements.abortTransaction Bool
preparable)
    QueryError
-> Session (Maybe (a, Bool)) -> Session (Maybe (a, Bool))
forall a. QueryError -> Session a -> Session a
handleTransactionError QueryError
error (Session (Maybe (a, Bool)) -> Session (Maybe (a, Bool)))
-> Session (Maybe (a, Bool)) -> Session (Maybe (a, Bool))
forall a b. (a -> b) -> a -> b
$ Maybe (a, Bool) -> Session (Maybe (a, Bool))
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, Bool)
forall a. Maybe a
Nothing

  case Maybe (a, Bool)
bodyRes of
    Just (a
res, Bool
commit) -> Session (Maybe a)
-> (QueryError -> Session (Maybe a)) -> Session (Maybe a)
forall a. Session a -> (QueryError -> Session a) -> Session a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (Bool -> Bool -> Session ()
commitOrAbort Bool
commit Bool
preparable Session () -> Maybe a -> Session (Maybe a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a -> Maybe a
forall a. a -> Maybe a
Just a
res) ((QueryError -> Session (Maybe a)) -> Session (Maybe a))
-> (QueryError -> Session (Maybe a)) -> Session (Maybe a)
forall a b. (a -> b) -> a -> b
$ \QueryError
error -> do
      QueryError -> Session (Maybe a) -> Session (Maybe a)
forall a. QueryError -> Session a -> Session a
handleTransactionError QueryError
error (Session (Maybe a) -> Session (Maybe a))
-> Session (Maybe a) -> Session (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Session (Maybe a)
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Maybe (a, Bool)
Nothing -> Maybe a -> Session (Maybe a)
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

commitOrAbort :: Bool -> Bool -> Session ()
commitOrAbort :: Bool -> Bool -> Session ()
commitOrAbort Bool
commit Bool
preparable =
  if Bool
commit
    then () -> Statement () () -> Session ()
forall params result.
params -> Statement params result -> Session result
statement () (Bool -> Statement () ()
Statements.commitTransaction Bool
preparable)
    else () -> Statement () () -> Session ()
forall params result.
params -> Statement params result -> Session result
statement () (Bool -> Statement () ()
Statements.abortTransaction Bool
preparable)

handleTransactionError :: QueryError -> Session a -> Session a
handleTransactionError :: forall a. QueryError -> Session a -> Session a
handleTransactionError QueryError
error Session a
onTransactionError = case QueryError
error of
  QueryError ByteString
_ [Text]
_ (ResultError (ServerError ByteString
code ByteString
_ Maybe ByteString
_ Maybe ByteString
_ Maybe Int
_)) -> case ByteString
code of
    ByteString
"40001" -> Session a
onTransactionError
    ByteString
"40P01" -> Session a
onTransactionError
    ByteString
_ -> QueryError -> Session a
forall a. QueryError -> Session a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QueryError
error
  QueryError
error -> QueryError -> Session a
forall a. QueryError -> Session a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QueryError
error