module Utils.Sql
  ( setSerializable
  ) where

import ClassyPrelude.Yesod

import Database.Persist.Sql

import Database.PostgreSQL.Simple (SqlError(SqlError), sqlErrorHint)
import Control.Monad.Catch (handleIf)

import Data.Time.Clock

setSerializable :: (MonadLogger m, MonadCatch m, MonadBase IO m, MonadIO m) => ReaderT SqlBackend m a -> ReaderT SqlBackend m a
setSerializable act = setSerializable' (0 :: Integer)
  where
    act' = [executeQQ|SET TRANSACTION ISOLATION LEVEL SERIALIZABLE|] *> act

    setSerializable' (min 10 -> logBackoff) =
      handleIf
        (\SqlError{sqlErrorHint} -> "The transaction might succeed if retried." `isInfixOf` sqlErrorHint)
        (\e -> do
            let
              delay :: NominalDiffTime
              delay = 1e-3 * 2 ^ logBackoff
            $logWarnS "Sql" $ tshow (delay, e)
            transactionUndo
            threadDelay . round $ delay * 1e6
            setSerializable' (succ logBackoff)
        )
        act'