154855b · odd-jobs · git.iko.soy

git.iko.soy/odd-jobs

Merge pull request #83 from SupercedeTech/retry-backoff

Make retry backoff configurable

commit154855bd7ce1b57e48e091c27f334e3edb89db60 authorIsaac van Bakel <isaac@supercede.com> dateThu 19 May 2022, 15:10 (4 years ago) parent72e942d 37088a0

4 files changed+46−2

compare with master

unifiedsplit

src/OddJobs/ConfigBuilder.hs+1 src/OddJobs/Job.hs+7−2 src/OddJobs/Types.hs+8 test/Test.hs+30

src/OddJobs/ConfigBuilder.hs+1

@@ -69,6 +69,7 @@ mkConfig logger tname dbpool ccControl jrunner configOverridesFn =

6969 , cfgJobType = defaultJobType

7070 , cfgDefaultJobTimeout = Seconds 600

7171 , cfgDeleteSuccessfulJobs = True

72+ , cfgDefaultRetryBackoff = \attempts -> pure $ Seconds $ 2 ^ attempts

7273 }

7374 in cfg

7475

src/OddJobs/Job.hs+7−2

@@ -142,7 +142,7 @@ class (MonadUnliftIO m, MonadBaseControl IO m) => HasJobRunner m where

142142 getConcurrencyControl :: m ConcurrencyControl

143143 log :: LogLevel -> LogEvent -> m ()

144144 getDefaultJobTimeout :: m Seconds

145−

145+ getDefaultRetryBackoff :: Int -> m Seconds

146146

147147-- $logging

148148--

@@ -195,6 +195,10 @@ instance HasJobRunner RunnerM where

195195

196196 getDefaultJobTimeout = cfgDefaultJobTimeout . envConfig <$> ask

197197

198+ getDefaultRetryBackoff attempts = do

199+ retryFn <- cfgDefaultRetryBackoff . envConfig <$> ask

200+ liftIO $ retryFn attempts

201+

198202-- | Start the job-runner in the /current/ thread, i.e. you'll need to use

199203-- 'forkIO' or 'async' manually, if you want the job-runner to run in the

200204-- background. Consider using 'OddJobs.Cli' to rapidly build your own

@@ -410,11 +414,12 @@ runJob jid = do

410414 then ( Failed, FailPermanent, LevelError )

411415 else ( Retry, FailWithRetry, LevelWarn )

412416 t <- liftIO getCurrentTime

417+ backoffInSeconds <- getDefaultRetryBackoff jobAttempts

413418 newJob <- saveJob job{ jobStatus=newStatus

414419 , jobLockedBy=Nothing

415420 , jobLockedAt=Nothing

416421 , jobLastError=(Just $ toJSON $ show e) -- TODO: convert errors to json properly

417− , jobRunAt=(addUTCTime (fromIntegral $ (2::Int) ^ jobAttempts) t)

422+ , jobRunAt=(addUTCTime (fromIntegral $ unSeconds backoffInSeconds) t)

418423 }

419424 case fromException e :: Maybe TimeoutException of

420425 Nothing -> log logLevel $ LogJobFailed newJob e failureMode runTime

src/OddJobs/Types.hs+8

@@ -337,6 +337,14 @@ data Config = Config

337337

338338 -- | Should successful jobs be deleted from the queue to save on table space?

339339 , cfgDeleteSuccessfulJobs :: Bool

340+

341+ -- | How far into the future should jobs which can be retried be queued for?

342+ --

343+ -- The 'Int' argument is the number of times the job has been attepted. It will

344+ -- always be at least 1, since the job will have to have started at least once

345+ -- in order to fail and be retried. The default implementation is an exponential

346+ -- backoff of @'Seconds' $ 2 ^ 'jobAttempts'@.

347+ , cfgDefaultRetryBackoff :: Int -> IO Seconds

340348 }

341349

342350

test/Test.hs+30

@@ -81,6 +81,7 @@ tests appPool jobPool = testGroup "All tests"

8181 , testGracefulShutdown appPool jobPool

8282 , testJobErrHandler appPool jobPool

8383 , testPushFailedJobEndQueue jobPool

84+ , testRetryBackoff appPool jobPool

8485 ]

8586 -- , testGroup "property tests" [ testEverything appPool jobPool

8687 -- -- , propFilterJobs appPool jobPool

@@ -356,6 +357,35 @@ testJobErrHandler appPool jobPool = testCase "job error handler" $ do

356357 readMVar mvar1 >>= assertEqual "Error Handler 1 doesn't seem to have run" True

357358 readMVar mvar2 >>= assertEqual "Error Handler 2 doesn't seem to have run" True

358359

360+testRetryBackoff appPool jobPool = testCase "retry backoff" $ do

361+ withRandomTable jobPool $ \tname -> do

362+ withNamedJobMonitor tname jobPool modifyRetryBackoff $ \logRef -> do

363+ Pool.withResource appPool $ \conn -> do

364+ jobQueueTime <- getCurrentTime

365+ Job{jobId} <- Job.createJob conn tname (PayloadAlwaysFail 0)

366+ delaySeconds (2 * Job.defaultPollingInterval)

367+

368+ let assertBackedOff = do

369+ job@Job{jobAttempts, jobStatus, jobRunAt} <- ensureJobId conn tname jobId

370+ assertEqual "Exepcting job to be in Retry status" Job.Retry jobStatus

371+ assertBool "Expecting job runAt to be in the future"

372+ (jobRunAt >= addUTCTime (fromIntegral $ unSeconds $ backoff jobAttempts) jobQueueTime)

373+

374+ assertBackedOff

375+

376+ -- Run it for another attempt and check the backoff scales

377+ job <- ensureJobId conn tname jobId

378+ Job.saveJobIO conn tname (job {jobRunAt = jobQueueTime})

379+ delaySeconds (2 * Job.defaultPollingInterval)

380+

381+ assertBackedOff

382+ where

383+

384+ backoff attempts = Seconds $ 300 * attempts

385+

386+ modifyRetryBackoff cfg

387+ = cfg { Job.cfgDefaultRetryBackoff = pure . backoff }

388+

359389data JobEvent = JobStart

360390 | JobRetry

361391 | JobSuccess