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

chore(lms): towards #169 option to prevent qualifications to renew automatically upon e-learning

Browse Source
This commit is contained in:
Steffen Jost 2024-07-03 15:47:23 +02:00
parent 0ac75e0d59
commit 0725a9a908
11 changed files with 54 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatis
QualificationRefreshReminder: 2. Erinnerung QualificationRefreshReminder: 2. Erinnerung
QualificationRefreshReminderTooltip: Optionaler Zeitraum vor Ablauf zur Versendung einer zweiten Erinnerung per Brief oder Email mit identischen Zugangsdaten, sofern in diesem Zeitraum vor Ablauf noch keine Ablaufbenachrichtigung versendet wurde. QualificationRefreshReminderTooltip: Optionaler Zeitraum vor Ablauf zur Versendung einer zweiten Erinnerung per Brief oder Email mit identischen Zugangsdaten, sofern in diesem Zeitraum vor Ablauf noch keine Ablaufbenachrichtigung versendet wurde.
QualificationElearningStart: Wird das E‑Learning automatisch gestartet? QualificationElearningStart: Wird das E‑Learning automatisch gestartet?
QualificationElearningRenew: Verlängert ein erfolgreiches E‑Learning die Qualifikation automatisch um die reguläre Gültigkeitsdauer?
QualificationExpiryNotification: Ungültigkeitsbenachrichtigung? QualificationExpiryNotification: Ungültigkeitsbenachrichtigung?
QualificationExpiryNotificationTooltip: Nutzer werden benachrichtigt, wenn die Qualifikation ungültig wird, sofern der jeweilige Nutzer in seinen Benutzereinstellungen diese Art Benachrichtigung aktiviert hat. QualificationExpiryNotificationTooltip: Nutzer werden benachrichtigt, wenn die Qualifikation ungültig wird, sofern der jeweilige Nutzer in seinen Benutzereinstellungen diese Art Benachrichtigung aktiviert hat.
TableQualificationCountActive: Aktive TableQualificationCountActive: Aktive
@ -47,11 +48,12 @@ QualificationExpired: Ungültig seit
LmsUser: Inhaber LmsUser: Inhaber
LmsURL: Link E‑Learning LmsURL: Link E‑Learning
TableLmsEmail: E‑Mail TableLmsEmail: E‑Mail
TableLmsIdent: E-Learning Benutzer TableLmsIdent: E‑Learning Benutzer
TableLmsElearning: E‑Learning TableLmsElearning: E‑Learning
TableLmsElearningRenews: Automatische Verlängerung
TableLmsPin: E‑Learning Passwort TableLmsPin: E‑Learning Passwort
TableLmsResetPin: E-Learning Passwort zurücksetzen? TableLmsResetPin: E‑Learning Passwort zurücksetzen?
TableLmsDatePin: E-Learning Passwort erstellt TableLmsDatePin: E‑Learning Passwort erstellt
TableLmsDate: Datum TableLmsDate: Datum
TableLmsDelete: Löschen? TableLmsDelete: Löschen?
TableLmsStaff: Interner Mitarbeiter? TableLmsStaff: Interner Mitarbeiter?
@ -89,7 +91,8 @@ LmsReportInsert: Neues LMS Ereignis
LmsReportUpdate: LMS Ereignis Aktualisierung LmsReportUpdate: LMS Ereignis Aktualisierung
LmsReportCsvExceptionDuplicatedKey: CSV-Import LmsReport fand uneindeutigen Schlüssel LmsReportCsvExceptionDuplicatedKey: CSV-Import LmsReport fand uneindeutigen Schlüssel
LmsDirectUpload: Direkter Upload für automatisierte Systeme LmsDirectUpload: Direkter Upload für automatisierte Systeme
LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde. LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde!
LmsErrorNoRenewElearning: Fehler: Erfoglreiches E‑Learning verlängert die Qualifikation nicht automatisch, da die Gültigkeitsdauer nicht festgelegt wurde!
MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig

5
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optional period before expiry to start e‑le
QualificationRefreshReminder: 2. Reminder QualificationRefreshReminder: 2. Reminder
QualificationRefreshReminderTooltip: Optional period before expiry to send a second notification by post or email once more, provided that no renewal notification was sent in this period before expiry. QualificationRefreshReminderTooltip: Optional period before expiry to send a second notification by post or email once more, provided that no renewal notification was sent in this period before expiry.
QualificationElearningStart: Is e‑learning automatically started? QualificationElearningStart: Is e‑learning automatically started?
QualificationElearningRenew: Does successful e‑learning automatically extend a qualification by the default validity period?
QualificationExpiryNotification: Invalidity notification? QualificationExpiryNotification: Invalidity notification?
QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings. QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings.
TableQualificationCountActive: Active TableQualificationCountActive: Active
@ -50,6 +51,7 @@ TableLmsEmail: Email
TableLmsIdent: E‑learning user TableLmsIdent: E‑learning user
TableLmsPin: E‑learning password TableLmsPin: E‑learning password
TableLmsElearning: E‑learning TableLmsElearning: E‑learning
TableLmsElearningRenews: Automatic renewal
TableLmsResetPin: Reset E‑learning password? TableLmsResetPin: Reset E‑learning password?
TableLmsDatePin: E‑learning password created TableLmsDatePin: E‑learning password created
TableLmsDate: Date TableLmsDate: Date
@ -89,7 +91,8 @@ LmsReportInsert: New LMS event
LmsReportUpdate: Update of LMS event LmsReportUpdate: Update of LMS event
LmsReportCsvExceptionDuplicatedKey: CSV Import LmsReport with ambiguous key LmsReportCsvExceptionDuplicatedKey: CSV Import LmsReport with ambiguous key
LmsDirectUpload: Direct upload for automated systems LmsDirectUpload: Direct upload for automated systems
LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set. LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set!
LmsErrorNoRenewElearning: Error: E‑learning will not automatically extend validity due to validity duration not being set!
MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly
MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon
MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid

2
models/lms.model
View File

@ -13,7 +13,7 @@ Qualification
refreshWithin CalendarDiffDays Maybe -- notify users about renewal within this number of month/days before expiry; to be used with addGregorianDurationClip refreshWithin CalendarDiffDays Maybe -- notify users about renewal within this number of month/days before expiry; to be used with addGregorianDurationClip
refreshReminder CalendarDiffDays Maybe -- send a second notification about renewal within this number of month/days before expiry refreshReminder CalendarDiffDays Maybe -- send a second notification about renewal within this number of month/days before expiry
elearningStart Bool -- automatically schedule e-refresher elearningStart Bool -- automatically schedule e-refresher
-- elearningOnly Bool -- successful E-learing automatically increases validity. NO! elearningRenews Bool default=true -- successful E-learing automatically increases validity automatically by validDuration
expiryNotification Bool default=true -- should expiryNotification be generated for this qualification? expiryNotification Bool default=true -- should expiryNotification be generated for this qualification?
avsLicence AvsLicence Maybe -- if set, valid QualificationUsers are synchronized to AVS as a driving licence avsLicence AvsLicence Maybe -- if set, valid QualificationUsers are synchronized to AVS as a driving licence
sapId Text Maybe -- if set, valid QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id sapId Text Maybe -- if set, valid QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id

1
src/Handler/Admin/Test.hs
View File

@ -351,6 +351,7 @@ getAdminTestPdfR = do
, qualShort = qual ^. _qualificationShorthand . _CI , qualShort = qual ^. _qualificationShorthand . _CI
, qualSchool = qual ^. _qualificationSchool , qualSchool = qual ^. _qualificationSchool
, qualDuration = qual ^. _qualificationValidDuration , qualDuration = qual ^. _qualificationValidDuration
, qualRenewAuto = qual ^. _qualificationElearningRenews
, isReminder = False , isReminder = False
} }
apcIdent <- letterApcIdent letter encRecipient now apcIdent <- letterApcIdent letter encRecipient now

1
src/Handler/PrintCenter.hs
View File

@ -94,6 +94,7 @@ lrqf2letter LRQF{..}
, qualShort = lrqfQuali ^. _qualificationShorthand . _CI , qualShort = lrqfQuali ^. _qualificationShorthand . _CI
, qualSchool = lrqfQuali ^. _qualificationSchool , qualSchool = lrqfQuali ^. _qualificationSchool
, qualDuration = lrqfQuali ^. _qualificationValidDuration , qualDuration = lrqfQuali ^. _qualificationValidDuration
, qualRenewAuto = lrqfQuali ^. _qualificationElearningRenews
, isReminder = lrqfReminder , isReminder = lrqfReminder
} }
return (fromMaybe usr rcvr, SomeLetter letter) return (fromMaybe usr rcvr, SomeLetter letter)

2
src/Handler/Qualification.hs
View File

@ -102,6 +102,8 @@ mkQualificationAllTable isAdmin = do
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder) foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder)
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart) , sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
$ tickmarkCell . view (resultAllQualification . _qualificationElearningStart) $ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
, sortable (Just "qelearrenew") (i18nCell MsgTableLmsElearningRenews & cellTooltip MsgQualificationElearningRenew)
$ tickmarkCell . view (resultAllQualification . _qualificationElearningRenews)
, sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip) , sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip)
$ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification) $ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification)
, sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip) , sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip)

4
src/Handler/Utils/Qualification.hs
View File

@ -189,6 +189,8 @@ renewValidQualificationUsers qid reason renewalTime uids =
-- E.where_ $ (qu E.^. QualificationUserQualification E.==. E.val qid ) -- E.where_ $ (qu E.^. QualificationUserQualification E.==. E.val qid )
-- E.&&. (qu E.^. QualificationUserUser `E.in_` E.valList uids) -- E.&&. (qu E.^. QualificationUserUser `E.in_` E.valList uids)
get qid >>= \case get qid >>= \case
Just Qualification{qualificationElearningRenews=False}
| Just (Right (QualificationRenewELearningBy _)) <- reason -> return 0
Just Qualification{qualificationValidDuration=Just renewalMonths} -> do Just Qualification{qualificationValidDuration=Just renewalMonths} -> do
cutoff <- maybe (liftIO getCurrentTime) return renewalTime cutoff <- maybe (liftIO getCurrentTime) return renewalTime
quEntsAll <- selectValidQualifications qid uids cutoff quEntsAll <- selectValidQualifications qid uids cutoff
@ -227,7 +229,7 @@ qualificationUserBlocking ::
, Num n , Num n
) => QualificationId -> [UserId] -> Bool -> Maybe UTCTime -> QualificationChangeReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n ) => QualificationId -> [UserId] -> Bool -> Maybe UTCTime -> QualificationChangeReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n
qualificationUserBlocking qid uids unblock mbBlockTime (qualificationChangeReasonText -> reason) notify = do qualificationUserBlocking qid uids unblock mbBlockTime (qualificationChangeReasonText -> reason) notify = do
$logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow uids, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify] $logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify, "#Users:" <> tshow (length uids), tshow uids] -- this message can get very long on test systems
authUsr <- liftHandler maybeAuthId authUsr <- liftHandler maybeAuthId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let blockTime = fromMaybe now mbBlockTime let blockTime = fromMaybe now mbBlockTime

2
src/Jobs/Handler/LMS.hs
View File

@ -336,7 +336,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
-- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log -- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log
-- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|]) -- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|])
-- END LMS WORKAROUND 2 -- END LMS WORKAROUND 2
ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser] -- only valid qualifications are truly renewed and only if validDuration is set and elearningRenews is true; transcribes to audit log
update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay] update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay]
return $ Sum ok_renew return $ Sum ok_renew
in lrepQry lrFltrSuccess in lrepQry lrFltrSuccess

26
src/Jobs/Handler/SendNotification/Qualification.hs
View File

@ -98,18 +98,19 @@ dispatchNotificationQualificationRenewal nQualification nReminder jRecipient = d
(Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do (Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do
let qname = CI.original qualificationName let qname = CI.original qualificationName
letter = LetterRenewQualification letter = LetterRenewQualification
{ lmsLogin = lmsUserIdent { lmsLogin = lmsUserIdent
, lmsPin = lmsUserPin , lmsPin = lmsUserPin
, qualHolderID = jRecipient , qualHolderID = jRecipient
, qualHolderDN = userDisplayName , qualHolderDN = userDisplayName
, qualHolderSN = userSurname , qualHolderSN = userSurname
, qualExpiry = qualificationUserValidUntil , qualExpiry = qualificationUserValidUntil
, qualId = nQualification , qualId = nQualification
, qualName = qname , qualName = qname
, qualShort = CI.original qualificationShorthand , qualShort = CI.original qualificationShorthand
, qualSchool = qualificationSchool , qualSchool = qualificationSchool
, qualDuration = qualificationValidDuration , qualDuration = qualificationValidDuration
, isReminder = nReminder , qualRenewAuto = qualificationElearningRenews
, isReminder = nReminder
} }
$logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname $logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname
notifyOk <- sendEmailOrLetter jRecipient letter notifyOk <- sendEmailOrLetter jRecipient letter
@ -120,4 +121,3 @@ dispatchNotificationQualificationRenewal nQualification nReminder jRecipient = d
(Nothing, _, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: User does not exist!" (Nothing, _, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: User does not exist!"
(_, _, Nothing, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: QualificationUser does not exist, i.e. user does not have this qualification!" (_, _, Nothing, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: QualificationUser does not exist, i.e. user does not have this qualification!"
(_, _, _, Nothing) -> $logWarnS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: LmsUser does not exist!" (_, _, _, Nothing) -> $logWarnS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: LmsUser does not exist!"

7
templates/qualification.hamlet
View File

@ -50,6 +50,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
#{icon IconNotificationError} #{icon IconNotificationError}
_{MsgLmsErrorNoRefreshElearning} _{MsgLmsErrorNoRefreshElearning}
<dt .deflist__dt>_{MsgQualificationElearningRenew}
<dd .deflist__dd>#{boolSymbol (qualificationElearningRenews quali)}
$if (qualificationElearningRenews quali) && isNothing (qualificationValidDuration quali)
<p>
#{icon IconNotificationError}
_{MsgLmsErrorNoRefreshElearning}
<section> <section>
^{qualificationTable} ^{qualificationTable}

6
test/Database/Fill.hs
View File

@ -753,9 +753,9 @@ fillDb = do
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|] let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|] let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True (Just AvsLicenceVorfeld) $ Just "F4466" qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True True (Just AvsLicenceVorfeld) $ Just "F4466"
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False (Just AvsLicenceRollfeld) $ Just "R2801" qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False False (Just AvsLicenceRollfeld) $ Just "R2801"
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing False True Nothing Nothing qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing True False True Nothing Nothing
qfjost <- insert' $ QualificationUser jost qid_f (n_day 11) (n_day $ -1) (n_day $ -22) True (n_day' $ -9) -- TODO: better dates! qfjost <- insert' $ QualificationUser jost qid_f (n_day 11) (n_day $ -1) (n_day $ -22) True (n_day' $ -9) -- TODO: better dates!
void . insert $ QualificationUserBlock qfjost False (n_day' $ -6) "First block" (Just svaupel) void . insert $ QualificationUserBlock qfjost False (n_day' $ -6) "First block" (Just svaupel)
void . insert $ QualificationUserBlock qfjost True (n_day' $ -5) "Second unblock" (Just gkleen) void . insert $ QualificationUserBlock qfjost True (n_day' $ -5) "Second unblock" (Just gkleen)