From 0d4a09b8954cd1e8f9a70af901531d2e8eed6bb3 Mon Sep 17 00:00:00 2001 From: Isaac van Bakel Date: Thu, 11 Nov 2021 10:50:17 +0000 Subject: [PATCH 1/2] Make deleting successful jobs configurable --- src/OddJobs/ConfigBuilder.hs | 1 + src/OddJobs/Job.hs | 11 +++++++++-- src/OddJobs/Types.hs | 3 +++ 3 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/OddJobs/ConfigBuilder.hs b/src/OddJobs/ConfigBuilder.hs index 07e9016..ee52cd5 100644 --- a/src/OddJobs/ConfigBuilder.hs +++ b/src/OddJobs/ConfigBuilder.hs @@ -68,6 +68,7 @@ mkConfig logger tname dbpool ccControl jrunner configOverridesFn = , cfgConcurrencyControl = ccControl , cfgJobType = defaultJobType , cfgDefaultJobTimeout = Seconds 600 + , cfgDeleteSuccessfulJobs = True } in cfg diff --git a/src/OddJobs/Job.hs b/src/OddJobs/Job.hs index 43d60b5..f73317c 100644 --- a/src/OddJobs/Job.hs +++ b/src/OddJobs/Job.hs @@ -131,6 +131,7 @@ import Database.PostgreSQL.Simple.ToField as PGS (toField) class (MonadUnliftIO m, MonadBaseControl IO m) => HasJobRunner m where getPollingInterval :: m Seconds onJobSuccess :: Job -> m () + deleteSuccessfulJobs :: m Bool onJobFailed :: m [JobErrHandler] getJobRunner :: m (Job -> IO ()) getDbPool :: m (Pool Connection) @@ -169,9 +170,12 @@ logCallbackErrors jid msg action = catchAny action $ \e -> log LevelError $ LogT instance HasJobRunner RunnerM where getPollingInterval = cfgPollingInterval . envConfig <$> ask onJobFailed = cfgOnJobFailed . envConfig <$> ask + onJobSuccess job = do fn <- cfgOnJobSuccess . envConfig <$> ask logCallbackErrors (jobId job) "onJobSuccess" $ liftIO $ fn job + deleteSuccessfulJobs = cfgDeleteSuccessfulJobs . envConfig <$> ask + getJobRunner = cfgJobRunner . envConfig <$> ask getDbPool = cfgDbPool . envConfig <$> ask getTableName = cfgTableName . envConfig <$> ask @@ -387,8 +391,11 @@ runJob jid = do (flip catches) [Handler $ timeoutHandler job startTime, Handler $ exceptionHandler job startTime] $ do runJobWithTimeout lockTimeout job endTime <- liftIO getCurrentTime - deleteJob jid - let newJob = job{jobStatus=Success, jobLockedBy=Nothing, jobLockedAt=Nothing} + shouldDeleteJob <- deleteSuccessfulJobs + let newJob = job{jobStatus=Success, jobLockedBy=Nothing, jobLockedAt=Nothing, jobUpdatedAt = endTime} + if shouldDeleteJob + then deleteJob jid + else void $ saveJob job log LevelInfo $ LogJobSuccess newJob (diffUTCTime endTime startTime) onJobSuccess newJob pure () diff --git a/src/OddJobs/Types.hs b/src/OddJobs/Types.hs index b2b6978..74fddd7 100644 --- a/src/OddJobs/Types.hs +++ b/src/OddJobs/Types.hs @@ -334,6 +334,9 @@ data Config = Config -- | How long can a job run after which it is considered to be "crashed" and -- picked up for execution again , cfgDefaultJobTimeout :: Seconds + + -- | Should successful jobs be deleted from the queue to save on table space? + , cfgDeleteSuccessfulJobs :: Bool } From b7ddab180860ca8de20d4c65431543935ca248cf Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Thu, 18 Nov 2021 15:08:20 +0100 Subject: [PATCH 2/2] Fix newjob not being saved --- src/OddJobs/Job.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/OddJobs/Job.hs b/src/OddJobs/Job.hs index f73317c..5938b1a 100644 --- a/src/OddJobs/Job.hs +++ b/src/OddJobs/Job.hs @@ -395,7 +395,7 @@ runJob jid = do let newJob = job{jobStatus=Success, jobLockedBy=Nothing, jobLockedAt=Nothing, jobUpdatedAt = endTime} if shouldDeleteJob then deleteJob jid - else void $ saveJob job + else void $ saveJob newJob log LevelInfo $ LogJobSuccess newJob (diffUTCTime endTime startTime) onJobSuccess newJob pure ()