Ignoring stale locks

config/settings.yml

@@ -19,6 +19,7 @@ mail-verp:
 job-workers:        "_env:JOB_WORKERS:10"
 job-flush-interval: "_env:JOB_FLUSH:30"
 job-cron-interval:  "_env:CRON_INTERVAL:60"
+job-stale-threshold: 300
 
 detailed-logging:  "_env:DETAILED_LOGGING:false"
 should-log-all:    "_env:LOG_ALL:false"

src/Jobs.hs

@@ -66,6 +66,7 @@ import qualified Control.Monad.State.Class as State
 import Control.Monad.Writer.Class (MonadWriter(..))
 import Control.Monad.Reader.Class (MonadReader(..))
 import Control.Monad.Trans.Resource (MonadResourceBase, ResourceT, runResourceT, allocate)
+import Control.Monad.Trans.Maybe (MaybeT(..))
 
 import Control.Monad.Random (MonadRandom(..), evalRand)
 
@@ -248,10 +249,21 @@ jLocked jId act = do
 
   let
     lock = runDB . setSerializable $ do
-      QueuedJob{..} <- maybe (throwM $ JNonexistant jId) return =<< get jId
+      qj@QueuedJob{..} <- maybe (throwM $ JNonexistant jId) return =<< get jId
-      maybe (return ()) throwM $ JLocked <$> pure jId <*> queuedJobLockInstance <*> queuedJobLockTime
       instanceID <- getsYesod appInstanceID
+      threshold <- getsYesod $ appJobStaleThreshold . appSettings
       now <- liftIO getCurrentTime
+      hadStale <- maybeT (return False) $ do
+        lockTime <- MaybeT $ return queuedJobLockTime
+        lockInstance <- MaybeT $ return queuedJobLockInstance
+        if
+          | lockInstance == instanceID
+          , diffUTCTime now lockTime >= threshold
+            -> return True
+          | otherwise
+            -> throwM $ JLocked jId lockInstance lockTime
+      when hadStale .
+        $logWarnS "Jobs" $ "Ignored stale lock: " <> tshow qj
       val <- updateGet jId [ QueuedJobLockInstance =. Just instanceID
                            , QueuedJobLockTime =. Just now
                            ]

src/Settings.hs

@@ -85,6 +85,7 @@ data AppSettings = AppSettings
     , appJobWorkers             :: Int
     , appJobFlushInterval       :: Maybe NominalDiffTime
     , appJobCronInterval        :: NominalDiffTime
+    , appJobStaleThreshold      :: NominalDiffTime
 
     , appDetailedRequestLogging :: Bool
     -- ^ Use detailed request logging system
@@ -276,6 +277,7 @@ instance FromJSON AppSettings where
         appJobWorkers             <- o .:  "job-workers"
         appJobFlushInterval       <- o .:? "job-flush-interval"
         appJobCronInterval        <- o .:  "job-cron-interval"
+        appJobStaleThreshold      <- o .:  "job-stale-threshold"
 
         appDetailedRequestLogging <- o .:? "detailed-logging" .!= defaultDev
         appShouldLogAll           <- o .:? "should-log-all"   .!= defaultDev