Make deleting successful jobs configurable

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
 

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 ()

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
   }