From 9bd1076a9cdc97795ba37e11dffe20bc5a5e26b5 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 19 Jun 2023 14:44:50 +0000 Subject: [PATCH] chore(lms): prepare renewal letter sending --- .../categories/qualification/de-de-formal.msg | 5 ++- .../categories/qualification/en-eu.msg | 27 +++++++------- .../categories/settings/de-de-formal.msg | 3 +- .../uniworx/categories/settings/en-eu.msg | 3 +- models/lms.model | 1 + src/Handler/Admin/Test.hs | 1 + src/Handler/LMS.hs | 2 +- src/Handler/PrintCenter.hs | 33 +++++++++-------- src/Handler/Profile.hs | 5 +-- src/Handler/Qualification.hs | 7 ++-- src/Jobs/Handler/LMS.hs | 36 +++++++++++++++++-- src/Jobs/Handler/QueueNotification.hs | 6 ++-- .../Handler/SendNotification/Qualification.hs | 5 +-- src/Jobs/Types.hs | 6 ++-- src/Model/Types/Mail.hs | 3 +- src/Utils/Print/RenewQualification.hs | 1 + templates/qualification.hamlet | 12 +++++++ test/Database/Fill.hs | 6 ++-- 18 files changed, 112 insertions(+), 50 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index c83010f5b..997f6e531 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -9,7 +9,9 @@ QualificationValidIndicator: Gültigkeit QualificationValidDuration: Gültigkeitsdauer QualificationAuditDuration: Aufbewahrung Audit Log QualificationRefreshWithin: Erneurerungszeitraum -QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E‑Learning +QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatischen Start des E‑Learnings und Versand einer Benachrichtigung per Brief oder Email +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 QualificationElearningStart: Wird das E‑Learning automatisch gestartet? 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. @@ -101,6 +103,7 @@ QualificationStatusBlock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} QualificationStatusUnblock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} reaktiviert LmsRenewalInstructions: Weitere Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF mit dem im FRADrive hinterlegten PDF-Passwort des Prüflings verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort die Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach. LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E‑Learning verlängert werden. +LmsRenewalReminder: Erinnerung LmsActNotify: Benachrichtigung E‑Learning erneut per Post oder E-Mail versenden LmsActRenewPin: Neues zufällige E‑Learning Passwort zuweisen LmsActRenewNotify: Neue zufällige E‑Learning Passwort zuweisen und Benachrichtigung per Post oder E-Mail versenden diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index 1e83b6b6a..2c730c639 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -9,7 +9,9 @@ QualificationValidIndicator: Validity QualificationValidDuration: Validity period QualificationAuditDuration: Audit log keept QualificationRefreshWithin: Refresh within -QualificationRefreshWithinTooltip: Period before expiry to send a notification or to start e‑learning +QualificationRefreshWithinTooltip: Optional period before expiry to start e‑learning and send a notification by post or email +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 QualificationElearningStart: Is e‑learning automatically started? QualificationExpiryNotification: Invalidity notification? QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings. @@ -37,13 +39,13 @@ QualificationBlockNotify: Send notification QualificationBlockRemoveSupervisor: Remove all supervisors QualificationExpired: Expired on LmsUser: Licensee -LmsURL: Link E-learning +LmsURL: Link E‑learning TableLmsEmail: Email -TableLmsIdent: E-learning user +TableLmsIdent: E‑learning user TableLmsPin: E‑learning password TableLmsElearning: E‑learning -TableLmsResetPin: Reset E-learning password? -TableLmsDatePin: E-learning password created +TableLmsResetPin: Reset E‑learning password? +TableLmsDatePin: E‑learning password created TableLmsDelete: Delete? TableLmsStaff: Staff? TableLmsStarted: Started @@ -68,7 +70,7 @@ FilterLmsNotificationDue: Notification due CsvColumnLmsIdent: E#{nonBreakableDash}learning identifier, unique for each qualification and user CsvColumnLmsPin: Password e#{nonBreakableDash}learning access CsvColumnLmsResetPin: Will the e#{nonBreakableDash}learning password be reset upon next synchronisation? -CsvColumnLmsDelete: Will the identifier be deleted from the E-learning platfrom upon next synchronisation? +CsvColumnLmsDelete: Will the identifier be deleted from the E‑learning platfrom upon next synchronisation? CsvColumnLmsStaff: Is the user an internal staff member? (Legacy, currently ignored) CsvColumnLmsSuccess: Timestamp of successful completion (UTC) CsvColumnLmsFailed: Blockier durch LMS, üblicherweise wegen zu vieler Fehlversuche @@ -79,7 +81,7 @@ LmsResultUpdate: Update of LMS result LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key 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. MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid @@ -100,7 +102,8 @@ QualificationActGrantWarning: Use with caution in rare exceptional cases only! A QualificationStatusBlock l n m: #{n}/#{m} #{l} revoked QualificationStatusUnblock l n m: #{n}/#{m} #{l} reactivated LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with the FRADrive PDF-password of the examinee. If no PDF-password had been chosen yet, then the password is the Fraport id card number of the examinee, including the punctuation mark and the digit thereafter. -LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only. +LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through e‑learning only. +LmsRenewalReminder: Reminder LmsActNotify: Resend e‑learning notification by post or email LmsActRenewPin: Randomly replace e‑learning password LmsActRenewNotify: Randomly replace e‑learning password and re-send notification by post or email @@ -109,11 +112,11 @@ LmsActRestartWarning: The existing e-learning will be erased immediately! For dr LmsActRestartExtend: Ensure validity for the next # days LmsActRestartUnblock: Undo any revocations LmsActRestartFeedback n@Int m@Int: #{n}/#{m} e-learnings were restarted. -LmsStatusNotificationSent: E-learning password has been sent to examinee or supervisor by letter post or by email; e‑learning is currently open -LmsNotificationSend n: E-learning notifications will be sent to #{n} #{pluralENs n "examinee"} by letter post or by email. -LmsPinRenewal n: E-learning password replaced randomly for #{n} #{pluralENs n "examinee"}. +LmsStatusNotificationSent: E‑learning password has been sent to examinee or supervisor by letter post or by email; e‑learning is currently open +LmsNotificationSend n: E‑learning notifications will be sent to #{n} #{pluralENs n "examinee"} by letter post or by email. +LmsPinRenewal n: E‑learning password replaced randomly for #{n} #{pluralENs n "examinee"}. LmsActionFailed n: No action for #{n} #{pluralENs n "person"}, since there was no ongoing examination. -LmsStarted: E-learning open since +LmsStarted: E‑learning open since LmsAutomaticQueuing n@Natural: The following functions are executed daily at #{show n} o'clock. LmsManualQueuing: The following functions should be executed daily. BtnLmsEnqueue: Enqueue users with expiring qualifications for e‑learning and notify them. diff --git a/messages/uniworx/categories/settings/de-de-formal.msg b/messages/uniworx/categories/settings/de-de-formal.msg index 81e458b06..966a96328 100644 --- a/messages/uniworx/categories/settings/de-de-formal.msg +++ b/messages/uniworx/categories/settings/de-de-formal.msg @@ -83,7 +83,8 @@ NotificationTriggerCourseRegistered: Ein:e Kursverwalter:in hat mich zu einer Ku NotificationTriggerSubmissionUserCreated: Ich wurde als Mitabgebender zu einer Übungsblatt-Abgabe hinzugefügt NotificationTriggerSubmissionEdited: Eine meiner Übungsblatt-Abgaben wurde verändert NotificationTriggerSubmissionUserDeleted: Ich wurde als Mitabgebender von einer Übungsblatt-Abgabe entfernt -NotificationTriggerQualification: Eine meiner Qualifikationen läuft ab +NotificationTriggerQualificationExpiry: Eine meiner Qualifikationen läuft ab +NotificationTriggerQualificationReminder: Zweite Erinnerung bei Ablauf einer meiner Qualifikationen UserDisplayNameRules: Vorgaben für den angezeigten Namen diff --git a/messages/uniworx/categories/settings/en-eu.msg b/messages/uniworx/categories/settings/en-eu.msg index 9113c8e41..af8288459 100644 --- a/messages/uniworx/categories/settings/en-eu.msg +++ b/messages/uniworx/categories/settings/en-eu.msg @@ -83,7 +83,8 @@ NotificationTriggerCourseRegistered: A course administrator has enrolled me in a NotificationTriggerSubmissionUserCreated: I was added to an exercise sheet submission NotificationTriggerSubmissionEdited: One of my exercise sheet submissions was changed NotificationTriggerSubmissionUserDeleted: I was removed from one of my exercise sheet submissions -NotificationTriggerQualification: My Qualifications are about to expire +NotificationTriggerQualificationExpiry: My qualifications are about to expire +NotificationTriggerQualificationReminder: Send second reminder if one of my qualifications is about to expire UserDisplayNameRules: Specification for display names diff --git a/models/lms.model b/models/lms.model index 805bdc83c..f8233b4ef 100644 --- a/models/lms.model +++ b/models/lms.model @@ -11,6 +11,7 @@ Qualification validDuration Int Maybe -- > 0, qualification is valid indefinitely or for a specified number of months, use with addMonthsDay auditDuration Int Maybe -- > 0, number of months to keep audit log and LmsUserIdents; or indefinitely (dangerous, since LmsIdents may run out) 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 elearningStart Bool -- automatically schedule e-refresher -- elearningOnly Bool -- successful E-learing automatically increases validity. NO! expiryNotification Bool default=true -- should expiryNotification be generated for this qualification? diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs index 3d6fd5b4a..3fff50aab 100644 --- a/src/Handler/Admin/Test.hs +++ b/src/Handler/Admin/Test.hs @@ -335,6 +335,7 @@ getAdminTestPdfR = do , qualShort = qual ^. _qualificationShorthand . _CI , qualSchool = qual ^. _qualificationSchool , qualDuration = qual ^. _qualificationValidDuration + , isReminder = False } apcIdent <- letterApcIdent letter encRecipient now renderLetterPDF usr letter apcIdent >>= \case diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index fba615998..d10fbb51e 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -690,7 +690,7 @@ postLmsR sid qsh = do newPin <- liftIO randomLMSpw update lid [LmsUserPin =. newPin, LmsUserDatePin =. now, LmsUserResetPin =. True] when (isNotifyAct action) $ - queueDBJob $ JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid' } + queueDBJob $ JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid' False } return $ length okUsers let numSelected = length selectedUsers diffSelected = numSelected - numExaminees diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index f3b64d3be..90889c63d 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -40,26 +40,29 @@ single = uncurry Map.singleton data LRQF = LRQF - { lrqfLetter :: Text - , lrqfUser :: Either UserEmail UserId - , lrqfSuper :: Maybe (Either UserEmail UserId) - , lrqfQuali :: Entity Qualification - , lrqfIdent :: LmsIdent - , lrqfPin :: Text - , lrqfExpiry :: Maybe Day + { lrqfLetter :: Text + , lrqfUser :: Either UserEmail UserId + , lrqfSuper :: Maybe (Either UserEmail UserId) + , lrqfQuali :: Entity Qualification + , lrqfIdent :: LmsIdent + , lrqfPin :: Text + , lrqfExpiry :: Maybe Day + , lrqfReminder :: Bool } deriving (Eq, Generic) makeRenewalForm :: Maybe LRQF -> Form LRQF makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRenewQualificationF $ \html -> do -- now_day <- utctDay <$> liftIO getCurrentTime flip (renderAForm FormStandard) html $ LRQF - <$> areq textField (fslI MsgPrintLetterType) (lrqfLetter <$> tmpl) - <*> areq (userField False Nothing) (fslI MsgLmsUser) (lrqfUser <$> tmpl) - <*> aopt (userField False Nothing) (fslI MsgTableSupervisor) (lrqfSuper <$> tmpl) - <*> areq qualificationFieldEnt (fslI MsgQualificationName) (lrqfQuali <$> tmpl) - <*> areq lmsField (fslI MsgTableLmsIdent) (lrqfIdent <$> tmpl) - <*> areq textField (fslI MsgTableLmsPin) (lrqfPin <$> tmpl) - <*> aopt dayField (fslI MsgLmsQualificationValidUntil) (lrqfExpiry <$> tmpl) + <$> areq textField (fslI MsgPrintLetterType) (lrqfLetter <$> tmpl) + <*> areq (userField False Nothing) (fslI MsgLmsUser) (lrqfUser <$> tmpl) + <*> aopt (userField False Nothing) (fslI MsgTableSupervisor) (lrqfSuper <$> tmpl) + <*> areq qualificationFieldEnt (fslI MsgQualificationName) (lrqfQuali <$> tmpl) + <*> areq lmsField (fslI MsgTableLmsIdent) (lrqfIdent <$> tmpl) + <*> areq textField (fslI MsgTableLmsPin) (lrqfPin <$> tmpl) + <*> aopt dayField (fslI MsgLmsQualificationValidUntil) (lrqfExpiry <$> tmpl) + <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) + (fslI MsgLmsRenewalReminder) (lrqfReminder <$> tmpl) where lmsField = convertField LmsIdent getLmsIdent textField @@ -86,6 +89,7 @@ lrqf2letter LRQF{..} , qualShort = lrqfQuali ^. _qualificationShorthand . _CI , qualSchool = lrqfQuali ^. _qualificationSchool , qualDuration = lrqfQuali ^. _qualificationValidDuration + , isReminder = lrqfReminder } return (fromMaybe usr rcvr, SomeLetter letter) | lrqfLetter == "e" || lrqfLetter == "E" = do @@ -318,6 +322,7 @@ postPrintSendR = do , lrqfIdent = LmsIdent "stuvwxyz" , lrqfPin = "76543210" , lrqfExpiry = Just $ succ nowaday + , lrqfReminder = False } def_lrqf = mkLetter <$> mbQual diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 80ae420cd..a1e0d01ef 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -247,10 +247,11 @@ notificationForm template = wFormToAForm $ do NTExamOfficeExamResults -> Just $ NTKFunctionary SchoolExamOffice NTExamOfficeExamResultsChanged -> Just $ NTKFunctionary SchoolExamOffice NTCourseRegistered -> Just NTKAll - NTQualification -> Just NTKAll + NTQualificationExpiry -> Just NTKAll + NTQualificationReminder -> Just NTKAll -- _other -> Nothing - forcedTriggers = [NTUserRightsUpdate, NTUserAuthModeUpdate] + forcedTriggers = [NTUserRightsUpdate, NTUserAuthModeUpdate, NTQualificationExpiry] aFormToWForm $ NotificationSettings <$> sectionedFuncForm ntSection nsForm (fslI MsgNotificationSettings) False diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index 88b85239d..7d53bac9c 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -96,9 +96,10 @@ mkQualificationAllTable isAdmin = do maybeCell (qualificationDescription quali) markupCellLargeModal , sortable Nothing (i18nCell MsgQualificationValidDuration & cellTooltip MsgTableDiffDaysTooltip) $ foldMap (textCell . formatCalendarDiffDays . fromMonths) . view (resultAllQualification . _qualificationValidDuration) - , sortable Nothing (i18nCell MsgQualificationRefreshWithin & cellTooltip 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 Nothing (i18nCell MsgQualificationRefreshWithin & cellTooltip MsgQualificationRefreshWithinTooltip) $ + foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshWithin) + , sortable Nothing (i18nCell MsgQualificationRefreshReminder & cellTooltip MsgQualificationRefreshReminderTooltip) $ + foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder) , sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart) $ tickmarkCell . view (resultAllQualification . _qualificationElearningStart) , sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip) diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index 80f797c8f..210621981 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -273,11 +273,41 @@ dispatchJobLmsResults qid = JobHandlerAtomic act -- processes received input and block qualifications, if applicable dispatchJobLmsUserlist :: QualificationId -> JobHandler UniWorX -dispatchJobLmsUserlist qid = JobHandlerAtomic act +dispatchJobLmsUserlist qid = JobHandlerAtomic act where act :: YesodJobDB UniWorX () act = do - now <- liftIO getCurrentTime + now <- liftIO getCurrentTime + -- send reminders first -- TODO: move to dispatchJobLmsEnqueueUser + let sendReminders remindPeriod = do + let now_day = utctDay now + remindDate = addGregorianDurationClip remindPeriod now_day + reminders <- E.select $ do + (luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser + `E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification + E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser + ) + E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid + E.&&. quser E.^. QualificationUserScheduleRenewal + E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val now_day + E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val remindDate + E.&&. E.isNothing (quser E.^. QualificationUserBlockedDue) + E.&&. E.isNothing (luser E.^. LmsUserEnded) + E.&&. E.isNothing (luser E.^. LmsUserStatus) + E.&&. E.isJust (luser E.^. LmsUserNotified) + -- E.&&. ((day_ (luser E.^. LmsUserNotified) E.+. E.interval remindPeriod) E.<. quser E.^. QualificationUserValidUntil) -- not sure whether may throw runtime errors, so we check in Haskell-Land instead + return (luser, quser E.^. QualificationUserValidUntil) + forM_ reminders $ \case + (Entity _ (LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}), E.Value quValidUntil) + | addGregorianDurationClip remindPeriod (utctDay lnotified) < quValidUntil -> + queueDBJob JobSendNotification + { jRecipient = luser + , jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True } + } + _ -> return () + maybeM (return ()) sendReminders ((>>= view _qualificationRefreshReminder) <$> get qid) + -- now process actual results + -- result :: [(Entity LmsUser, Entity LmsUserlist)] results <- E.select $ do (luser :& lulist) <- E.from $ @@ -302,7 +332,7 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act when (isNothing $ lmsUserNotified luser) $ do -- notify users that lms is available queueDBJob JobSendNotification { jRecipient = lmsUserUser luser - , jNotification = NotificationQualificationRenewal { nQualification = qid } + , jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = False } } let isBlocked = lmsUserlistFailed lulist diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index db91f4640..230ca3ea2 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -201,6 +201,6 @@ classifyNotification NotificationCourseRegistered{} = return NTCou classifyNotification NotificationSubmissionEdited{} = return NTSubmissionEdited classifyNotification NotificationSubmissionUserCreated{} = return NTSubmissionUserCreated classifyNotification NotificationSubmissionUserDeleted{} = return NTSubmissionUserDeleted -classifyNotification NotificationQualificationExpiry{} = return NTQualification -classifyNotification NotificationQualificationExpired{} = return NTQualification -classifyNotification NotificationQualificationRenewal{} = return NTQualification +classifyNotification NotificationQualificationExpiry{} = return NTQualificationExpiry +classifyNotification NotificationQualificationExpired{} = return NTQualificationExpiry +classifyNotification NotificationQualificationRenewal{} = return NTQualificationReminder diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 2200b12c3..2cbc59d2a 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -84,8 +84,8 @@ dispatchNotificationQualificationExpired nQualification jRecipient = do -- NOTE: Renewal expects that LmsUser already exists for recipient -dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler () -dispatchNotificationQualificationRenewal nQualification jRecipient = do +dispatchNotificationQualificationRenewal :: QualificationId -> Bool -> UserId -> Handler () +dispatchNotificationQualificationRenewal nQualification nReminder jRecipient = do encRecipient :: CryptoUUIDUser <- encrypt jRecipient query <- runDB $ (,,,) <$> get jRecipient @@ -107,6 +107,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do , qualShort = CI.original qualificationShorthand , qualSchool = qualificationSchool , qualDuration = qualificationValidDuration + , isReminder = nReminder } $logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname notifyOk <- sendEmailOrLetter jRecipient letter diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 6457d6f8e..e75411160 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -151,9 +151,9 @@ data Notification | NotificationSubmissionEdited { nInitiator :: UserId, nSubmission :: SubmissionId } | NotificationSubmissionUserCreated { nUser :: UserId, nSubmission :: SubmissionId } | NotificationSubmissionUserDeleted { nUser :: UserId, nSheet :: SheetId, nSubmission :: SubmissionId } - | NotificationQualificationExpiry { nQualification :: QualificationId, nExpiry :: Day } -- NotificationTrigger: NTQualification TODO: separate - | NotificationQualificationExpired { nQualification :: QualificationId } -- NotificationTrigger: NTQualification - | NotificationQualificationRenewal { nQualification :: QualificationId } -- NotificationTrigger: NTQualification + | NotificationQualificationExpiry { nQualification :: QualificationId, nExpiry :: Day } -- NotificationTrigger: NTQualificationExpiry TODO: separate + | NotificationQualificationExpired { nQualification :: QualificationId } -- NotificationTrigger: NTQualificationExpiry + | NotificationQualificationRenewal { nQualification :: QualificationId, nReminder :: Bool } -- NotificationTrigger: NTQualificationReminder deriving (Eq, Ord, Show, Read, Generic) instance Hashable Job diff --git a/src/Model/Types/Mail.hs b/src/Model/Types/Mail.hs index cba46cefd..1b6223e10 100644 --- a/src/Model/Types/Mail.hs +++ b/src/Model/Types/Mail.hs @@ -60,7 +60,8 @@ data NotificationTrigger | NTExamOfficeExamResults | NTExamOfficeExamResultsChanged | NTCourseRegistered - | NTQualification + | NTQualificationExpiry + | NTQualificationReminder deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) deriving anyclass (Universe, Finite, Hashable, NFData) diff --git a/src/Utils/Print/RenewQualification.hs b/src/Utils/Print/RenewQualification.hs index 31a5a23dc..a9307d80d 100644 --- a/src/Utils/Print/RenewQualification.hs +++ b/src/Utils/Print/RenewQualification.hs @@ -31,6 +31,7 @@ data LetterRenewQualificationF = LetterRenewQualificationF , qualShort :: Text , qualSchool :: SchoolId , qualDuration :: Maybe Int + , isReminder :: Bool } deriving (Eq, Show) diff --git a/templates/qualification.hamlet b/templates/qualification.hamlet index 063d46f86..1459ebdfb 100644 --- a/templates/qualification.hamlet +++ b/templates/qualification.hamlet @@ -31,6 +31,18 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later $if drd > 0 _{MsgDays (fromIntegral drd)} + $maybe dremind <- qualificationRefreshReminder quali +
_{MsgQualificationRefreshReminder} ^{iconTooltip (msg2widget MsgQualificationRefreshReminderTooltip) Nothing True} +
+ $with drm <- cdMonths dremind + $with drd <- cdDays dremind + $if drm > 0 + _{MsgMonths (fromIntegral drm)} + $if drd > 0 + , # + $if drd > 0 + _{MsgDays (fromIntegral drd)} +
_{MsgQualificationElearningStart}
#{boolSymbol (qualificationElearningStart quali)} $if (qualificationElearningStart quali) && isNothing (qualificationRefreshWithin quali) diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 40c662257..dbcc97c35 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -695,9 +695,9 @@ fillDb = do let f_descr = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|] let r_descr = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|] let l_descr = Just $ htmlToStoredMarkup [shamlet|

für unhabilitierte|] - qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True True (Just AvsLicenceVorfeld) $ Just "F4466" - qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) False False (Just AvsLicenceRollfeld) $ Just "R2801" - qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True False Nothing Nothing + 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_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_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing True False Nothing Nothing void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) (Just $ QualificationBlocked (n_day $ -5) "LMS") True (n_day' $ -9) -- TODO: better dates! void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) Nothing True (n_day' $ -9) -- TODO: better dates! void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) Nothing True (n_day' $ -9) -- TODO: better dates!