diff --git a/package.yaml b/package.yaml index c240d4fc0..c9f2e9858 100644 --- a/package.yaml +++ b/package.yaml @@ -103,6 +103,7 @@ dependencies: - hashable - aeson-pretty - resourcet +- postgresql-simple # The library contains all of our application code. The executable # defined below is just a thin wrapper. diff --git a/src/Jobs.hs b/src/Jobs.hs index 772391e42..5969c4f08 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -10,6 +10,7 @@ , QuasiQuotes , NamedFieldPuns , MultiWayIf + , NumDecimals #-} module Jobs @@ -75,6 +76,9 @@ import Data.Time.Zones import Control.Concurrent.STM (retry) +import Database.PostgreSQL.Simple (sqlErrorHint) +import Control.Monad.Catch (handleIf) + data JobQueueException = JInvalid QueuedJobId QueuedJob | JLocked QueuedJobId InstanceId UTCTime @@ -320,7 +324,15 @@ queueJob' :: (MonadHandler m, HandlerSite m ~ UniWorX) => Job -> m () queueJob' job = queueJob job >>= writeJobCtl . JobCtlPerform setSerializable :: DB a -> DB a -setSerializable = ([executeQQ|SET TRANSACTION ISOLATION LEVEL SERIALIZABLE|] *>) +setSerializable act = setSerializable' (0 :: Integer) + where + act' = [executeQQ|SET TRANSACTION ISOLATION LEVEL SERIALIZABLE|] *> act + + setSerializable' (min 10 -> logBackoff) = + handleIf + (\e -> sqlErrorHint e == "The transaction might succeed if retried.") + (\e -> $logWarnS "SQL" (tshow e) *> threadDelay (1e3 * 2 ^ logBackoff) *> setSerializable' (succ logBackoff)) + act' determineCrontab :: DB (Crontab JobCtl)