Make deleting successful jobs configurable (#84)

* Make deleting successful jobs configurable * Fix newjob not being saved Co-authored-by: Jappie Klooster <[email protected]>
saurabhnanda · May 12, 2022 · 72e942d · 72e942d
1 parent 33039f3
commit 72e942d
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 2 deletions.
diff --git 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
@@ -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 newJob
         log LevelInfo $ LogJobSuccess newJob (diffUTCTime endTime startTime)
         onJobSuccess newJob
         pure ()

diff --git 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
   }