fraport/fradrive-old
Archived
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 HealthCheckSMTPConnect: SMTP-Server kann erreicht werden
HealthCheckWidgetMemcached: Memcached-Server liefert Widgets korrekt aus HealthCheckWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
HealthCheckActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen HealthCheckActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen
HealthCheckDoesFlush: Zustandspüfung läuft durch HealthCheckDoesFlush: Zustandsprüfung läuft durch
InstanceIdentification: Instanz-Identifikation InstanceIdentification: Instanz-Identifikation
InstanceId: Instanz-Nummer InstanceId: Instanz-Nummer
ClusterId: Cluster-Nummer ClusterId: Cluster-Nummer

2
src/Application.hs
View File

@ -551,7 +551,7 @@ warpSettings foundation = defaultSettings
atomically $ do atomically $ do
results <- readTVar $ foundation ^. _appHealthReport results <- readTVar $ foundation ^. _appHealthReport
guard $ activeChecks == Set.map (classifyHealthReport . snd) results guard $ activeChecks == Set.map (classifyHealthReport . snd) results
guard . (== Min HealthSuccess) $ foldMap (Min . healthReportStatus . snd) results guard . (/= Min HealthFailure) $ foldMap (Min . healthReportStatus . snd) results
notifyReady notifyReady
| otherwise | otherwise
-> notifyReady -> notifyReady

38
src/Handler/Health.hs
View File

@ -48,10 +48,10 @@ getHealthR = do
setLastModified lastUpdated setLastModified lastUpdated
let status' let status'
| HealthSuccess <- status | HealthFailure <- status
= ok200
| otherwise
= internalServerError500 = internalServerError500
| otherwise
= ok200
sendResponseStatus status' <=< selectRep $ do sendResponseStatus status' <=< selectRep $ do
provideRep . siteLayoutMsg MsgHealthReport $ do provideRep . siteLayoutMsg MsgHealthReport $ do
setTitleI MsgHealthReport setTitleI MsgHealthReport
@ -61,26 +61,28 @@ getHealthR = do
$case status $case status
$of HealthSuccess $of HealthSuccess
_{MsgMessageSuccess} _{MsgMessageSuccess}
$of HealthInactive
_{MsgMessageWarning}
$of _ $of _
_{MsgMessageError} _{MsgMessageError}
<hr> <hr>
<dl .deflist> <dl .deflist>
$forall (lUp, report) <- healthReports' $forall (lUp, report) <- healthReports'
$with hcclass <- classifyHealthReport report $case healthReportStatus report
$with hcstatus <- HealthSuccess == healthReportStatus report $of HealthInactive
$case report $of hcstatus
$of HealthLDAPAdmins (Just found) <dt .deflist__dt>
<dt .deflist__dt>_{MsgHealthCheckLDAPAdmins} _{classifyHealthReport report}
<dd .deflist__dd>#{textPercent found 1} <dd .deflist__dd>
\ ^{formatTimeW SelFormatDateTime lUp} #{boolSymbol (healthOk hcstatus)} #
$of HealthActiveJobExecutors (Just active) $case report
<dt .deflist__dt>_{MsgHealthCheckActiveJobExecutors} $of HealthLDAPAdmins (Just found)
<dd .deflist__dd>#{textPercent active 1} #{textPercent found 1}
\ ^{formatTimeW SelFormatDateTime lUp} $of HealthActiveJobExecutors (Just active)
$of _ #{textPercent active 1}
<dt .deflist__dt>_{hcclass} $of _
<dd .deflist__dd>#{boolSymbol hcstatus} <div>
\ ^{formatTimeW SelFormatDateTime lUp} ^{formatTimeW SelFormatDateTime lUp}
|] |]
provideJson healthReports provideJson healthReports
provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReports provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReports

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

@ -78,7 +78,7 @@ classifyHealthReport HealthDoesFlush{} = HealthCheckDoesFlush
-- --
-- Currently all consumers of this type check for @(== HealthSuccess)@; this -- 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 -- 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) deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
instance Universe HealthStatus instance Universe HealthStatus
@ -89,17 +89,29 @@ deriveJSON defaultOptions
} ''HealthStatus } ''HealthStatus
nullaryPathPiece ''HealthStatus $ camelToPathPiece' 1 nullaryPathPiece ''HealthStatus $ camelToPathPiece' 1
healthOk :: HealthStatus -> Bool
healthOk HealthFailure = False
healthOk HealthInactive = True
healthOk HealthSuccess = True
healthReportStatus :: HealthReport -> HealthStatus healthReportStatus :: HealthReport -> HealthStatus
-- ^ Classify `HealthReport` by badness -- ^ Classify `HealthReport` by badness
healthReportStatus = \case healthReportStatus = \case
HealthMatchingClusterConfig False -> HealthFailure HealthMatchingClusterConfig True -> HealthSuccess
HealthHTTPReachable (Just False) -> HealthFailure HealthHTTPReachable (Just True ) -> HealthSuccess
HealthHTTPReachable Nothing -> HealthInactive
HealthLDAPAdmins (Just prop ) HealthLDAPAdmins (Just prop )
| prop <= 0 -> HealthFailure | prop > 0 -> HealthSuccess
HealthSMTPConnect (Just False) -> HealthFailure 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 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 ) HealthActiveJobExecutors (Just prop )
| prop <= 0 -> HealthFailure | prop > 0 -> HealthSuccess
HealthDoesFlush mProp HealthDoesFlush mProp
| maybe True (>= 2) mProp -> HealthFailure | maybe True (>= 2) mProp -> HealthFailure -- Looks buggy to me?
_other -> maxBound -- Minimum badness | otherwise -> HealthSuccess
_other -> HealthFailure