fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Debounce notifications much more aggressively

Browse Source 
Fixes #251
This commit is contained in:
Gregor Kleen 2018-12-05 22:03:10 +01:00
parent 1941338075
commit aea7837c49
1 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Jobs.hs
View File

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