diff --git a/src/Jobs.hs b/src/Jobs.hs index 45a5f74f6..9385eeff4 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -134,6 +134,7 @@ execCrontab = evalStateT go HashMap.empty runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ merge refT <- liftIO getCurrentTime + settings <- getsYesod appSettings currentState <- mapStateT (mapReaderT $ liftIO . atomically) $ do crontab' <- liftBase . tryReadTMVar =<< asks jobCrontab case crontab' of @@ -141,7 +142,7 @@ execCrontab = evalStateT go HashMap.empty Just crontab -> Just <$> do State.modify . HashMap.filterWithKey $ \k _ -> HashMap.member k crontab prevExec <- State.get - case earliestJob prevExec crontab refT of + case earliestJob settings prevExec crontab refT of Nothing -> liftBase retry Just (_, MatchNone) -> liftBase retry Just x -> return (crontab, x) @@ -189,6 +190,11 @@ execCrontab = evalStateT go HashMap.empty acc :: NominalDiffTime acc = 1e-3 + debouncingAcc :: AppSettings -> JobCtl -> NominalDiffTime + debouncingAcc AppSettings{appNotificationRateLimit} = \case + JobCtlQueue (JobQueueNotification _) -> appNotificationRateLimit + _ -> acc + applyJitter :: (MonadHandler m, HandlerSite m ~ UniWorX, Hashable seed) => seed -> UTCTime -> m UTCTime applyJitter seed t = do appInstance <- getsYesod appInstanceID @@ -197,8 +203,8 @@ execCrontab = evalStateT go HashMap.empty diff = evalRand ( (* acc) . fromInteger <$> getRandomR (- halfRange, halfRange)) $ mkStdGen (hash appInstance `hashWithSalt` seed) return $ addUTCTime diff t - earliestJob :: HashMap JobCtl (Max UTCTime) -> Crontab JobCtl -> UTCTime -> Maybe (JobCtl, CronNextMatch UTCTime) - earliestJob lastTimes crontab now = foldr go' Nothing $ HashMap.toList crontab + earliestJob :: AppSettings -> HashMap JobCtl (Max UTCTime) -> Crontab JobCtl -> UTCTime -> Maybe (JobCtl, CronNextMatch UTCTime) + earliestJob settings lastTimes crontab now = foldr go' Nothing $ HashMap.toList crontab where go' (jobCtl, cron) mbPrev | Just (_, t') <- mbPrev @@ -207,7 +213,7 @@ execCrontab = evalStateT go HashMap.empty | otherwise = Just (jobCtl, t) where - t = nextCronMatch appTZ (getMax <$> HashMap.lookup jobCtl lastTimes) acc now cron + t = nextCronMatch appTZ (getMax <$> HashMap.lookup jobCtl lastTimes) (debouncingAcc settings jobCtl) now cron waitUntil :: (Eq a, MonadResourceBase m, MonadLogger m) => TMVar a -> a -> UTCTime -> m Bool waitUntil crontabTV crontab nextTime = runResourceT $ do