diff --git a/src/Handler/Health/Interface.hs b/src/Handler/Health/Interface.hs index c43ffaed8..1b6ee1dee 100644 --- a/src/Handler/Health/Interface.hs +++ b/src/Handler/Health/Interface.hs @@ -67,27 +67,30 @@ matchesUniqueInterfaceHealth (UniqueInterfaceHealth ai as aw) (UniqueInterfaceHe eqOrNothing a b = a == b -getHealthInterfaceR :: [Text] -> Handler Html -getHealthInterfaceR ris = do - let (forced, ris') = case ris of - ("force":ris0) -> (True , ris0) - _ -> (False, ris ) - interfs = splitInterfaces $ identifyInterfaces ris' +getHealthInterfaceR :: [Text] -> Handler TypedContent +getHealthInterfaceR (dropWhile (=="force") -> ris) = do -- for backwards compatibility we ignore leading "force" + let interfs = splitInterfaces $ identifyInterfaces ris (missing, allok, res, iltable) <- runInterfaceLogTable interfs - let badMsg = "Unhealthy interfaces: " <> Text.intercalate ", " [iface | (iface, False) <- res] when missing notFound -- send 404 if any requested interface was not found - unless (forced || allok) $ sendResponseStatus internalServerError500 badMsg - content <- siteLayoutMsg MsgMenuHealthInterface $ do - setTitleI MsgMenuHealthInterface - [whamlet| - $if allok - Interfaces are healthy. - $else - #{badMsg} + let respond = sendResponseStatus (bool internalServerError500 status200 allok) + plainMsg = if allok + then "Interfaces are healthy" + else "Unhealthy interfaces: " <> Text.intercalate ", " [iface | (iface, False) <- res] + selectRep $ do + provideRep $ do + content <- siteLayoutMsg MsgMenuHealthInterface $ do + setTitleI MsgMenuHealthInterface + [whamlet| +