Handle serialization failures
This commit is contained in:
parent
8db4347ac3
commit
27dfae1345
@ -103,6 +103,7 @@ dependencies:
|
|||||||
- hashable
|
- hashable
|
||||||
- aeson-pretty
|
- aeson-pretty
|
||||||
- resourcet
|
- resourcet
|
||||||
|
- postgresql-simple
|
||||||
|
|
||||||
# The library contains all of our application code. The executable
|
# The library contains all of our application code. The executable
|
||||||
# defined below is just a thin wrapper.
|
# defined below is just a thin wrapper.
|
||||||
|
|||||||
14
src/Jobs.hs
14
src/Jobs.hs
@ -10,6 +10,7 @@
|
|||||||
, QuasiQuotes
|
, QuasiQuotes
|
||||||
, NamedFieldPuns
|
, NamedFieldPuns
|
||||||
, MultiWayIf
|
, MultiWayIf
|
||||||
|
, NumDecimals
|
||||||
#-}
|
#-}
|
||||||
|
|
||||||
module Jobs
|
module Jobs
|
||||||
@ -75,6 +76,9 @@ import Data.Time.Zones
|
|||||||
|
|
||||||
import Control.Concurrent.STM (retry)
|
import Control.Concurrent.STM (retry)
|
||||||
|
|
||||||
|
import Database.PostgreSQL.Simple (sqlErrorHint)
|
||||||
|
import Control.Monad.Catch (handleIf)
|
||||||
|
|
||||||
|
|
||||||
data JobQueueException = JInvalid QueuedJobId QueuedJob
|
data JobQueueException = JInvalid QueuedJobId QueuedJob
|
||||||
| JLocked QueuedJobId InstanceId UTCTime
|
| JLocked QueuedJobId InstanceId UTCTime
|
||||||
@ -320,7 +324,15 @@ queueJob' :: (MonadHandler m, HandlerSite m ~ UniWorX) => Job -> m ()
|
|||||||
queueJob' job = queueJob job >>= writeJobCtl . JobCtlPerform
|
queueJob' job = queueJob job >>= writeJobCtl . JobCtlPerform
|
||||||
|
|
||||||
setSerializable :: DB a -> DB a
|
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)
|
determineCrontab :: DB (Crontab JobCtl)
|
||||||
|
|||||||
Reference in New Issue
Block a user