diff --git a/src/Jobs.hs b/src/Jobs.hs index bbc298877..7fe2fcf9c 100644 --- a/src/Jobs.hs +++ b/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 diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index b1bb1d05a..b690ddf2c 100644 --- a/src/Jobs/Crontab.hs +++ b/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 diff --git a/src/Model/Types/Health.hs b/src/Model/Types/Health.hs index 137810be8..493d021b0 100644 --- a/src/Model/Types/Health.hs +++ b/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 diff --git a/src/Settings.hs b/src/Settings.hs index 743c0120a..c9ab18286 100644 --- a/src/Settings.hs +++ b/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 diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 048a6f49d..6e13afc09 100644 --- a/src/Utils/Lens.hs +++ b/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