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

chore(health): add HealthStatus HealthInactive

Browse Source
This commit is contained in:
Steffen Jost 2023-07-12 10:47:15 +00:00
parent c596491e49
commit 1b224630eb
4 changed files with 43 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/categories/health/de-de-formal.msg
View File

@ -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

2
src/Application.hs
View File

@ -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

38
src/Handler/Health.hs
View File

@ -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}
<hr>
<dl .deflist>
$forall (lUp, report) <- healthReports'
$with hcclass <- classifyHealthReport report
$with hcstatus <- HealthSuccess == healthReportStatus report
$case report
$of HealthLDAPAdmins (Just found)
<dt .deflist__dt>_{MsgHealthCheckLDAPAdmins}
<dd .deflist__dd>#{textPercent found 1}
\ ^{formatTimeW SelFormatDateTime lUp}
$of HealthActiveJobExecutors (Just active)
<dt .deflist__dt>_{MsgHealthCheckActiveJobExecutors}
<dd .deflist__dd>#{textPercent active 1}
\ ^{formatTimeW SelFormatDateTime lUp}
$of _
<dt .deflist__dt>_{hcclass}
<dd .deflist__dd>#{boolSymbol hcstatus}
\ ^{formatTimeW SelFormatDateTime lUp}
$case healthReportStatus report
$of HealthInactive
$of hcstatus
<dt .deflist__dt>
_{classifyHealthReport report}
<dd .deflist__dd>
#{boolSymbol (healthOk hcstatus)} #
$case report
$of HealthLDAPAdmins (Just found)
#{textPercent found 1}
$of HealthActiveJobExecutors (Just active)
#{textPercent active 1}
$of _
<div>
^{formatTimeW SelFormatDateTime lUp}
|]
provideJson healthReports
provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReports

30
src/Model/Types/Health.hs
View File

@ -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