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

refactor(health): simplfy code following HealthR handler

Browse Source
This commit is contained in:
Steffen Jost 2024-02-06 10:48:54 +00:00
parent 42f1a802b5
commit 4a843fe30e
1 changed files with 10 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -68,28 +68,25 @@ matchesUniqueInterfaceHealth (UniqueInterfaceHealth ai as aw) (UniqueInterfaceHe
getHealthInterfaceR :: [Text] -> Handler TypedContent getHealthInterfaceR :: [Text] -> Handler TypedContent
getHealthInterfaceR (dropWhile (=="force") -> ris) = do -- for backwards compatibility we ignore leading "force" getHealthInterfaceR (dropWhile (=="force") -> ris) = do -- for backwards compatibility we ignore leading "force"
let interfs = splitInterfaces $ identifyInterfaces ris let interfs = splitInterfaces $ identifyInterfaces ris
(missing, allok, res, iltable) <- runInterfaceLogTable interfs (missing, allok, res, iltable) <- runInterfaceLogTable interfs
when missing notFound -- send 404 if any requested interface was not found when missing notFound -- send 404 if any requested interface was not found
let respond = sendResponseStatus (bool internalServerError500 status200 allok) let ihstatus = if allok then status200
plainMsg = if allok else internalServerError500
then "Interfaces are healthy" plainMsg = if allok then "Interfaces are healthy."
else "Unhealthy interfaces: " <> Text.intercalate ", " [iface | (iface, False) <- res] else "Unhealthy interfaces: " <> Text.intercalate ", " [iface | (iface, False) <- res]
selectRep $ do sendResponseStatus ihstatus <=< selectRep $ do
provideRep $ do provideRep . siteLayoutMsg MsgMenuHealthInterface $ do
content <- siteLayoutMsg MsgMenuHealthInterface $ do
setTitleI MsgMenuHealthInterface setTitleI MsgMenuHealthInterface
[whamlet| [whamlet|
<div> <div>
#{plainMsg} #{plainMsg}
<div> <div>
^{iltable} ^{iltable}
|] |]
respond content
provideRep $ do provideRep $ return $ RepPlain $ toContent plainMsg
respond $ RepPlain $ toContent plainMsg