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