fix(jobs): flush only partially for reliability

src/Jobs.hs

@@ -498,9 +498,12 @@ handleJobs' wNum = C.mapM_ $ \jctl -> hoist delimitInternalState . withJobWorker
     handleCmd JobCtlTest = $logDebugS logIdent "JobCtlTest"
     handleCmd JobCtlFlush = do
       $logDebugS logIdent "JobCtlFlush..."
+      maxFlush <- getsYesod $ view _appJobMaxFlush
+      let selectOpts = [ Asc QueuedJobCreationTime ]
+                     & maybe id (\maxCount -> (:) (LimitTo $ fromIntegral maxCount)) maxFlush
       heldLocks <- asks jobHeldLocks >>= readTVarIO
       void . lift . runDB . runConduit
-        $ selectKeys [ QueuedJobId /<-. Set.toList heldLocks ] [ Asc QueuedJobCreationTime ]
+        $ selectKeys [ QueuedJobId /<-. Set.toList heldLocks ] selectOpts
        .| C.mapM_ (\j -> lift $ runReaderT (writeJobCtl $ JobCtlPerform j) =<< getYesod)
       lFlushTVar <- asks jobLastFlush
       atomically . modifyTVar' lFlushTVar . max . Just =<< liftIO getCurrentTime

src/Jobs/Crontab.hs

@@ -179,7 +179,7 @@ determineCrontab = execWriterT $ do
   
   when (isn't _JobsOffload appJobMode) $ do
     case appJobFlushInterval of
-      Just interval -> tell $ HashMap.singleton
+      Just interval | maybe True (> 0) appJobMaxFlush -> tell $ HashMap.singleton
         JobCtlFlush
         Cron
           { cronInitial = CronAsap
@@ -187,7 +187,7 @@ determineCrontab = execWriterT $ do
           , cronRateLimit = interval
           , cronNotAfter = Right CronNotScheduled
           }
-      Nothing -> return ()
+      _other -> return ()
 
     oldestInvitationMUTC <- lift $ preview (_head . _entityVal . _invitationExpiresAt . _Just) <$> selectList [InvitationExpiresAt !=. Nothing] [Asc InvitationExpiresAt, LimitTo 1]
     whenIsJust oldestInvitationMUTC $ \oldestInvUTC -> tell $ HashMap.singleton

src/Model/Types/Health.hs

@@ -94,6 +94,6 @@ healthReportStatus = \case
   HealthWidgetMemcached       (Just False) -> HealthFailure -- TODO: investigate this failure mode; do we just handle it gracefully?
   HealthActiveJobExecutors    (Just prop )
     | prop <= 0                            -> HealthFailure
-  HealthDoesFlush             (Just prop )
-    | prop >= 1                            -> HealthFailure
+  HealthDoesFlush              mProp
+    | maybe True (>= 2) mProp              -> HealthFailure
   _other                                   -> maxBound -- Minimum badness

src/Settings.hs

@@ -224,6 +224,8 @@ data AppSettings = AppSettings
     , appBotMitigations         :: Set SettingBotMitigation
 
     , appVolatileClusterSettingsCacheTime :: DiffTime
+
+    , appJobMaxFlush           :: Maybe Natural
     } deriving Show
 
 data JobMode = JobsLocal { jobsAcceptOffload :: Bool }
@@ -404,6 +406,10 @@ nullaryPathPiece ''SettingBotMitigation $ camelToPathPiece' 3
 pathPieceJSON ''SettingBotMitigation
 pathPieceJSONKey ''SettingBotMitigation
 
+makePrisms ''JobMode
+makeLenses_ ''JobMode
+
+
 instance FromJSON LdapConf where
     parseJSON = withObject "LdapConf" $ \o -> do
         ldapTls <- o .:? "tls"
@@ -564,7 +570,12 @@ instance FromJSON AppSettings where
         appBearerExpiration       <- o .:? "bearer-expiration"
         appBearerEncoding         <- o .: "bearer-encoding"
 
-        appHealthCheckInterval    <- (assertM' (> 0) . ) <$> o .: "health-check-interval"
+        appJobMode <- o .:? "job-mode" .!= JobsLocal True
+
+        let hciOverride :: HealthCheck -> Maybe NominalDiffTime -> Maybe NominalDiffTime
+            hciOverride HealthCheckDoesFlush _ | is _JobsOffload appJobMode = Nothing
+            hciOverride _ mInterval = mInterval
+        appHealthCheckInterval    <- (\f hc -> hciOverride hc . assertM' (> 0) $ f hc) <$> o .: "health-check-interval"
         appHealthCheckDelayNotify <- o .:  "health-check-delay-notify"
         appHealthCheckHTTP        <- o .:  "health-check-http"
 
@@ -662,8 +673,6 @@ instance FromJSON AppSettings where
 
         appDownloadTokenExpire <- o .: "download-token-expire"
 
-        appJobMode <- o .:? "job-mode" .!= JobsLocal True
-
         appStudyFeaturesRecacheRelevanceWithin   <- o .:? "study-features-recache-relevance-within"
         appStudyFeaturesRecacheRelevanceInterval <- o .:  "study-features-recache-relevance-interval"
 
@@ -682,6 +691,8 @@ instance FromJSON AppSettings where
 
         appVolatileClusterSettingsCacheTime <- o .: "volatile-cluster-settings-cache-time"
 
+        appJobMaxFlush <- o .:? "job-max-flush"
+
         return AppSettings{..}
       where isValidARCConf ARCConf{..} = arccMaximumWeight > 0
 

src/Utils/Lens.hs

@@ -5,7 +5,6 @@
 module Utils.Lens ( module Utils.Lens ) where
 
 import Import.NoModel
-import Settings
 import Model
 import Model.Rating
 import qualified ClassyPrelude.Yesod as Yesod (HasHttpManager(..))
@@ -277,9 +276,6 @@ makePrisms ''AllocationPriority
 makePrisms ''RoomReference
 makeLenses_ ''RoomReference
 
-makePrisms ''JobMode
-makeLenses_ ''JobMode
-
 -- makeClassy_ ''Load
 
 makePrisms ''SchoolAuthorshipStatementMode