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

Fix notification delay

Browse Source
This commit is contained in:
Gregor Kleen 2019-05-26 13:09:12 +02:00
parent e83df05a69
commit 679fb7cf9b
1 changed files with 27 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/Application.hs
View File

@ -425,29 +425,36 @@ appMain = runResourceT $ do
Just wInterval Just wInterval
| maybe True (== myProcessID) watchdogProcess | maybe True (== myProcessID) watchdogProcess
-> let notifyWatchdog :: IO () -> let notifyWatchdog :: IO ()
notifyWatchdog = runAppLoggingT foundation . forever $ do notifyWatchdog = runAppLoggingT foundation $ go Nothing
d <- liftIO . newDelay . floor $ wInterval % 2 where
go pStatus = do
d <- liftIO . newDelay . floor $ wInterval % 2
status <- atomically $ asum status <- atomically $ asum
[ Nothing <$ waitDelay d [ Nothing <$ waitDelay d
, Just <$> do , Just <$> do
results <- readTVar $ foundation ^. _appHealthReport results <- readTVar $ foundation ^. _appHealthReport
case fromNullable results of case fromNullable results of
Nothing -> retry Nothing -> retry
Just rs -> return $ ofoldMap1 (Max *** Min . healthReportStatus) rs Just rs -> do
] let status = ofoldMap1 (Max *** Min . healthReportStatus) rs
guard $ maybe True (/= status) pStatus
return status
]
case status of case status of
Just (_, Min status') -> do Just (_, Min status') -> do
$logInfoS "NotifyStatus" $ toPathPiece status' $logInfoS "NotifyStatus" $ toPathPiece status'
liftIO . void . Systemd.notifyStatus . unpack $ toPathPiece status' liftIO . void . Systemd.notifyStatus . unpack $ toPathPiece status'
Nothing -> return () Nothing -> return ()
case status of case status of
Just (_, Min HealthSuccess) -> do Just (_, Min HealthSuccess) -> do
$logInfoS "NotifyWatchdog" "Notify" $logInfoS "NotifyWatchdog" "Notify"
liftIO $ void Systemd.notifyWatchdog liftIO $ void Systemd.notifyWatchdog
_other -> return () _other -> return ()
go status
in void $ allocate (async notifyWatchdog >>= \a -> a <$ link a) cancel in void $ allocate (async notifyWatchdog >>= \a -> a <$ link a) cancel
_other -> return () _other -> return ()