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

fix(lms): allow 2nd reminders to be independent of renewal period

Browse Source
This commit is contained in:
Steffen Jost 2024-07-12 17:14:39 +02:00
parent e6f0454e78
commit d853e8559b
8 changed files with 22 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -11,9 +11,9 @@ QualificationAuditDuration: Aufbewahrung Audit Log
QualificationAuditDurationTooltip n@Int: Optionaler Zeitraum zur Löschung von E‑Learning Daten. Hinweis: Der E‑Learning Server kann seine anonymisierten Daten schon früher löschen, aber spätestens #{n} Tage nach Abschluss.
QualificationAuditDurationReuseError: Diese Qualifikation nutzt das E‑Learning einer anderen Qualifikation, für die derzeit keinen Löschzeitraum konfiguriert wurde.
QualificationRefreshWithin: Erneurerungszeitraum
QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatischen Start des E‑Learnings und Versand einer Benachrichtigung per Brief oder Email.
QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für eine Benachrichtigung per Email. Bei aktiviertem automatischem E‑Learning wird dieses gestartet und die Benachrichtigung erfolgt per Brief oder Email.
QualificationRefreshReminder: Zweite 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 E‑Learning Zugangsdaten, sofern die Qualifikation noch gültig und das E‑Learning noch offen ist.
QualificationElearningStart: Wird das E‑Learning automatisch gestartet?
QualificationElearningRenew: Verlängert ein erfolgreiches E‑Learning die Qualifikation automatisch um die reguläre Gültigkeitsdauer?
QualificationElearningLimit: Ist die Anzahl der E‑Learning Versuche limitiert?

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

@ -11,9 +11,9 @@ QualificationAuditDuration: Audit log retention period
QualificationAuditDurationTooltip n@Int: Optional period for deletion of e‑learning data. Note that the e‑learning server may delete its anonymised data earlier, at most #{n} days after closing.
QualificationAuditDurationReuseError: This qualification reuses the e‑learning from another qualification, which has no audit duration configured.
QualificationRefreshWithin: Refresh within
QualificationRefreshWithinTooltip: Optional period before expiry to start e‑learning and send a notification by post or email.
QualificationRefreshWithinTooltip: Optional period before expiry to send a notification by email. If e‑learning is set to start automatically, it will be started and e‑learning credentials are send with this notification by post or email.
QualificationRefreshReminder: Second 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, including the existing credentials, provided that the e‑learning is still undecided and the qualification has not yet expired.
QualificationElearningStart: Is e‑learning automatically started?
QualificationElearningRenew: Does successful e‑learning automatically extend a qualification by the default validity period?
QualificationElearningLimit: Is the number of e‑learning attempts limited?

2
src/Handler/Admin/Avs.hs
View File

@ -639,7 +639,7 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
mkOption :: E.Value Text -> Option Text
mkOption (E.unValue -> t) = Option{ optionDisplay = t, optionInternalValue = t, optionExternalValue = toPathPiece t }
suggestionsBlock :: HandlerFor UniWorX (OptionList Text)
suggestionsBlock = mkOptionList . fmap mkOption <$> runDBRead (getBlockReasons E.not_)
suggestionsBlock = mkOptionList . fmap mkOption <$> runDBRead (getBlockReasons E.not__)
suggestionsUnblock = mkOptionList . fmap mkOption <$> runDBRead (getBlockReasons id)
acts :: Map LicenceTableAction (AForm Handler LicenceTableActionData)

6
src/Handler/LMS.hs
View File

@ -149,12 +149,14 @@ mkLmsAllTable isAdmin lmsDeletionDays = do
, sortable Nothing (i18nCell MsgQualificationRefreshWithin & cellTooltips [SomeMessage MsgQualificationRefreshWithinTooltip , SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshWithin)
-- , sortable Nothing (i18nCell MsgQualificationRefreshWithin) $ foldMap textCell . view (resultAllQualification . _qualificationRefreshWithin . to formatCalendarDiffDays) -- does not work, since there is a maybe in between
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart) $ \row ->
let elearnstart = row ^. resultAllQualification . _qualificationElearningStart
reminder = row ^. resultAllQualification . _qualificationRefreshReminder
in tickmarkCell $ elearnstart && isJust reminder
, sortable Nothing (i18nCell MsgQualificationRefreshReminder & cellTooltips [SomeMessage MsgQualificationRefreshReminderTooltip, SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder)
, sortable Nothing (i18nCell MsgQualificationAuditDuration & cellTooltips [SomeMessage (MsgQualificationAuditDurationTooltip lmsDeletionDays), SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays . fromMonths) . view (resultAllQualification . _qualificationAuditDuration)
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
$ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
, sortable (Just "qel-renew") (i18nCell MsgTableLmsElearningRenews & cellTooltip MsgQualificationElearningRenew)
$ tickmarkCell . view (resultAllQualification . _qualificationElearningRenews)
, sortable (Just "qel-limit") (i18nCell MsgTableLmsElearningLimit & cellTooltip MsgQualificationElearningLimit)

6
src/Handler/Qualification.hs
View File

@ -96,12 +96,14 @@ mkQualificationAllTable isAdmin = do
maybeCell (qualificationDescription quali) markupCellLargeModal
, sortable Nothing (i18nCell MsgQualificationValidDuration & cellTooltip MsgTableDiffDaysTooltip) $
foldMap (textCell . formatCalendarDiffDays . fromMonths) . view (resultAllQualification . _qualificationValidDuration)
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart) $ \row ->
let elearnstart = row ^. resultAllQualification . _qualificationElearningStart
reminder = row ^. resultAllQualification . _qualificationRefreshReminder
in tickmarkCell $ elearnstart && isJust reminder
, sortable Nothing (i18nCell MsgQualificationRefreshWithin & cellTooltips [SomeMessage MsgQualificationRefreshWithinTooltip , SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshWithin)
, sortable Nothing (i18nCell MsgQualificationRefreshReminder & cellTooltips [SomeMessage MsgQualificationRefreshReminderTooltip, SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder)
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
$ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
, sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip)
$ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification)
-- , sortable (Just "qelearrenew") (i18nCell MsgTableLmsElearningRenews & cellTooltip MsgQualificationElearningRenew)

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

@ -99,7 +99,7 @@ addDefaultSupervisorsFor reason mbSuperId mutualSupervision cids = do
(do
(spr :& usr) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @UserCompany `E.on` (\(spr :& usr) -> spr E.^. UserCompanyCompany E.==. usr E.^. UserCompanyCompany)
E.where_ $ E.and $ guardMonoid (not mutualSupervision)
[ E.not_ $ usr E.^. UserCompanySupervisor ]
[ E.not__ $ usr E.^. UserCompanySupervisor ]
<> maybeEmpty mbSuperId (\sprId -> [E.exists $ do
superv <- E.from $ E.table @UserSupervisor
E.where_ $ superv E.^. UserSupervisorSupervisor E.==. E.val sprId
@ -130,7 +130,7 @@ addDefaultSupervisorsAll reason mutualSupervision cids = do
(do
(spr :& usr) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @UserCompany `E.on` (\(spr :& usr) -> spr E.^. UserCompanyCompany E.==. usr E.^. UserCompanyCompany)
E.where_ $ E.and $ guardMonoid (not mutualSupervision)
[ E.not_ $ usr E.^. UserCompanySupervisor ]
[ E.not__ $ usr E.^. UserCompanySupervisor ]
<> [ spr E.^. UserCompanySupervisor
, spr E.^. UserCompanyCompany `E.in_` E.vals cids
, usr E.^. UserCompanyCompany `E.in_` E.vals cids

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

@ -52,7 +52,7 @@ quserToNotify cutoff quser qblock = -- either recently become invalid with no pr
quser E.^. QualificationUserScheduleRenewal
E.&&. (( quser E.^. QualificationUserValidUntil E.<. E.val (utctDay cutoff)
E.&&. quser E.^. QualificationUserValidUntil E.>. E.day (quser E.^. QualificationUserLastNotified)
E.&&. E.not_ (E.isFalse (qblock E.?. QualificationUserBlockUnblock)) -- not currently blocked
E.&&. E.not__ (E.isFalse (qblock E.?. QualificationUserBlockUnblock)) -- not currently blocked
) E.||. ( -- was recently blocked
E.isFalse (qblock E.?. QualificationUserBlockUnblock)
E.&&. qblock E.?. QualificationUserBlockFrom E.>. E.just (quser E.^. QualificationUserLastNotified)

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

@ -46,12 +46,15 @@ fetchRefreshQualifications qidJob = do
qids <- E.select $ do
q <- E.from $ E.table @Qualification
E.where_ $ E.isJust (q E.^. QualificationRefreshWithin)
E.||. E.isJust (q E.^. QualificationRefreshReminder)
E.||. q E.^. QualificationExpiryNotification
pure $ q E.^. QualificationId
forM_ qids $ \(E.unValue -> qid) ->
queueDBJob $ qidJob qid
-- | enlist expiring qualification holders to e-learning
-- Second reminders sent for users with validQualifications and open LMS only
-- NOTE: getting rid of QualificationId parameter and using a DB-join fails, since addGregorianDurationClip cannot be performed within DB
dispatchJobLmsEnqueue :: QualificationId -> JobHandler UniWorX
dispatchJobLmsEnqueue qid = JobHandlerAtomic act
@ -89,9 +92,7 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
}
_ -> return ()
case qualificationRefreshWithin quali of
Nothing -> return () -- no renewal period, no
(Just renewalPeriod) -> do
ifNothingM (qualificationRefreshWithin quali) () $ \renewalPeriod -> do -- no refreshWithin, no first reminders
let renewalDate = addGregorianDurationClip renewalPeriod nowaday
renewalUsers <- E.select $ do
quser <- E.from $ E.table @QualificationUser
@ -202,6 +203,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
-- E.&&. E.isNothing (luser E.^. LmsUserEnded)
E.&&. E.not__ (validQualification now quser)
pure (luser E.?. LmsUserId, quser E.^. QualificationUserUser)
-- TODO: why do we block expired users again? to notify?
nrBlocked <- qualificationUserBlocking qid (E.unValue . snd <$> expiredUsers) False (Just now) (Right QualificationBlockExpired) True -- essential that blocks occur only once
let expiredLearners = [ luid | (E.Value (Just luid), _) <- expiredUsers ]
-- let expiredLearners = catMaybes (E.unValue . fst <$> expiredUsers)
@ -404,7 +406,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
E.<&> E.false)
E.insertSelect $ do
lrl <- E.from $ E.table @LmsReportLog
E.where_ $ E.not_ (lrl E.^. LmsReportLogMissing)
E.where_ $ E.not__ (lrl E.^. LmsReportLogMissing)
E.&&. lrl E.^. LmsReportLogQualification E.==. E.val qid
E.&&. E.notExists (do
lreport <- E.from $ E.table @LmsReport