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

refactor(health): interface-health

Browse Source 
- send text/plain by default
- attempt to fix negative sub-filters for interface health
This commit is contained in:
Steffen Jost 2024-02-06 15:37:00 +00:00
parent 4a843fe30e
commit 2a0bca1230
2 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Handler/Health/Interface.hs
View File

@ -76,18 +76,16 @@ getHealthInterfaceR (dropWhile (=="force") -> ris) = do -- for bac
else internalServerError500
plainMsg = if allok then "Interfaces are healthy."
else "Unhealthy interfaces: " <> Text.intercalate ", " [iface | (iface, False) <- res]
sendResponseStatus ihstatus <=< selectRep $ do
provideRep . siteLayoutMsg MsgMenuHealthInterface $ do
sendResponseStatus ihstatus <=< selectRep $ do -- most browsers send accept:text/html, thus text/plain can be default here
provideRep . return . RepPlain $ toContent plainMsg -- /?_accept=text/plain
provideRep . siteLayoutMsg MsgMenuHealthInterface $ do -- /?_accept=text/html
setTitleI MsgMenuHealthInterface
[whamlet|
<div>
#{plainMsg}
<div>
^{iltable}
|]
provideRep $ return $ RepPlain $ toContent plainMsg
|]
runInterfaceLogTable :: ReqBanInterfaceHealth -> Handler (Bool, Bool, [(Text,Bool)], Widget)
@ -105,6 +103,12 @@ runInterfaceLogTable interfs@(reqIfs,_) = do
-- ihDebugShow :: Unique InterfaceHealth -> Text
-- ihDebugShow (UniqueInterfaceHealth i s w) = "(" <> tshow i <> tshow s <> tshow w <> ")"
-- | like (=~.) but avoids condition entirely if second argument is Nothing; Note that using =~. with E.val Nothing did not work somehow!
infixl 4 ~~.
(~~.) :: PersistField typ => E.SqlExpr (E.Value typ) -> Maybe typ -> E.SqlExpr (E.Value Bool)
(~~.) a Nothing = E.true
(~~.) a (Just b) = a E.==. E.val b
mkInterfaceLogTable :: (Bool -> Widget) -> ReqBanInterfaceHealth -> DB ([(Text,Bool)], Widget)
mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do
-- $logWarnS "DEBUG" $ tshow ([ihDebugShow x | x<- reqIfs], [ihDebugShow x | x<- banIfs])
@ -122,8 +126,8 @@ mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do
)
let matchUIH crits = E.or
[ ilog E.^. InterfaceLogInterface E.==. E.val (sanitize ifce)
E.&&. ilog E.^. InterfaceLogSubtype E.=~. E.val (sanitize <$> subt)
E.&&. ilog E.^. InterfaceLogWrite E.=~. E.val writ
E.&&. ilog E.^. InterfaceLogSubtype ~~. (sanitize <$> subt)
E.&&. ilog E.^. InterfaceLogWrite ~~. writ
| (UniqueInterfaceHealth ifce subt writ) <- crits
]
unless (null reqIfs) $ E.where_ $ matchUIH reqIfs

4
src/Model/Migration/Definitions.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
@ -125,7 +125,7 @@ migrateAlwaysSafe = do
in sql
-- unless (tableExists "interface_health") $ do
-- [executeQQ|
-- INSERT INTO "interface_health" (interface, subtype, write, hours)
-- INSERT INTO "interface_health" ("interface", "subtype", "write", "hours")
-- VALUES
-- ('Printer', 'Acknowledge', True, 168)
-- , ('AVS' , 'Synch' , True , 96)