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

git.iko.soy/odd-jobs

on master help sign in

Merge pull request #83 from SupercedeTech/retry-backoff

154855bIsaac van Bakel4 years ago

src/OddJobs/ConfigBuilder.hs+1

compare with master

unifiedsplit

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

69 , cfgJobType = defaultJobType

70 , cfgDefaultJobTimeout = Seconds 600

71 , cfgDeleteSuccessfulJobs = True

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

72 }

73 }

73 in cfg

74 in cfg

src/OddJobs/Job.hs+7−2

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

142 getConcurrencyControl :: m ConcurrencyControl

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

144 getDefaultJobTimeout :: m Seconds

145−

145+ getDefaultRetryBackoff :: Int -> m Seconds

146

147-- $logging

148--

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

195

196 getDefaultJobTimeout = cfgDefaultJobTimeout . envConfig <$> ask

197

198+ getDefaultRetryBackoff attempts = do

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

200+ liftIO $ retryFn attempts

201+

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

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

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

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

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

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

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

410 then ( Failed, FailPermanent, LevelError )

414 then ( Failed, FailPermanent, LevelError )

411 else ( Retry, FailWithRetry, LevelWarn )

415 else ( Retry, FailWithRetry, LevelWarn )

412 t <- liftIO getCurrentTime

416 t <- liftIO getCurrentTime

417+ backoffInSeconds <- getDefaultRetryBackoff jobAttempts

413 newJob <- saveJob job{ jobStatus=newStatus

418 newJob <- saveJob job{ jobStatus=newStatus

414 , jobLockedBy=Nothing

419 , jobLockedBy=Nothing

415 , jobLockedAt=Nothing

420 , jobLockedAt=Nothing

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

421 , 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)

418 }

423 }

419 case fromException e :: Maybe TimeoutException of

424 case fromException e :: Maybe TimeoutException of

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

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

src/OddJobs/Types.hs+8

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

337

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

339 , 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

340 }

348 }

341

349

342

350

test/Test.hs+30

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

81 , testGracefulShutdown appPool jobPool

82 , testJobErrHandler appPool jobPool

83 , testPushFailedJobEndQueue jobPool

84+ , testRetryBackoff appPool jobPool

84 ]

85 ]

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

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

86 -- -- , propFilterJobs appPool jobPool

87 -- -- , propFilterJobs appPool jobPool

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

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

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

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

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

358

359

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+

359data JobEvent = JobStart

389data JobEvent = JobStart

360 | JobRetry

390 | JobRetry

361 | JobSuccess

391 | JobSuccess