chore(health): augement #154 by adding option to disable interface warnings

Also:
- add usage explanation
- show intervals in a human readable form
This commit is contained in:
Steffen Jost 2024-08-22 17:28:28 +02:00
parent 407ba543a1
commit 53abdb7cc3
12 changed files with 99 additions and 63 deletions

View File

@ -149,10 +149,13 @@ InterfaceSubtype: Betreffend
InterfaceWrite: Schreibend
InterfaceSuccess: Rückmeldung
InterfaceInfo: Nachricht
InterfaceFreshness: Prüfungszeitraum (h)
ConfigInterfacesHeading: Konfiguration Warnung Schnittstellen
InterfaceFreshness: Maximale Zugriffsfrist
InterfaceFreshnessTooltip: Zeitspanne innerhalb der ein erneuter erfolgreicher Schnittstellenzugriff erfolgen muss, ohne Warnungen auszulösen
ConfigInterfacesHeading: Konfiguration Zugriffsfristen
IWTActAdd: Hinzufügen
IWTActAdd: Hinzufügen/Ändern
IWTActDelete: Entfernen
InterfaceWarningAdded: Schnittstellenwarnungszeit hinzugefügt oder geändert
InterfaceWarningDeleted n@Int: #{pluralDEeN n "Schnittstellenwarnungszeit"} gelöscht
InterfaceWarningDeleted n@Int: #{pluralDEeN n "Schnittstellenwarnungszeit"} gelöscht
InterfaceWarningDisabledEntirely: Alle Fehler ignorieren
InterfaceWarningDisabledInterval: Keine Zugriffsfrist

View File

@ -149,10 +149,13 @@ InterfaceSubtype: Affecting
InterfaceWrite: Write
InterfaceSuccess: Returned
InterfaceInfo: Message
InterfaceFreshness: Check hours
ConfigInterfacesHeading: Configuration interface warnings
InterfaceFreshness: Maximum usage period
InterfaceFreshnessTooltip: Time period within which the next successful interface access must occur to avoid a warning
ConfigInterfacesHeading: Configure interface usage warnings
IWTActAdd: Add
IWTActAdd: Add/Edit
IWTActDelete: Delete
InterfaceWarningAdded: Interface warning time added/changed
InterfaceWarningDeleted n: #{pluralENsN n "interface warning time"} deleted
InterfaceWarningDeleted n: #{pluralENsN n "interface warning time"} deleted
InterfaceWarningDisabledEntirely: Ignore all errors
InterfaceWarningDisabledInterval: No maximum usage period

View File

@ -12,6 +12,7 @@ FieldSecondary: Nebenfach
MultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Adressen möglich
MultiSelectTip: Mehrfachauswahl und Abwählen mit Strg-Klick
WeekDay: Wochentag
Hours: Stunden
LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}
Days num@Int64: #{num} #{pluralDE num "Tag" "Tage"}

View File

@ -12,6 +12,7 @@ FieldSecondary: Minor
MultiEmailFieldTip: Multiple emails addresses may be specified (comma-separated)
MultiSelectTip: Multiple selection and desection via Ctrl-Click
WeekDay: Day of the week
Hours: Hours
LdapIdentificationOrEmail: Fraport AG-Kennung / email address
Months num: #{num} #{pluralEN num "Month" "Months"}
Days num: #{num} #{pluralEN num "Day" "Days"}

View File

@ -86,7 +86,7 @@ handleAdminProblems mbProblemTable = do
<*> allRDriversHaveFs now
<*> (not <$> exists [PrintJobAcknowledged ==. Nothing, PrintJobCreated <. cutOffOldTime])
<*> (not <$> exists [PrintAcknowledgeProcessed ==. False])
<*> mkInterfaceLogTable flagError mempty
<*> mkInterfaceLogTable mempty
let interfacesBadNr = length $ filter (not . snd) interfaceOks
-- interfacesOk = all snd interfaceOks

View File

@ -37,6 +37,12 @@ wc2null "_" = Nothing
wc2null "*" = Nothing
wc2null o = Just o
warnIntervalCell :: (IsDBTable m b, Integral a) => a -> DBCell m b
warnIntervalCell x
| x >= 0 = textCell $ formatDiffHours x
| x <= (-100) = i18nCell MsgInterfaceWarningDisabledEntirely
| otherwise = i18nCell MsgInterfaceWarningDisabledInterval
-- | sloppily parse a boolean, also see Model.Types.Avs.SloppyBool
pbool :: Text -> Maybe Bool
pbool (Text.toLower . Text.strip -> w)
@ -92,12 +98,7 @@ getHealthInterfaceR (dropWhile (=="force") -> ris) = do -- for bac
runInterfaceLogTable :: ReqBanInterfaceHealth -> Handler (Bool, Bool, [(Text,Bool)], Widget)
runInterfaceLogTable interfs@(reqIfs,_) = do
-- we abuse messageTooltip for colored icons here
msgSuccessTooltip <- messageI Success MsgMessageSuccess
-- msgWarningTooltip <- messageI Warning MsgMessageWarning
msgErrorTooltip <- messageI Error MsgMessageError
let flagError = messageTooltip . bool msgErrorTooltip msgSuccessTooltip
(res, twgt) <- runDB $ mkInterfaceLogTable flagError interfs
(res, twgt) <- runDB $ mkInterfaceLogTable interfs
let missing = notNull [ifce | (UniqueInterfaceHealth ifce _subt _writ) <- reqIfs, ifce `notElem` (fst <$> res) ]
allok = all snd res
return (missing, allok, res, twgt)
@ -105,12 +106,14 @@ runInterfaceLogTable interfs@(reqIfs,_) = do
-- ihDebugShow :: Unique InterfaceHealth -> Text
-- ihDebugShow (UniqueInterfaceHealth i s w) = "(" <> tshow i <> "," <> tshow s <> "," <> tshow w <> ")"
mkInterfaceLogTable :: (Bool -> Widget) -> ReqBanInterfaceHealth -> DB ([(Text,Bool)], Widget)
mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do
mkInterfaceLogTable :: ReqBanInterfaceHealth -> DB ([(Text,Bool)], Widget)
mkInterfaceLogTable interfs@(reqIfs, banIfs) = do
-- $logWarnS "DEBUG" $ tshow ([ihDebugShow x | x<- reqIfs], [ihDebugShow x | x<- banIfs])
void $ liftHandler $ timeoutHandler 42000001 $ runDB $ runInterfaceChecks interfs
flagError <- liftHandler $ do
void $ timeoutHandler 42000001 $ runDB $ runInterfaceChecks interfs -- ensure interface checkc are up to date
mkErrorFlag
now <- liftIO getCurrentTime
dbTableDB ilvalidator DBTable{dbtColonnade=colonnade now, ..}
dbTableDB ilvalidator DBTable{dbtColonnade=colonnade now flagError, ..}
where
sanitize = text2AlphaNumPlus ['+','-','_','Ä','Ö','Ü','ß','ä','ö','ü']
dbtIdent = "interface-log" :: Text
@ -157,27 +160,29 @@ mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do
queryILog :: (E.SqlExpr (Entity InterfaceLog) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity InterfaceHealth))) -> E.SqlExpr (Entity InterfaceLog)
queryILog = $(E.sqlLOJproj 2 1)
queryHealth :: (E.SqlExpr (Entity InterfaceLog) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity InterfaceHealth))) -> E.SqlExpr (Maybe (Entity InterfaceHealth))
queryHealth = $(E.sqlLOJproj 2 2)
resultILog :: Lens' (DBRow (Entity InterfaceLog, E.Value Int)) InterfaceLog
resultILog = _dbrOutput . _1 . _entityVal
resultHours :: Lens' (DBRow (Entity InterfaceLog, E.Value Int)) Int
resultHours = _dbrOutput . _2 . E._unValue
dbtRowKey = queryILog >>> (E.^.InterfaceLogId)
colonnade now = mconcat
colonnade now flagError = mconcat
[ sortable Nothing (i18nCell MsgInterfaceStatus) $ \row -> -- do
let hours = row ^. resultHours
-- defmsg = row ^? resultErrMsg
logtime = row ^. resultILog . _interfaceLogTime
success = row ^. resultILog . _interfaceLogSuccess
iface = row ^. resultILog . _interfaceLogInterface
status = success && (hours < 0 || now <= addHours hours logtime)
in tellCell [(iface,status)] $
wgtCell $ flagError status
status = (success || hours <= -100) && (hours < 0 || now <= addHours hours logtime)
in tellCell [(iface,status)] $ wgtCell $ flagError $ toMaybe (success || not status) status
, sortable (Just "interface") (i18nCell MsgInterfaceName ) $ \(view (resultILog . _interfaceLogInterface) -> n) -> textCell n
, sortable (Just "subtype") (i18nCell MsgInterfaceSubtype ) $ textCell . view (resultILog . _interfaceLogSubtype)
, sortable (Just "write") (i18nCell MsgInterfaceWrite ) $ (`ifIconCell` IconEdit) . view (resultILog . _interfaceLogWrite)
, sortable (Just "time") (i18nCell MsgInterfaceLastSynch ) $ dateTimeCell . view (resultILog . _interfaceLogTime)
, sortable Nothing (i18nCell MsgInterfaceFreshness ) $ numCell . view resultHours
, sortable (Just "hours") (i18nCell MsgInterfaceFreshness & cellTooltips [SomeMessage MsgInterfaceFreshnessTooltip, SomeMessage MsgTableDiffDaysTooltip]
) $ warnIntervalCell . view resultHours
, sortable (Just "rows") (i18nCell MsgTableRows ) $ cellMaybe numCell . view (resultILog . _interfaceLogRows)
, sortable (Just "success") (i18nCell MsgInterfaceSuccess ) $ \(view (resultILog . _interfaceLogSuccess) -> s) -> iconBoolCell s
, sortable Nothing (i18nCell MsgInterfaceInfo ) $ \(view resultILog -> ilt) -> case ilt of
@ -193,6 +198,7 @@ mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do
, singletonMap "time" $ SortColumn $ queryILog >>> (E.^. InterfaceLogTime)
, singletonMap "rows" $ SortColumn $ queryILog >>> (E.^. InterfaceLogRows)
, singletonMap "success" $ SortColumn $ queryILog >>> (E.^. InterfaceLogSuccess)
, singletonMap "hours" $ SortColumn $ \r -> E.coalesceDefault [queryHealth r E.?. InterfaceHealthHours] (E.val defaultInterfaceWarnHours)
]
ilvalidator = def & defaultSorting [SortAscBy "interface", SortAscBy "subtype", SortAscBy "write"]
dbtFilter = mempty
@ -296,7 +302,7 @@ resultInterfaceHealth :: Lens' IWTableData (Entity InterfaceHealth)
resultInterfaceHealth = _dbrOutput
wildcardCell :: IsDBTable m b => (a -> DBCell m b) -> Maybe a -> DBCell m b
wildcardCell _ Nothing = textCell "*"
wildcardCell _ Nothing = iconFixedCell $ icon IconWildcard
wildcardCell c (Just x) = c x
mkInterfaceWarnTable :: DB (FormResult (IWTableActionData, Set InterfaceHealthId), Widget)
@ -321,16 +327,17 @@ mkInterfaceWarnTable = do
dbtColonnade = formColonnade $ mconcat
[ dbSelect (applying _2) id (return . view (resultInterfaceHealth . _entityKey))
, sortable (Just "interface") (i18nCell MsgInterfaceName ) $ \(view (resultInterfaceHealth . _entityVal . _interfaceHealthInterface) -> n) -> textCell n
, sortable (Just "subtype") (i18nCell MsgInterfaceSubtype ) $ wildcardCell textCell . view (resultInterfaceHealth . _entityVal . _interfaceHealthSubtype )
, sortable (Just "write") (i18nCell MsgInterfaceWrite ) $ wildcardCell (`ifIconCell` IconEdit) . view (resultInterfaceHealth . _entityVal . _interfaceHealthWrite )
, sortable (Just "hours") (i18nCell MsgInterfaceFreshness ) $ numCell . view (resultInterfaceHealth . _entityVal . _interfaceHealthHours )
, sortable (Just "hours") (i18nCell MsgInterfaceFreshness ) $ textCell . formatDiffHours . view (resultInterfaceHealth . _entityVal . _interfaceHealthHours)
, sortable (Just "subtype") (i18nCell MsgInterfaceSubtype ) $ wildcardCell textCell . view (resultInterfaceHealth . _entityVal . _interfaceHealthSubtype )
, sortable (Just "write") (i18nCell MsgInterfaceWrite ) $ wildcardCell (iconFixedCell . iconWriteReadOnly) . view (resultInterfaceHealth . _entityVal . _interfaceHealthWrite )
-- , sortable (Just "hours") (i18nCell MsgInterfaceFreshness ) $ numCell . view (resultInterfaceHealth . _entityVal . _interfaceHealthHours )
, sortable (Just "hours") (i18nCell MsgInterfaceFreshness
& cellTooltip MsgTableDiffDaysTooltip ) $ warnIntervalCell . view (resultInterfaceHealth . _entityVal . _interfaceHealthHours )
]
dbtSorting = mconcat
[ singletonMap "interface" $ SortColumn $ queryInterfaceHealth >>> (E.^. InterfaceHealthInterface)
, singletonMap "subtype" $ SortColumn $ queryInterfaceHealth >>> (E.^. InterfaceHealthSubtype)
, singletonMap "write" $ SortColumn $ queryInterfaceHealth >>> (E.^. InterfaceHealthWrite)
, singletonMap "time" $ SortColumn $ queryInterfaceHealth >>> (E.^. InterfaceHealthHours)
, singletonMap "hours" $ SortColumn $ queryInterfaceHealth >>> (E.^. InterfaceHealthHours)
]
dbtFilter = mempty
dbtFilterUI = mempty
@ -347,7 +354,7 @@ mkInterfaceWarnTable = do
<$> apreq (textField & cfStrip & addDatalist suggestionInterface) (fslI MsgInterfaceName) Nothing
<*> aopt (textField & cfStrip & addDatalist suggestionSubtype) (fslI MsgInterfaceSubtype) Nothing
<*> aopt boolField' (fslI MsgInterfaceWrite) Nothing
<*> apreq intField (fslI MsgInterfaceFreshness) Nothing
<*> apreq intField (fslI MsgInterfaceFreshness & setTooltip MsgHours) Nothing
, singletonMap IWTActDelete $ pure IWTActDeleteData
]
in renderAForm FormStandard
@ -372,14 +379,8 @@ mkInterfaceWarnTable = do
getConfigInterfacesR, postConfigInterfacesR :: Handler Html
getConfigInterfacesR = postConfigInterfacesR
postConfigInterfacesR = do
-- we abuse messageTooltip for colored icons here
msgSuccessTooltip <- messageI Success MsgMessageSuccess
-- msgWarningTooltip <- messageI Warning MsgMessageWarning
msgErrorTooltip <- messageI Error MsgMessageError
let flagError = messageTooltip . bool msgErrorTooltip msgSuccessTooltip
((interfaceOks, interfaceTable), (warnRes, configTable)) <- runDB $ (,)
<$> mkInterfaceLogTable flagError mempty
<$> mkInterfaceLogTable mempty
<*> mkInterfaceWarnTable
let interfacesBadNr = length $ filter (not . snd) interfaceOks
formResult warnRes $ \case

View File

@ -265,7 +265,7 @@ formatDiffDays t
inMinutes = tshow $ convertBy nominalMinute
formatDiffHours :: Integral a => a -> Text
formatDiffHours = formatDiffDays . secondsToNominalDiffTime . (* 360) . fromIntegral
formatDiffHours = pack . iso8601Show . calendarTimeTime . secondsToNominalDiffTime . (* 3600) . fromIntegral
formatCalendarDiffDays :: CalendarDiffDays -> Text
formatCalendarDiffDays = pack . iso8601Show

View File

@ -173,6 +173,23 @@ companyWidget isPrimary (csh, cname, isSupervisor)
| otherwise = text2markup corg
---------------------
-- Status Tooltips --
---------------------
-- | generate a generic colored icon to display success or failure to user
mkErrorFlag :: Handler (Maybe Bool -> Widget)
mkErrorFlag = do
-- we abuse messageTooltip for colored icons here
msgSuccessTooltip <- messageI Success MsgMessageSuccess
msgWarningTooltip <- messageI Warning MsgMessageWarning
msgErrorTooltip <- messageI Error MsgMessageError
let flagError Nothing = messageTooltip msgWarningTooltip
flagError (Just False) = messageTooltip msgErrorTooltip
flagError (Just True) = messageTooltip msgSuccessTooltip
return flagError
----------
-- HEAT --
----------

View File

@ -122,7 +122,7 @@ data Icon
-- IconMagic -- indicates automatic updates
| IconReroute -- for notification rerouting
| IconTop -- indicating highest number/quantity/priority for something
| IconWildcard
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
deriving anyclass (Universe, Finite, NFData)
@ -222,6 +222,7 @@ iconText = \case
-- IconMagic -> "wand-magic"
IconReroute -> "directions"
IconTop -> "arrow-to-top"
IconWildcard -> "asterisk"
nullaryPathPiece ''Icon $ camelToPathPiece' 1
deriveLift ''Icon
@ -331,6 +332,10 @@ iconQualificationBlock :: Bool -> Markup
iconQualificationBlock True = icon IconCertificate
iconQualificationBlock False = icon IconBlocked
iconWriteReadOnly :: Bool -> Markup
iconWriteReadOnly True = icon IconEdit
iconWriteReadOnly False = icon IconVisible
----------------
-- For documentation on how to avoid these unneccessary functions
-- we implement them here just once for the first icon:

View File

@ -228,3 +228,5 @@ messageTooltip Message{..} = let urgency = statusToUrgencyClass messageStatus
tooltip = toWidget messageContent :: WidgetFor site ()
isInlineTooltip = False
in $(whamletFile "templates/widgets/tooltip.hamlet")
-- also see Handler.Utils.Widgets.mkErrorFlag for generic error icon tooltips

View File

@ -6,22 +6,23 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<h2>
_{MsgMenuInterfaces}
_{MsgConfigInterfacesHeading}
<div>
<p>
Eine Schnittstelle gilt als fehlgeschlagen, wenn die letzte Transaktion dieser Schnittstelle ein konkreten Fehler lieferte,
oder wenn seit einer gewissen Anzahl an Stunden kein erneuter Erfolg für diese Schnittstelle registriert wurde.
Diese Zeitspanne beträgt normalerweise: #{defWarnTime}
Mit der nachfolgend gezeigten Tabelle kann diese Zeitspanne zwischen letztem Erfolg und dem Anzeigen eines Fehlers aufgrund
des Ausbleibens eines erneuten Erfolges für einzelne Schnittstellen geändert werden.
Einträge mit unspezifiertem _{MsgInterfaceSubtype} und/oder _{MsgInterfaceWrite} betreffen alle drauf passenden Schnittstellen,
sofern es keine anderen passenden, besser spezifizierten Einträge gibt.
Die Zeitspanne ist hier immer in Stunden anzugeben.
Eine negative Stundenzahl deaktiviert den Warnungsmechanismus für ausbleibende wiederholte Erfolge;
in diesem Fall werden für die Schnittstelle nur tatsächliche Fehlschläge als Fehler gemeldet.
Eine Schnittstelle gilt als fehlgeschlagen, wenn die letzte Transaktion dieser Schnittstelle ein konkreten Fehler lieferte, #
oder wenn seit einer gewissen Zugriffsfrist kein erneuter Erfolg für diese Schnittstelle registriert wurde. #
<p>
Diese Zeitspanne beträgt normalerweise: #{defWarnTime} #
<p>
Mit der nachfolgend gezeigten Tabelle kann diese Zugriffsfrist zwischen letztem Erfolg und dem Anzeigen eines Fehlers aufgrund #
des Ausbleibens eines erneuten Erfolges für einzelne Schnittstellen geändert werden. #
Einträge mit unspezifiertem _{MsgInterfaceSubtype} und/oder _{MsgInterfaceWrite} betreffen alle drauf passenden Schnittstellen, #
sofern es keine anderen passenden, besser spezifizierten Einträge gibt. #
<p>
Die Zeitspanne ist hier immer in Stunden anzugeben. #
Eine negative Stundenzahl deaktiviert den Warnungsmechanismus für ausbleibende wiederholte Erfolge; #
in diesem Fall werden für die Schnittstelle nur tatsächliche Fehlschläge als Fehler gemeldet. #
Eine negative Zeitspanne von -100 oder weniger deaktiviert alle Warnungen für diese Schnittstelle.
<p>
^{configTable}

View File

@ -6,17 +6,19 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<h2>
_{MsgMenuInterfaces}
_{MsgConfigInterfacesHeading}
<div>
<p>
An interface is flagged as failed, if no success had been reported within the last #{defWarnTime}
The following table allows to change the time span between the last success and before an error is raised.
A time value having _{MsgInterfaceSubtype} and/or _{MsgInterfaceWrite} left unspecified affects all matching interfeaces,
unless another more specified matching row exists for a particular interface.
The time span is configure by a number of hours.
A negative hour value disables the raising of an error by time entirely; in this case, an error is only raised if the last interface transaction reported failure.
An interface is flagged as failed, if an error is reported or if no new success had been reported within
its maximum usage period, usually #{defWarnTime} #
<p>
The following table allows to change the time span between the last success and before an error is raised. #
A time value having _{MsgInterfaceSubtype} and/or _{MsgInterfaceWrite} left unspecified affects all matching interfeaces, #
unless another more specified matching row exists for a particular interface. #
<p>
The time span is configure by a number of hours. #
A negative hour value disables the raising of an error by time entirely; in this case, an error is only raised if the last interface transaction reported failure. #
A negative value of less than -100 disables all warnings for this interface.
<p>
^{configTable}