module Hasql.Transaction.Private.Sessions
where

import Hasql.Transaction.Private.Prelude
import Hasql.Transaction.Private.Model
import Hasql.Session
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 :: 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 (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 :: 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 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 (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 (m :: * -> *) a.
MonadError QueryError m =>
QueryError -> m a -> m 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 (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 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 (m :: * -> *) a.
MonadError QueryError m =>
QueryError -> m a -> m 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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

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 -> m a -> m a
handleTransactionError QueryError
error m a
onTransactionError = case QueryError
error of
  QueryError ByteString
_ [Text]
_ (ResultError (ServerError ByteString
"40001" ByteString
_ Maybe ByteString
_ Maybe ByteString
_)) -> m a
onTransactionError
  QueryError
error -> QueryError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QueryError
error