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

Merge branch 'fradrive/jost' into 'master'

Browse Source 
minor update

Closes #154 and #5

See merge request fradrive/fradrive!38
This commit is contained in:
Steffen Jost 2024-08-21 17:59:22 +00:00
commit 97446aa9ef
18 changed files with 355 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
frontend/src/utils/exam-correct/exam-correct.js
View File

@ -301,7 +301,7 @@ export class ExamCorrect {
users: [user],
status: STATUS.LOADING,
};
if (results && results !== {}) rowInfo.results = results;
if (results && Object.keys(results).length > 0) rowInfo.results = results;
if (result !== undefined) rowInfo.result = result;
this._addRow(rowInfo);

8
messages/uniworx/categories/admin/de-de-formal.msg
View File

@ -149,4 +149,10 @@ InterfaceSubtype: Betreffend
InterfaceWrite: Schreibend
InterfaceSuccess: Rückmeldung
InterfaceInfo: Nachricht
InterfaceFreshness: Prüfungszeitraum (h)
InterfaceFreshness: Prüfungszeitraum (h)
ConfigInterfacesHeading: Konfiguration Warnung Schnittstellen
IWTActAdd: Hinzufügen
IWTActDelete: Entfernen
InterfaceWarningAdded: Schnittstellenwarnungszeit hinzugefügt oder geändert
InterfaceWarningDeleted n@Int: #{pluralDEeN n "Schnittstellenwarnungszeit"} gelöscht

8
messages/uniworx/categories/admin/en-eu.msg
View File

@ -149,4 +149,10 @@ InterfaceSubtype: Affecting
InterfaceWrite: Write
InterfaceSuccess: Returned
InterfaceInfo: Message
InterfaceFreshness: Check hours
InterfaceFreshness: Check hours
ConfigInterfacesHeading: Configuration interface warnings
IWTActAdd: Add
IWTActDelete: Delete
InterfaceWarningAdded: Interface warning time added/changed
InterfaceWarningDeleted n: #{pluralENsN n "interface warning time"} deleted

1
messages/uniworx/utils/table_column/de-de-formal.msg
View File

@ -79,6 +79,7 @@ TableCompany: Firma
TableCompanyFilter: Firma oder Nummer
TableCompanyShort: Firmenkürzel
TableCompanies: Firmen
TablePrimeCompany: Primäre Firma
TableCompanyNo: Firmennummer
TableCompanyNos: Firmennummern
TableCompanyUser: Firmenangehöriger

1
messages/uniworx/utils/table_column/en-eu.msg
View File

@ -79,6 +79,7 @@ TableCompany: Company
TableCompanyFilter: Company/Nr
TableCompanyShort: Company shorthand
TableCompanies: Companies
TablePrimeCompany: Primary company
TableCompanyNo: Company number
TableCompanyNos: Company numbers
TableCompanyUser: Associate

1
routes
View File

@ -76,6 +76,7 @@
/admin/problems/r-without-f ProblemFbutNoR GET
/admin/problems/avs ProblemAvsSynchR GET POST
/admin/problems/avs/errors ProblemAvsErrorR GET
/admin/config/interfaces ConfigInterfacesR GET POST
/comm CommCenterR GET
/comm/email MailCenterR GET POST

15
src/Foundation/Navigation.hs
View File

@ -122,6 +122,7 @@ breadcrumb ProblemWithoutAvsId = i18nCrumb MsgProblemsNoAvsIdHeading $ Just
breadcrumb ProblemFbutNoR = i18nCrumb MsgProblemsRWithoutFHeading $ Just AdminProblemsR
breadcrumb ProblemAvsSynchR = i18nCrumb MsgProblemsAvsSynchHeading $ Just AdminProblemsR
breadcrumb ProblemAvsErrorR = i18nCrumb MsgProblemsAvsErrorHeading $ Just AdminProblemsR
breadcrumb ConfigInterfacesR = i18nCrumb MsgConfigInterfacesHeading $ Just AdminProblemsR
breadcrumb FirmAllR = i18nCrumb MsgMenuFirms Nothing
breadcrumb FirmsCommR{} = i18nCrumb MsgMenuFirmsComm $ Just FirmAllR
@ -2533,6 +2534,20 @@ pageActions AdminCrontabR = return
}
]
pageActions AdminProblemsR = return
[ NavPageActionPrimary
{ navLink = defNavLink MsgConfigInterfacesHeading ConfigInterfacesR
, navChildren = []
}
, NavPageActionPrimary
{ navLink = defNavLink MsgProblemsAvsSynchHeading ProblemAvsSynchR
, navChildren = []
}
, NavPageActionSecondary
{ navLink = defNavLink MsgProblemsAvsErrorHeading ProblemAvsErrorR
}
]
pageActions _ = return []
submissionList :: ( MonadIO m

145
src/Handler/Health/Interface.hs
View File

@ -8,12 +8,14 @@ module Handler.Health.Interface
getHealthInterfaceR
, mkInterfaceLogTable
, runInterfaceChecks
, getConfigInterfacesR, postConfigInterfacesR
)
where
import Import
-- import qualified Data.Set as Set
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Text as Text
import Handler.Utils
import Handler.Utils.Concurrent
@ -24,6 +26,8 @@ import qualified Database.Esqueleto.Utils as E
import qualified Database.Esqueleto.Legacy as EL (on)
import qualified Database.Persist.Sql as E (deleteWhereCount)
defaultInterfaceWarnHours :: Int
defaultInterfaceWarnHours = 3 * 24 -- if no warn time can be found, use 3 days instead
-- | identify a wildcard argument
wc2null :: Text -> Maybe Text
@ -148,7 +152,7 @@ mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do
-- E.where_ $ E.not_ (ilog E.^. InterfaceLogInterface E.==. E.val "LMS" E.&&. ilog E.^. InterfaceLogSubtype E.==. E.val (sanitize "F")) -- BAD All missing, except for "Printer" "F"
-- E.where_ $ E.not_ $ E.parens (ilog E.^. InterfaceLogInterface E.==. E.val "LMS" E.&&. ilog E.^. InterfaceLogSubtype E.==. E.val (sanitize "F")) -- WORKS OKAY
-- E.where_ $ ilog E.^. InterfaceLogInterface E.!=. E.val "LMS" E.||. ilog E.^. InterfaceLogSubtype E.!=. E.val (sanitize "F") -- WORKS OKAY
let ihour = E.coalesceDefault [ihealth E.?. InterfaceHealthHours] (E.val $ 3 * 24) -- if no default time is set, use 3 days instead
let ihour = E.coalesceDefault [ihealth E.?. InterfaceHealthHours] (E.val defaultInterfaceWarnHours) -- if no default time is set, use a default instead
return (ilog, ihour)
queryILog :: (E.SqlExpr (Entity InterfaceLog) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity InterfaceHealth))) -> E.SqlExpr (Entity InterfaceLog)
@ -258,3 +262,140 @@ avsInterfaceCheck interfs = maybeRunCheck interfs (UniqueInterfaceHealth "AVS" (
-- lastOk <- userAvsLastSynch . entityVal <<$>> selectFirst [UserAvsLastSynchError ==. Nothing] [Desc UserAvsLastSynch]
writeAvsSynchStats Nothing =<< mkBadInfo badRows badTime
_ -> return ()
data IWTableAction
= IWTActAdd
| IWTActDelete
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
instance Universe IWTableAction
instance Finite IWTableAction
nullaryPathPiece ''IWTableAction $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''IWTableAction id
data IWTableActionData
= IWTActAddData
{ iwtActInterface :: Text
, iwtActSubtype :: Maybe Text
, iwtActWrite :: Maybe Bool
, iwtActHours :: Int
}
| IWTActDeleteData
deriving (Eq, Ord, Read, Show, Generic)
type IWTableExpr = E.SqlExpr (Entity InterfaceHealth)
queryInterfaceHealth :: IWTableExpr -> E.SqlExpr (Entity InterfaceHealth)
queryInterfaceHealth = id
type IWTableData = DBRow (Entity InterfaceHealth)
resultInterfaceHealth :: Lens' IWTableData (Entity InterfaceHealth)
resultInterfaceHealth = _dbrOutput
wildcardCell :: IsDBTable m b => (a -> DBCell m b) -> Maybe a -> DBCell m b
wildcardCell _ Nothing = textCell "*"
wildcardCell c (Just x) = c x
mkInterfaceWarnTable :: DB (FormResult (IWTableActionData, Set InterfaceHealthId), Widget)
mkInterfaceWarnTable = do
let
mkOption :: E.Value Text -> Option Text
mkOption (E.unValue -> t) = Option{ optionDisplay = t, optionInternalValue = t, optionExternalValue = toPathPiece t }
getSuggestion pj = E.select $ E.distinct $ do
il <- E.from $ E.table @InterfaceLog
let res = il E.^. pj
E.orderBy [E.asc res]
pure res
suggestionInterface :: HandlerFor UniWorX (OptionList Text)
suggestionInterface = mkOptionList . fmap mkOption <$> runDB (getSuggestion InterfaceLogInterface)
suggestionSubtype :: HandlerFor UniWorX (OptionList Text)
suggestionSubtype = mkOptionList . fmap mkOption <$> runDB (getSuggestion InterfaceLogSubtype)
dbtIdent = "interface-warnings" :: Text
dbtSQLQuery :: IWTableExpr -> E.SqlQuery IWTableExpr
dbtSQLQuery = return
dbtRowKey = queryInterfaceHealth >>> (E.^. InterfaceHealthId)
dbtProj = dbtProjId
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)
]
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)
]
dbtFilter = mempty
dbtFilterUI = mempty
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtParams = DBParamsForm
{ dbParamsFormMethod = POST
, dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
, dbParamsFormAttrs = []
, dbParamsFormSubmit = FormSubmit
, dbParamsFormAdditional
= let acts :: Map IWTableAction (AForm Handler IWTableActionData)
acts = mconcat
[ singletonMap IWTActAdd $ IWTActAddData
<$> 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
, singletonMap IWTActDelete $ pure IWTActDeleteData
]
in renderAForm FormStandard
$ (, mempty) . First . Just
<$> multiActionA acts (fslI MsgTableAction) Nothing
, dbParamsFormEvaluate = liftHandler . runFormPost
, dbParamsFormResult = id
, dbParamsFormIdent = def
}
dbtCsvEncode = noCsvEncode
dbtCsvDecode = Nothing
dbtExtraReps = []
postprocess :: FormResult (First IWTableActionData, DBFormResult InterfaceHealthId Bool IWTableData)
-> FormResult ( IWTableActionData, Set InterfaceHealthId)
postprocess inp = do
(First (Just act), jobMap) <- inp
let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
return (act, jobSet)
psValidator = def & defaultSorting [SortAscBy "interface", SortAscBy "subtype", SortAscBy "write"]
over _1 postprocess <$> dbTable psValidator DBTable{..}
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
<*> mkInterfaceWarnTable
let interfacesBadNr = length $ filter (not . snd) interfaceOks
formResult warnRes $ \case
(IWTActAddData{..}, _) -> do
void $ runDB $ upsertBy
(UniqueInterfaceHealth iwtActInterface iwtActSubtype iwtActWrite)
( InterfaceHealth iwtActInterface iwtActSubtype iwtActWrite iwtActHours)
[InterfaceHealthHours =. iwtActHours]
addMessageI Success MsgInterfaceWarningAdded
reloadKeepGetParams ConfigInterfacesR
(IWTActDeleteData, ihids) -> do
runDB $ mapM_ delete ihids
addMessageI Success $ MsgInterfaceWarningDeleted $ Set.size ihids
reloadKeepGetParams ConfigInterfacesR
siteLayoutMsg MsgConfigInterfacesHeading $ do
setTitleI MsgConfigInterfacesHeading
let defWarnTime = formatDiffHours defaultInterfaceWarnHours
$(i18nWidgetFile "config-interfaces")

82
src/Handler/LMS.hs
View File

@ -220,7 +220,6 @@ data LmsTableCsv = LmsTableCsv -- L..T..C.. -> ltc..
{ ltcDisplayName :: UserDisplayName
, ltcEmail :: UserEmail
, ltcCompany :: Maybe Text
, ltcCompanyNumbers :: CsvSemicolonList Int
, ltcValidUntil :: Day
, ltcLastRefresh :: Day
, ltcFirstHeld :: Day
@ -242,8 +241,7 @@ ltcExample :: LmsTableCsv
ltcExample = LmsTableCsv
{ ltcDisplayName = "Max Mustermann"
, ltcEmail = "m.mustermann@example.com"
, ltcCompany = Just "Example Brothers LLC, SecondaryJobs Inc"
, ltcCompanyNumbers = CsvSemicolonList [27,69]
, ltcCompany = Just "Example Brothers LLC"
, ltcValidUntil = succ compDay
, ltcLastRefresh = compDay
, ltcFirstHeld = pred $ pred compDay
@ -285,8 +283,7 @@ instance CsvColumnsExplained LmsTableCsv where
csvColumnsExplanations = genericCsvColumnsExplanations ltcOptions $ Map.fromList
[ ('ltcDisplayName , SomeMessage MsgLmsUser)
, ('ltcEmail , SomeMessage MsgTableLmsEmail)
, ('ltcCompany , SomeMessage MsgTableCompanies)
, ('ltcCompanyNumbers , SomeMessage MsgTableCompanyNos)
, ('ltcCompany , SomeMessage MsgTablePrimeCompany)
, ('ltcValidUntil , SomeMessage MsgLmsQualificationValidUntil)
, ('ltcLastRefresh , SomeMessage MsgTableQualificationLastRefresh)
, ('ltcFirstHeld , SomeMessage MsgTableQualificationFirstHeld)
@ -320,7 +317,7 @@ queryQualBlock :: LmsTableExpr -> E.SqlExpr (Maybe (Entity QualificationUserBloc
queryQualBlock = $(sqlLOJproj 2 2)
type LmsTableData = DBRow (Entity QualificationUser, Entity User, Entity LmsUser, Maybe (Entity QualificationUserBlock), E.Value (Maybe [Maybe UTCTime]), [Entity UserCompany], E.Value Bool)
type LmsTableData = DBRow (Entity QualificationUser, Entity User, Entity LmsUser, Maybe (Entity QualificationUserBlock), E.Value (Maybe [Maybe UTCTime]), E.Value (Maybe CompanyId), E.Value Bool)
resultQualUser :: Lens' LmsTableData (Entity QualificationUser)
resultQualUser = _dbrOutput . _1
@ -337,8 +334,8 @@ resultQualBlock = _dbrOutput . _4 . _Just
resultPrintAck :: Traversal' LmsTableData [Maybe UTCTime]
resultPrintAck = _dbrOutput . _5 . _unValue . _Just
resultCompanyUser :: Lens' LmsTableData [Entity UserCompany]
resultCompanyUser = _dbrOutput . _6
resultCompanyId :: Traversal' LmsTableData CompanyId
resultCompanyId = _dbrOutput . _6 . _unValue . _Just
resultValidQualification :: Lens' LmsTableData Bool
resultValidQualification = _dbrOutput . _7 . _unValue
@ -406,6 +403,7 @@ lmsTableQuery :: UTCTime -> QualificationId -> LmsTableExpr
, E.SqlExpr (Entity LmsUser)
, E.SqlExpr (Maybe (Entity QualificationUserBlock))
, E.SqlExpr (E.Value (Maybe [Maybe UTCTime])) -- outer maybe indicates, whether a printJob exists, inner maybe indicates all acknowledged printJobs
, E.SqlExpr (E.Value (Maybe CompanyId))
, E.SqlExpr (E.Value Bool)
)
lmsTableQuery now qid (qualUser `E.InnerJoin` user `E.InnerJoin` lmsUser `E.LeftOuterJoin` qualBlock) = do
@ -421,12 +419,16 @@ lmsTableQuery now qid (qualUser `E.InnerJoin` user `E.InnerJoin` lmsUser `E.Left
E.where_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification
-- Letztes Datum anzeigen, wenn mehrere, dann diese in klickbaren Tooltip verstecken!
let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do
E.where_ $ E.isJust (pj E.^. PrintJobLmsUser)
E.&&. ((lmsUser E.^. LmsUserIdent) E.=?. (pj E.^. PrintJobLmsUser))
let pjOrder = [E.desc $ pj E.^. PrintJobCreated, E.desc $ pj E.^. PrintJobAcknowledged] -- latest created comes first! This is assumed to be the case later on!
pure $ --(E.arrayAggWith E.AggModeAll (pj E.^. PrintJobCreated ) pjOrder, -- return two aggregates only works with select, the restricted type of subSelect does not seem to support this!
E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) pjOrder
return (qualUser, user, lmsUser, qualBlock, printAcknowledged, validQualification now qualUser)
E.where_ $ E.isJust (pj E.^. PrintJobLmsUser)
E.&&. ((lmsUser E.^. LmsUserIdent) E.=?. (pj E.^. PrintJobLmsUser))
let pjOrder = [E.desc $ pj E.^. PrintJobCreated, E.desc $ pj E.^. PrintJobAcknowledged] -- latest created comes first! This is assumed to be the case later on!
pure $ --(E.arrayAggWith E.AggModeAll (pj E.^. PrintJobCreated ) pjOrder, -- return two aggregates only works with select, the restricted type of subSelect does not seem to support this!
E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) pjOrder
primeComp = E.subSelect . E.from $ \uc -> do
E.where_ $ user E.^. UserId E.==. uc E.^. UserCompanyUser
E.orderBy [E.desc $ uc E.^. UserCompanyPriority, E.asc $ uc E.^. UserCompanyCompany]
return (uc E.^. UserCompanyCompany)
return (qualUser, user, lmsUser, qualBlock, printAcknowledged, primeComp, validQualification now qualUser)
mkLmsTable :: ( Functor h, ToSortable h
@ -435,25 +437,26 @@ mkLmsTable :: ( Functor h, ToSortable h
=> Bool
-> Entity Qualification
-> Map LmsTableAction (AForm Handler LmsTableActionData)
-> (Map CompanyId Company -> cols)
-> ((CompanyId -> CompanyName) -> cols)
-> PSValidator (MForm Handler) (FormResult (First LmsTableActionData, DBFormResult UserId Bool LmsTableData))
-> DB (FormResult (LmsTableActionData, Set UserId), Widget)
mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
now <- liftIO getCurrentTime
-- lookup all companies
cmpMap <- memcachedBy (Just . Right $ 5 * diffMinute) ("CompanyDictionary"::Text) $ do
cmpMap <- memcachedBy (Just . Right $ 15 * diffMinute) ("CompanyDictionary"::Text) $ do
cmps <- selectList [] [] -- [Asc CompanyShorthand]
return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
let
getCompanyName :: CompanyId -> CompanyName
getCompanyName cid = maybe (unCompanyKey cid) companyName $ Map.lookup cid cmpMap -- use shorthand in case of impossible failure
csvName = T.replace " " "-" $ ciOriginal (quali ^. _qualificationName)
dbtIdent :: Text
dbtIdent = "lms"
dbtSQLQuery = lmsTableQuery now qid
dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjSimple $ \(qualUsr, usr, lmsUsr, qUsrBlock, printAcks, validQ) -> do
cmpUsr <- selectList [UserCompanyUser ==. entityKey usr] [Desc UserCompanyPriority, Asc UserCompanyCompany, LimitTo 1]
return (qualUsr, usr, lmsUsr, qUsrBlock, printAcks, cmpUsr, validQ)
dbtColonnade = cols cmpMap
dbtProj = dbtProjId
dbtColonnade = cols getCompanyName
dbtSorting = mconcat
[ single $ sortUserNameLink queryUser
, single $ sortUserEmail queryUser
@ -544,25 +547,20 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
doEncode' = LmsTableCsv
<$> view (resultUser . _entityVal . _userDisplayName)
<*> view (resultUser . _entityVal . _userDisplayEmail)
<*> (view resultCompanyUser >>= getCompanies)
<*> (view resultCompanyUser >>= getCompanyNos)
<*> view (resultQualUser . _entityVal . _qualificationUserValidUntil)
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
<*> view (resultQualUser . _entityVal . _qualificationUserFirstHeld)
<*> preview (resultCompanyId . to getCompanyName . _CI)
<*> view (resultQualUser . _entityVal . _qualificationUserValidUntil)
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
<*> view (resultQualUser . _entityVal . _qualificationUserFirstHeld)
<*> preview (resultQualBlock . _entityVal . _qualificationUserBlockUnblock . _not)
<*> preview (resultQualBlock . _entityVal . _qualificationUserBlockFrom)
<*> view (resultLmsUser . _entityVal . _lmsUserIdent)
<*> view (resultLmsUser . _entityVal . _lmsUserStatus)
<*> view (resultLmsUser . _entityVal . _lmsUserStatusDay)
<*> view (resultLmsUser . _entityVal . _lmsUserStarted)
<*> view (resultLmsUser . _entityVal . _lmsUserDatePin)
<*> view (resultLmsUser . _entityVal . _lmsUserReceived)
<*> view (resultLmsUser . _entityVal . _lmsUserNotified) -- TODO: only exports last email date / print job sending date, not print acknowledge
<*> view (resultLmsUser . _entityVal . _lmsUserEnded)
getCompanies cmps = case mapMaybe (flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany)) cmps of
[] -> pure Nothing
somecmps -> pure $ Just $ intercalate ", " $ fmap (view (_companyName . _CI)) somecmps
getCompanyNos = pure . CsvSemicolonList . mapMaybe (preview (_Just . _companyAvsId) . flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany))
<*> view (resultLmsUser . _entityVal . _lmsUserIdent)
<*> view (resultLmsUser . _entityVal . _lmsUserStatus)
<*> view (resultLmsUser . _entityVal . _lmsUserStatusDay)
<*> view (resultLmsUser . _entityVal . _lmsUserStarted)
<*> view (resultLmsUser . _entityVal . _lmsUserDatePin)
<*> view (resultLmsUser . _entityVal . _lmsUserReceived)
<*> view (resultLmsUser . _entityVal . _lmsUserNotified) -- TODO: only exports last email date / print job sending date, not print acknowledge
<*> view (resultLmsUser . _entityVal . _lmsUserEnded)
dbtCsvDecode = Nothing
dbtExtraReps = []
@ -627,16 +625,12 @@ postLmsR sid qsh = do
-- <*> aopt (commentField MsgQualificationActBlockSupervisor) (fslI MsgMessageWarning) Nothing
<* aformMessage msgRestartWarning
]
colChoices cmpMap = mconcat
colChoices getCompanyName = mconcat
[ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultUser . _entityKey))
, colUserNameModalHdrAdmin MsgLmsUser AdminUserR
, colUserEmail
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \( view resultCompanyUser -> cmps) ->
let cs = [ companyCell (unCompanyKey cmpId) cmpName cmpSpr
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
, let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap
]
in intercalate spacerCell cs
, sortable (Just "user-company") (i18nCell MsgTablePrimeCompany) $ \(preview resultCompanyId -> mcid) ->
maybeEmpty mcid $ \cid -> companyCell (unCompanyKey cid) (getCompanyName cid) False
, colUserMatriclenr isAdmin
-- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d

17
src/Handler/MailCenter.hs
View File

@ -96,7 +96,7 @@ mkMCTable = do
, sortable Nothing (i18nCell MsgCommSubject) $ \(view resultMail -> Entity k v) ->
let subject = v ^? _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject"
linkWgt = maybe (msg2widget MsgUtilEMail) text2widget subject
in anchorCellM (MailPlainR <$> encrypt k) linkWgt
in anchorCellM (MailHtmlR <$> encrypt k) linkWgt
-- , sortable Nothing (i18nCell MsgCommContent) $ \(view $ resultMail . _entityKey -> k) -> anchorCellM (MailHtmlR <$> encrypt k) (text2widget "html")
-- , sortable Nothing (i18nCell MsgCommSubject) $ \(preview $ resultMail . _entityVal . _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject" -> h) -> cellMaybe textCell h
]
@ -219,10 +219,13 @@ handleMailShow hdr prefTypes cusm = do
<p>
^{part2widget pt}
|]
-- Include for Debugging:
-- ^{jsonWidget (sm ^. _sentMailHeaders)}
-- ^{jsonWidget (sentMailContentContent cn)}
-- Include for Debugging:
-- <section>
-- <h2>Debugging
-- <p>
-- ^{jsonWidget (sm ^. _sentMailHeaders)}
-- <p>
-- ^{jsonWidget (sentMailContentContent cn)} -- content fields needs decoding of base64 to make sense here
selectAlternative :: [ContentType] -> Alternatives -> Maybe Part
selectAlternative (fmap decodeUtf8 -> prefTypes) allAlts = aux prefTypes allAlts
@ -255,8 +258,8 @@ part2widget Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, partD
|]
where
showBody
| pt == decodeUtf8 typePlain = toWidget $ preEscapedToHtml $ plaintextToHtml $ decodeUtf8 pc
| pt == decodeUtf8 typeHtml = toWidget $ preEscapedToHtml $ decodeUtf8 pc -- preEscapedToHtml :: ToMarkup a => a -> Html
| pt == decodeUtf8 typePlain = toWidget $ preEscapedToHtml $ plainTextToHtml $ decodeUtf8 pc
| pt == decodeUtf8 typeHtml = toWidget $ preEscapedToHtml $ plainHtmlToHtml $ decodeUtf8 pc -- preEscapedToHtml :: ToMarkup a => a -> Html
| pt == decodeUtf8 typeJson =
let jw :: Aeson.Value -> Widget = jsonWidget
in either str2widget jw $ Aeson.eitherDecodeStrict' pc

54
src/Handler/Qualification.hs
View File

@ -158,7 +158,6 @@ data QualificationTableCsv = QualificationTableCsv -- Q..T..C.. -> qtc..
{ qtcDisplayName :: UserDisplayName
, qtcEmail :: UserEmail
, qtcCompany :: Maybe Text
, qtcCompanyNumbers :: CsvSemicolonList Int
, qtcValidUntil :: Day
, qtcLastRefresh :: Day
, qtcBlockStatus :: Maybe Bool
@ -174,8 +173,7 @@ qtcExample :: QualificationTableCsv
qtcExample = QualificationTableCsv
{ qtcDisplayName = "Max Mustermann"
, qtcEmail = "m.mustermann@example.com"
, qtcCompany = Just "Example Brothers LLC, SecondaryJobs Inc"
, qtcCompanyNumbers = CsvSemicolonList [27,69]
, qtcCompany = Just "Example Brothers LLC"
, qtcValidUntil = compDay
, qtcLastRefresh = compDay
, qtcBlockStatus = Nothing
@ -209,8 +207,7 @@ instance CsvColumnsExplained QualificationTableCsv where
csvColumnsExplanations = genericCsvColumnsExplanations qtcOptions $ Map.fromList
[ ('qtcDisplayName , SomeMessage MsgLmsUser)
, ('qtcEmail , SomeMessage MsgTableLmsEmail)
, ('qtcCompany , SomeMessage MsgTableCompanies)
, ('qtcCompanyNumbers , SomeMessage MsgTableCompanyNos)
, ('qtcCompany , SomeMessage MsgTablePrimeCompany)
, ('qtcValidUntil , SomeMessage MsgLmsQualificationValidUntil)
, ('qtcLastRefresh , SomeMessage MsgTableQualificationLastRefresh)
, ('qtcBlockStatus , SomeMessage MsgInfoQualificationBlockStatus)
@ -238,7 +235,7 @@ queryLmsUser = $(sqlLOJproj 3 2)
queryQualBlock :: QualificationTableExpr -> E.SqlExpr (Maybe (Entity QualificationUserBlock))
queryQualBlock = $(sqlLOJproj 3 3)
type QualificationTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity QualificationUserBlock), [Entity UserCompany])
type QualificationTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity QualificationUserBlock), E.Value (Maybe CompanyId))
resultQualUser :: Lens' QualificationTableData (Entity QualificationUser)
resultQualUser = _dbrOutput . _1
@ -252,8 +249,8 @@ resultLmsUser = _dbrOutput . _3 . _Just
resultQualBlock :: Traversal' QualificationTableData (Entity QualificationUserBlock)
resultQualBlock = _dbrOutput . _4 . _Just
resultCompanyUser :: Lens' QualificationTableData [Entity UserCompany]
resultCompanyUser = _dbrOutput . _5
resultCompanyId :: Traversal' QualificationTableData CompanyId
resultCompanyId = _dbrOutput . _5 . _unValue . _Just
instance HasEntity QualificationTableData User where
@ -340,6 +337,7 @@ qualificationTableQuery :: UTCTime -> QualificationId -> (_ -> E.SqlExpr (E.Valu
, E.SqlExpr (Entity User)
, E.SqlExpr (Maybe (Entity LmsUser))
, E.SqlExpr (Maybe (Entity QualificationUserBlock))
, E.SqlExpr (E.Value (Maybe CompanyId))
)
qualificationTableQuery now qid fltr (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` qualBlock) = do
-- E.distinctOnOrderBy will not work: sorting with dbTable should work, except that columns contained in distinctOnOrderBy cannot be sorted inversely by user; but PostgreSQL leftJoin with distinct filters too many results, see SQL Example lead/lag under jost/misc DevOps
@ -351,7 +349,11 @@ qualificationTableQuery now qid fltr (qualUser `E.InnerJoin` user `E.LeftOuterJo
E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
E.where_ $ fltr qualUser
E.&&. (E.val qid E.==. qualUser E.^. QualificationUserQualification)
return (qualUser, user, lmsUser, qualBlock)
let primeComp = E.subSelect . E.from $ \uc -> do
E.where_ $ user E.^. UserId E.==. uc E.^. UserCompanyUser
E.orderBy [E.desc $ uc E.^. UserCompanyPriority, E.asc $ uc E.^. UserCompanyCompany]
return (uc E.^. UserCompanyCompany)
return (qualUser, user, lmsUser, qualBlock, primeComp)
mkQualificationTable ::
@ -361,17 +363,19 @@ mkQualificationTable ::
=> Bool
-> Entity Qualification
-> Map QualificationTableAction (AForm Handler QualificationTableActionData)
-> (Map CompanyId Company -> cols)
-> ((CompanyId -> CompanyName) -> cols)
-> PSValidator (MForm Handler) (FormResult (First QualificationTableActionData, DBFormResult UserId Bool QualificationTableData))
-> DB (FormResult (QualificationTableActionData, Set UserId), Widget)
mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
svs <- getSupervisees
now <- liftIO getCurrentTime
-- lookup all companies
cmpMap <- memcachedBy (Just . Right $ 5 * diffMinute) ("CompanyDictionary"::Text) $ do
cmpMap <- memcachedBy (Just . Right $ 15 * diffMinute) ("CompanyDictionary"::Text) $ do
cmps <- selectList [] [] -- [Asc CompanyShorthand]
return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
let
getCompanyName :: CompanyId -> CompanyName
getCompanyName cid = maybe (unCompanyKey cid) companyName $ Map.lookup cid cmpMap -- use shorthand in case of impossible failure
nowaday = utctDay now
mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
@ -380,15 +384,8 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
fltrSvs = if isAdmin then const E.true else \quser -> quser E.^. QualificationUserUser `Ex.in_` E.vals svs
dbtSQLQuery = qualificationTableQuery now qid fltrSvs
dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjSimple $ \(qualUsr, usr, lmsUsr, qUsrBlock) -> do
-- cmps <- E.select . E.from $ \(usrComp `E.InnerJoin` comp) -> do
-- E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
-- E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val (entityKey usr)
-- E.orderBy [E.asc (comp E.^. CompanyName)]
-- return (comp E.^. CompanyName, comp E.^. CompanyAvsId, usrComp E.^. UserCompanySupervisor)
cmpUsr <- selectList [UserCompanyUser ==. entityKey usr] [Desc UserCompanyPriority, Asc UserCompanyCompany, LimitTo 1]
return (qualUsr, usr, lmsUsr, qUsrBlock, cmpUsr)
dbtColonnade = cols cmpMap
dbtProj = dbtProjId
dbtColonnade = cols getCompanyName
dbtSorting = mconcat
[ single $ sortUserNameLink queryUser
, single $ sortUserEmail queryUser
@ -471,8 +468,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
doEncode' = QualificationTableCsv
<$> view (resultUser . _entityVal . _userDisplayName)
<*> view (resultUser . _entityVal . _userDisplayEmail)
<*> (view resultCompanyUser >>= getCompanies)
<*> (view resultCompanyUser >>= getCompanyNos)
<*> preview (resultCompanyId . to getCompanyName . _CI)
<*> view (resultQualUser . _entityVal . _qualificationUserValidUntil)
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
<*> preview (resultQualBlock. _entityVal . _qualificationUserBlockUnblock . _not)
@ -480,10 +476,6 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
<*> view (resultQualUser . _entityVal . _qualificationUserScheduleRenewal)
<*> getStatusPlusTxt
<*> getStatusPlusDay
getCompanies cmps = case mapMaybe (flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany)) cmps of
[] -> pure Nothing
somecmps -> pure $ Just $ intercalate ", " $ fmap (view (_companyName . _CI)) somecmps
getCompanyNos = pure . CsvSemicolonList . mapMaybe (preview (_Just . _companyAvsId) . flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany))
getStatusPlusTxt =
(join . preview (resultLmsUser . _entityVal . _lmsUserStatus)) >>= \case
@ -585,16 +577,12 @@ postQualificationR sid qsh = do
] isAdmin
linkLmsUser = toMaybe isAdmin (LmsUserR sid qsh)
linkUserName = bool ForProfileR ForProfileDataR isAdmin
colChoices cmpMap = mconcat
colChoices getCompanyName = mconcat
[ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
, colUserNameModalHdr MsgLmsUser linkUserName
, colUserEmail
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \( view resultCompanyUser -> cmps) ->
let cs = [ companyCell (unCompanyKey cmpId) cmpName cmpSpr
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
, let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap
]
in intercalate spacerCell cs
, sortable (Just "user-company") (i18nCell MsgTablePrimeCompany) $ \(preview resultCompanyId -> mcid) ->
maybeEmpty mcid $ \cid -> companyCell (unCompanyKey cid) (getCompanyName cid) False
, guardMonoid isAdmin $ colUserMatriclenr isAdmin
-- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d

26
src/Handler/Utils/DateTime.hs
View File

@ -10,7 +10,8 @@ module Handler.Utils.DateTime
, toTimeOfDay
, toMidnight, beforeMidnight, toMidday, toMorning
, toFullHour, roundDownToMinutes, addHours
, formatDiffDays, formatCalendarDiffDays
, formatDiffDays, formatDiffHours
, formatCalendarDiffDays
, formatTime'
, formatTime, formatTimeUser, formatTimeW, formatTimeMail
, formatTimeRange, formatTimeRangeW, formatTimeRangeMail
@ -144,8 +145,8 @@ getDateTimeFormatUser sel mUser = do
getDateTimeFormatUser' :: SelDateTimeFormat -> User -> DateTimeFormat
getDateTimeFormatUser' SelFormatDateTime usr = usr & userDateTimeFormat
getDateTimeFormatUser' SelFormatDate usr = usr & userDateFormat
getDateTimeFormatUser' SelFormatTime usr = usr & userTimeFormat
getDateTimeFormatUser' SelFormatDate usr = usr & userDateFormat
getDateTimeFormatUser' SelFormatTime usr = usr & userTimeFormat
getDateTimeFormatter :: (MonadHandler m, HandlerSite m ~ UniWorX, YesodAuthPersist UniWorX, AuthEntity UniWorX ~ User, AuthId UniWorX ~ UserId) => m DateTimeFormatter
getDateTimeFormatter = do
@ -160,7 +161,7 @@ getDateTimeFormatterUser mUser = do
return $ mkDateTimeFormatter locale formatMap appTZ
getDateTimeFormatterUser' :: (MonadHandler m) => User -> m DateTimeFormatter
getDateTimeFormatterUser' usr = do
getDateTimeFormatterUser' usr = do
locale <- getTimeLocale
let formatMap = flip getDateTimeFormatUser' usr
return $ mkDateTimeFormatter locale formatMap appTZ
@ -263,18 +264,21 @@ formatDiffDays t
inHours = tshow $ convertBy nominalHour
inMinutes = tshow $ convertBy nominalMinute
formatDiffHours :: Integral a => a -> Text
formatDiffHours = formatDiffDays . secondsToNominalDiffTime . (* 360) . fromIntegral
formatCalendarDiffDays :: CalendarDiffDays -> Text
formatCalendarDiffDays = pack . iso8601Show
formatCalendarDiffDays = pack . iso8601Show
setYear :: Integer -> Day -> Day
setYear year date = fromGregorian year m d
where
(_,m,d) = toGregorian date
getYear :: Day -> Integer
getYear :: Day -> Integer
getYear date = y
where
(y,_,_) = toGregorian date
where
(y,_,_) = toGregorian date
dayOfWeekDiff :: DayOfWeek -> DayOfWeek -> Int
dayOfWeekDiff a b = mod (fromEnum a - fromEnum b) 7
@ -310,10 +314,10 @@ addLocalDays n utct = localTimeToUTCTZ appTZ newLocal
-- CalendarDiffDays --
----------------------
fromMonths :: Integral a => a -> CalendarDiffDays
fromMonths :: Integral a => a -> CalendarDiffDays
fromMonths (toInteger -> m) = CalendarDiffDays { cdMonths = m, cdDays = 0 } -- above is equivalent
fromDays :: Integral a => a -> CalendarDiffDays
fromDays :: Integral a => a -> CalendarDiffDays
fromDays (toInteger -> d) = CalendarDiffDays { cdMonths = 0, cdDays = d }
addDiffDaysClip :: CalendarDiffDays -> UTCTime -> UTCTime
@ -393,7 +397,7 @@ formatTimeRangeMail = formatTimeRange' formatTimeMail
formatGregorianW :: (YesodAuthPersist UniWorX, AuthEntity UniWorX ~ User, AuthId UniWorX ~ UserId) => Integer -> Int -> Int -> WidgetFor UniWorX ()
formatGregorianW y m d = formatTimeW SelFormatDate $ fromGregorian y m d
instance Csv.ToField ZonedTime where
instance Csv.ToField ZonedTime where
toField = Csv.toField . iso8601Show
-- also see Data.Time.Clock.Instances

10
src/Model/Types/Markup.hs
View File

@ -9,7 +9,7 @@ module Model.Types.Markup
, markdownToStoredMarkup
, esqueletoMarkupOutput
, I18nStoredMarkup
, markupIsSmallish
, markupIsSmallish
, html2textlines
, isSimilarMarkup
) where
@ -53,7 +53,7 @@ data StoredMarkup = StoredMarkup
deriving anyclass (Binary, Hashable, NFData)
isSimilarMarkup :: StoredMarkup -> StoredMarkup -> Bool
isSimilarMarkup StoredMarkup{markupInputFormat=af, markupInput=ai}
isSimilarMarkup StoredMarkup{markupInputFormat=af, markupInput=ai}
StoredMarkup{markupInputFormat=bf, markupInput=bi}
= af==bf && ai == bi
@ -74,7 +74,7 @@ plaintextToStoredMarkup :: Textual t => t -> StoredMarkup
plaintextToStoredMarkup (repack -> t) = StoredMarkup
{ markupInputFormat = MarkupPlaintext
, markupInput = t
, markupOutput = plaintextToHtml $ LT.toStrict t
, markupOutput = plainTextToHtml $ LT.toStrict t
}
preEscapedToStoredMarkup :: Textual t => t -> StoredMarkup
preEscapedToStoredMarkup (repack -> t) = StoredMarkup
@ -86,8 +86,8 @@ markdownToStoredMarkup :: Textual t => t -> StoredMarkup
markdownToStoredMarkup (repack -> t) = StoredMarkup
{ markupInputFormat = MarkupMarkdown
, markupInput = t
, markupOutput = plaintextToHtml $ LT.toStrict t
}
, markupOutput = plainTextToHtml $ LT.toStrict t
}
esqueletoMarkupOutput :: E.SqlExpr (E.Value StoredMarkup) -> E.SqlExpr (E.Value Html)

1
src/Utils/Lens.hs
View File

@ -316,6 +316,7 @@ makeLenses_ ''AuthorshipStatementDefinition
makeLenses_ ''PrintJob
makeLenses_ ''InterfaceLog
makeLenses_ ''InterfaceHealth
makeLenses_ ''AdminProblem
makeLenses_ ''ProblemLog

11
src/Utils/Pandoc.hs
View File

@ -19,11 +19,16 @@ import qualified Text.Pandoc as P
markdownToHtml :: Html -> Either P.PandocError Html
markdownToHtml html = P.runPure $ P.writeHtml5 htmlWriterOptions =<< P.readMarkdown markdownReaderOptions (toStrict $ renderHtml html)
plaintextToHtml :: Text -> Html
plaintextToHtml text = fromRight (toMarkup text) $ P.runPure $
plainTextToHtml :: Text -> Html
plainTextToHtml text = fromRight (toMarkup text) $ P.runPure $
P.writeHtml5 htmlWriterOptions =<< P.readMarkdown markdownReaderOptions text
-- Line below does not work as intended, also see Handler.Utils.Pandoc.plaintextToMarkdownWith which uses this code
-- where pandoc = P.Pandoc mempty [P.Plain [P.Str text]]
-- where pandoc = P.Pandoc mempty [P.Plain [P.Str text]]
plainHtmlToHtml :: Text -> Html
plainHtmlToHtml text = fromRight (toMarkup text) $ P.runPure $
P.writeHtml5 htmlWriterOptions =<< P.readHtml markdownReaderOptions text
htmlReaderOptions, markdownReaderOptions :: P.ReaderOptions

6
templates/admin-problems.hamlet
View File

@ -1,6 +1,6 @@
$newline never
$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
$# SPDX-FileCopyrightText: 2022-24 Steffen Jost <s.jost@fraport.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
@ -62,7 +62,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
$else
_{MsgInterfacesOk}
^{interfaceTable}
<p>
<a href=@{ConfigInterfacesR}>
_{MsgConfigInterfacesHeading}
<section>
<h2>
_{MsgProblemsHeadingMisc}

41
templates/i18n/config-interfaces/de-de-formal.hamlet Normal file
View File

@ -0,0 +1,41 @@
$newline never
$# SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<h2>
_{MsgMenuInterfaces}
<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.
<p>
^{configTable}
<section>
<h2>
_{MsgMenuInterfaces}
<div>
<p>
Current interface health is shown here for reference
<p>
$if interfacesBadNr > 0
_{MsgInterfacesFail interfacesBadNr}
$else
_{MsgInterfacesOk}
^{interfaceTable}

36
templates/i18n/config-interfaces/en-eu.hamlet Normal file
View File

@ -0,0 +1,36 @@
$newline never
$# SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<h2>
_{MsgMenuInterfaces}
<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.
<p>
^{configTable}
<section>
<h2>
_{MsgMenuInterfaces}
<div>
<p>
Current interface health is shown here for reference
<p>
$if interfacesBadNr > 0
_{MsgInterfacesFail interfacesBadNr}
$else
_{MsgInterfacesOk}
^{interfaceTable}