diff --git a/messages/uniworx/categories/health/de-de-formal.msg b/messages/uniworx/categories/health/de-de-formal.msg index 429a37e47..75aa473dd 100644 --- a/messages/uniworx/categories/health/de-de-formal.msg +++ b/messages/uniworx/categories/health/de-de-formal.msg @@ -9,7 +9,7 @@ HealthCheckLDAPAdmins: Anteil der Administrator:innen mit LDAP Authentifizierung HealthCheckSMTPConnect: SMTP-Server kann erreicht werden HealthCheckWidgetMemcached: Memcached-Server liefert Widgets korrekt aus HealthCheckActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen -HealthCheckDoesFlush: Zustandspüfung läuft durch +HealthCheckDoesFlush: Zustandsprüfung läuft durch InstanceIdentification: Instanz-Identifikation InstanceId: Instanz-Nummer ClusterId: Cluster-Nummer \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index 6592a8342..0181d2cf0 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -551,7 +551,7 @@ warpSettings foundation = defaultSettings atomically $ do results <- readTVar $ foundation ^. _appHealthReport guard $ activeChecks == Set.map (classifyHealthReport . snd) results - guard . (== Min HealthSuccess) $ foldMap (Min . healthReportStatus . snd) results + guard . (/= Min HealthFailure) $ foldMap (Min . healthReportStatus . snd) results notifyReady | otherwise -> notifyReady diff --git a/src/Handler/Health.hs b/src/Handler/Health.hs index b19e90a7e..e06f688ae 100644 --- a/src/Handler/Health.hs +++ b/src/Handler/Health.hs @@ -48,10 +48,10 @@ getHealthR = do setLastModified lastUpdated let status' - | HealthSuccess <- status - = ok200 - | otherwise + | HealthFailure <- status = internalServerError500 + | otherwise + = ok200 sendResponseStatus status' <=< selectRep $ do provideRep . siteLayoutMsg MsgHealthReport $ do setTitleI MsgHealthReport @@ -61,26 +61,28 @@ getHealthR = do $case status $of HealthSuccess _{MsgMessageSuccess} + $of HealthInactive + _{MsgMessageWarning} $of _ _{MsgMessageError}
$forall (lUp, report) <- healthReports' - $with hcclass <- classifyHealthReport report - $with hcstatus <- HealthSuccess == healthReportStatus report - $case report - $of HealthLDAPAdmins (Just found) -
_{MsgHealthCheckLDAPAdmins} -
#{textPercent found 1} - \ ^{formatTimeW SelFormatDateTime lUp} - $of HealthActiveJobExecutors (Just active) -
_{MsgHealthCheckActiveJobExecutors} -
#{textPercent active 1} - \ ^{formatTimeW SelFormatDateTime lUp} - $of _ -
_{hcclass} -
#{boolSymbol hcstatus} - \ ^{formatTimeW SelFormatDateTime lUp} + $case healthReportStatus report + $of HealthInactive + $of hcstatus +
+ _{classifyHealthReport report} +
+ #{boolSymbol (healthOk hcstatus)} # + $case report + $of HealthLDAPAdmins (Just found) + #{textPercent found 1} + $of HealthActiveJobExecutors (Just active) + #{textPercent active 1} + $of _ +
+ ^{formatTimeW SelFormatDateTime lUp} |] provideJson healthReports provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReports diff --git a/src/Model/Types/Health.hs b/src/Model/Types/Health.hs index 6528232bc..36f4be750 100644 --- a/src/Model/Types/Health.hs +++ b/src/Model/Types/Health.hs @@ -78,7 +78,7 @@ classifyHealthReport HealthDoesFlush{} = HealthCheckDoesFlush -- -- Currently all consumers of this type check for @(== HealthSuccess)@; this -- needs to be adjusted on a case-by-case basis if new constructors are added -data HealthStatus = HealthFailure | HealthSuccess +data HealthStatus = HealthFailure | HealthInactive | HealthSuccess deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) instance Universe HealthStatus @@ -89,17 +89,29 @@ deriveJSON defaultOptions } ''HealthStatus nullaryPathPiece ''HealthStatus $ camelToPathPiece' 1 +healthOk :: HealthStatus -> Bool +healthOk HealthFailure = False +healthOk HealthInactive = True +healthOk HealthSuccess = True + healthReportStatus :: HealthReport -> HealthStatus -- ^ Classify `HealthReport` by badness -healthReportStatus = \case - HealthMatchingClusterConfig False -> HealthFailure - HealthHTTPReachable (Just False) -> HealthFailure +healthReportStatus = \case + HealthMatchingClusterConfig True -> HealthSuccess + HealthHTTPReachable (Just True ) -> HealthSuccess + HealthHTTPReachable Nothing -> HealthInactive HealthLDAPAdmins (Just prop ) - | prop <= 0 -> HealthFailure - HealthSMTPConnect (Just False) -> HealthFailure + | prop > 0 -> HealthSuccess + HealthLDAPAdmins Nothing -> HealthInactive + HealthSMTPConnect (Just True ) -> HealthSuccess + HealthSMTPConnect Nothing -> HealthInactive HealthWidgetMemcached (Just False) -> HealthFailure -- TODO: investigate this failure mode; do we just handle it gracefully? + HealthWidgetMemcached (Just True ) -> HealthSuccess + HealthWidgetMemcached Nothing -> HealthInactive + HealthActiveJobExecutors Nothing -> HealthInactive HealthActiveJobExecutors (Just prop ) - | prop <= 0 -> HealthFailure + | prop > 0 -> HealthSuccess HealthDoesFlush mProp - | maybe True (>= 2) mProp -> HealthFailure - _other -> maxBound -- Minimum badness + | maybe True (>= 2) mProp -> HealthFailure -- Looks buggy to me? + | otherwise -> HealthSuccess + _other -> HealthFailure