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

feat(system-msg): display system status messages on volatile cluster settings only

Browse Source
This commit is contained in:
Sarah Vaupel 2022-02-17 17:23:28 +01:00
parent 32bed15961
commit da253f7fbd
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Handler/News.hs
View File

@ -73,15 +73,17 @@ newsSystemMessages = do
return $ guardOn (not hidden || showHidden) (smId, sm, trans, hidden)
(messages', Any anyHidden) <- liftHandler . runDB . runConduit . C.runWriterLC $
transPipe lift (selectKeys [] [])
.| C.filterM (lift . hasReadAccessTo . MessageR <=< encrypt)
.| transPipe lift (C.mapMaybeM $ \smId -> fmap (\args@(sm, _) -> (smId, sm, systemMessageToTranslation smId args)) <$> getSystemMessage smId)
.| C.filter (\(_, SystemMessage{..}, _) -> NTop systemMessageFrom <= NTop (Just now) && NTop (Just now) < NTop systemMessageTo)
.| C.mapMaybeM checkHidden
.| C.iterM (\(smId, _, _, _) -> tellShown smId)
.| C.mapM (\(smId, sm@SystemMessage{..}, trans, hidden) -> (sm, trans, hidden,,) <$> formatTime SelFormatDateTime (maybe id max systemMessageFrom systemMessageLastChanged) <*> mkHideForm smId sm)
.| C.consume
(messages', Any anyHidden) <- liftHandler . runDB $ do
volatileClusterConfig <- selectList [] []
runConduit . C.runWriterLC $
transPipe lift (selectKeys [] [])
.| C.filterM (lift . hasReadAccessTo . MessageR <=< encrypt)
.| transPipe lift (C.mapMaybeM $ \smId -> fmap (\args@(sm, _) -> (smId, sm, systemMessageToTranslation smId args)) <$> getSystemMessage smId)
.| C.filter (\(_, SystemMessage{..}, _) -> NTop systemMessageFrom <= NTop (Just now) && NTop (Just now) < NTop systemMessageTo && all (\(k,v) -> (k,v) `elem` ((\VolatileClusterConfig{..} -> (volatileClusterConfigSetting, volatileClusterConfigValue)) . entityVal <$> volatileClusterConfig)) (Set.toList systemMessageOnVolatileClusterSettings))
.| C.mapMaybeM checkHidden
.| C.iterM (\(smId, _, _, _) -> tellShown smId)
.| C.mapM (\(smId, sm@SystemMessage{..}, trans, hidden) -> (sm, trans, hidden,,) <$> formatTime SelFormatDateTime (maybe id max systemMessageFrom systemMessageLastChanged) <*> mkHideForm smId sm)
.| C.consume
let messages = sortOn (\(SystemMessage{..}, _, _, _, _) -> (Down systemMessageManualPriority, Down $ maybe id max systemMessageFrom systemMessageLastChanged, systemMessageSeverity)) messages'
hiddenUrl <- toTextUrl (NewsR, [(toPathPiece GetHidden, "")])