chore(qualifications): show qualifications on user profile page and send expired notifications
This commit is contained in:
Steffen Jost
parent
24837ec8ae
commit
86b5f0f175
@ -13,6 +13,7 @@ LmsQualificationValidUntil: Gültig bis
|
||||
TableQualificationLastRefresh: Zuletzt erneuert
|
||||
TableQualificationFirstHeld: Erstmalig
|
||||
TableQualificationBlockedDue: Suspendiert
|
||||
TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und wer hat das veranlasst?
|
||||
LmsUser: Inhaber
|
||||
TableLmsEmail: E-Mail
|
||||
TableLmsIdent: Identifikation
|
||||
@ -49,8 +50,10 @@ LmsDirectUpload: Direkter Upload für automatisierte Systeme
|
||||
LmsErrorNoRefreshElearning: Fehler: E-Lernen wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
|
||||
MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
|
||||
MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
|
||||
MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig
|
||||
MailBodyQualificationRenewal: Sie müssen diese Qualifikaton demnächst durch einen E-Lernen Kurs erneuern.
|
||||
MailBodyQualificationExpiry: Diese Qualifikaton läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden!
|
||||
MailBodyQualificationExpired: Diese Qualifikaton is nun abgelaufen. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen ab sofort nicht länger ausgeübt werden! Es ist möglich, dass die Qualifikation vorzeit ungültig wurde, z.B. wegen erfolgloser Teilnahme an einem verpflichtendem E-Lernen.
|
||||
LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PDF-Passwort verschlüsselt. Falls kein PDF-Passwort hinterlegt wurde, ist das PDF-Passwort Ihre Fraport Ausweisnummer, inklusive Punkt und der Ziffer danach.
|
||||
LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Lernen verlängert werden.
|
||||
LmsActNotify: Benachrichtigung E-Lernen erneut per Post oder E-Mail versenden
|
||||
|
||||
@ -13,6 +13,7 @@ LmsQualificationValidUntil: Valid until
|
||||
TableQualificationLastRefresh: Last renewed
|
||||
TableQualificationFirstHeld: First held
|
||||
TableQualificationBlockedDue: Suspended
|
||||
TableQualificationBlockedTooltip: When was the qualification temporarily suspended and who requested this?
|
||||
LmsUser: Licensee
|
||||
TableLmsEmail: Email
|
||||
TableLmsIdent: Identifier
|
||||
@ -49,8 +50,10 @@ LmsDirectUpload: Direct upload for automated Systems
|
||||
LmsErrorNoRefreshElearning: Error: E-learning will not be started automatically due to refresh-within time period not being set.
|
||||
MailSubjectQualificationRenewal qname@Text: Qualification #{qname} must be renewed shortly
|
||||
MailSubjectQualificationExpiry qname@Text: Qualification #{qname} expires soon
|
||||
MailSubjectQualificationExpired qname@Text: Qualification #{qname} is no longer valid
|
||||
MailBodyQualificationRenewal: You will soon need to renew this qualficiation by completing an e-learning course.
|
||||
MailBodyQualificationExpiry: This qualificaton expires soon. You may then no longer execute any duties that require this qualification as a precondition!
|
||||
MailBodyQualificationExpired: This qualificaton is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e-learning.
|
||||
LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with your chosen FRADrive PDF-Password. If you have not yet chosen a PDF-Password yet, then the password is your Fraport id card number, inkluding the punctuation mark and the Digit thereafter.
|
||||
LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only.
|
||||
LmsActNotify: Resend e-learning notification by post or email
|
||||
|
||||
@ -14,6 +14,7 @@ ProfileTutorialParticipations: Tutorien
|
||||
ProfileSubmissionGroups: Abgabegruppen
|
||||
ProfileSubmissions: Abgaben
|
||||
ProfileRemark: Hinweis
|
||||
ProfileQualifications: Eigene Qualifikationen
|
||||
PersonalInfoExamAchievementsWip: Die Anzeige von Prüfungsergebnissen wird momentan an dieser Stelle leider noch nicht unterstützt.
|
||||
PersonalInfoOwnTutorialsWip: Die Anzeige von Tutorien, zu denen Sie als Tutor eingetragen sind wird momentan an dieser Stelle leider noch nicht unterstützt.
|
||||
PersonalInfoTutorialsWip: Die Anzeige von Tutorien, zu denen Sie angemeldet sind wird momentan an dieser Stelle leider noch nicht unterstützt.
|
||||
|
||||
@ -14,6 +14,7 @@ ProfileTutorialParticipations: Tutorials
|
||||
ProfileSubmissionGroups: Submission groups
|
||||
ProfileSubmissions: Submissions
|
||||
ProfileRemark: Remarks
|
||||
ProfileQualifications: Owned Qualifications
|
||||
PersonalInfoExamAchievementsWip: The feature to display your exam achievements has not yet been implemented.
|
||||
PersonalInfoOwnTutorialsWip: The feature to display tutorials you have been assigned to as tutor has not yet been implemented.
|
||||
PersonalInfoTutorialsWip: The feature to display tutorials you have registered for has not yet been implemented.
|
||||
|
||||
@ -115,7 +115,7 @@ LmsUserlist
|
||||
failed Bool
|
||||
timestamp UTCTime default=now()
|
||||
UniqueLmsUserlist qualification ident
|
||||
deriving Generic
|
||||
deriving Generic Show
|
||||
|
||||
-- LmsResult stores LMS upload for later processing only
|
||||
LmsResult
|
||||
|
||||
@ -252,7 +252,7 @@ makeFoundation appSettings''@AppSettings{..} = do
|
||||
|
||||
runAppLoggingT tempFoundation $ do
|
||||
$logInfoS "InstanceID" $ UUID.toText appInstanceID
|
||||
$logDebugS "Configuration" $ tshowCrop appSettings''
|
||||
$logInfoS "Configuration" $ tshowCrop appSettings''
|
||||
$logDebugS "RTSFlags" . tshow =<< liftIO getRTSFlags
|
||||
|
||||
smtpPool <- for appSmtpConf $ \c -> do
|
||||
|
||||
@ -352,10 +352,10 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink queryUser
|
||||
, single $ sortUserEmail queryUser
|
||||
, single ("blocked-due" , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
|
||||
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
|
||||
, single ("last-refresh", SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
|
||||
, single ("first-held" , SortColumn $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
|
||||
, single ("blocked-due" , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
|
||||
, single ("lms-ident" , SortColumn $ queryLmsUser >>> (E.?. LmsUserIdent))
|
||||
, single ("lms-status" , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
|
||||
, single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted))
|
||||
@ -477,7 +477,8 @@ postLmsR sid qsh = do
|
||||
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
|
||||
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
|
||||
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
|
||||
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> qualificationBlockedCell b
|
||||
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltip
|
||||
) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> qualificationBlockedCell b
|
||||
, sortable (Just "lms-ident") (i18nLms MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> foldMap textCell lid
|
||||
, sortable (Just "lms-status") (i18nLms MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
|
||||
, sortable (Just "lms-started") (i18nLms MsgTableLmsStarted) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d
|
||||
|
||||
@ -647,6 +647,7 @@ makeProfileData (Entity uid User{..}) = do
|
||||
submissionTable <- mkSubmissionTable uid -- Tabelle mit allen Abgaben und Abgabe-Gruppen
|
||||
submissionGroupTable <- mkSubmissionGroupTable uid -- Tabelle mit allen Abgabegruppen
|
||||
correctionsTable <- mkCorrectionsTable uid -- Tabelle mit allen Korrektor-Aufgaben
|
||||
qualificationsTable <- mkQualificationsTable uid -- Tabelle mit allen Qualifikationen
|
||||
let examTable, ownTutorialTable, tutorialTable :: Widget
|
||||
examTable = i18n MsgPersonalInfoExamAchievementsWip
|
||||
ownTutorialTable = i18n MsgPersonalInfoOwnTutorialsWip
|
||||
@ -978,6 +979,52 @@ mkCorrectionsTable =
|
||||
in dbTableWidget' validator DBTable{..}
|
||||
|
||||
|
||||
|
||||
-- | Table listing all qualifications that the given user is enrolled in
|
||||
mkQualificationsTable :: UserId -> DB Widget
|
||||
mkQualificationsTable =
|
||||
let withType :: ((E.SqlExpr (Entity Qualification) `E.InnerJoin` E.SqlExpr (Entity QualificationUser)) -> a)
|
||||
-> ((E.SqlExpr (Entity Qualification) `E.InnerJoin` E.SqlExpr (Entity QualificationUser)) -> a)
|
||||
withType = id
|
||||
|
||||
validator = def -- TODO & defaultSorting [SortDescBy "valid-until"]
|
||||
|
||||
in \uid -> dbTableWidget' validator
|
||||
DBTable
|
||||
{ dbtIdent = "userQualifications" :: Text
|
||||
, dbtSQLQuery = \(quali `E.InnerJoin` quser) -> do
|
||||
E.on $ quali E.^. QualificationId E.==. quser E.^. QualificationUserQualification
|
||||
E.where_ $ quser E.^. QualificationUserUser E.==. E.val uid
|
||||
return (quali, quser)
|
||||
, dbtRowKey = \(_quali `E.InnerJoin` quser) -> quser E.^. QualificationUserId
|
||||
, dbtProj = dbtProjId
|
||||
, dbtColonnade = mconcat
|
||||
[ colSchool (_dbrOutput . _1 . _entityVal . _qualificationSchool)
|
||||
, sortable (Just "quali") (i18nCell MsgQualificationName) $ qualificationCell <$> view (_dbrOutput . _1 . _entityVal)
|
||||
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltip
|
||||
) $ qualificationBlockedCell <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserBlockedDue )
|
||||
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ dayCell <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserValidUntil )
|
||||
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh) $ dayCell <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserLastRefresh)
|
||||
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ dayCell <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserFirstHeld )
|
||||
]
|
||||
, dbtSorting = mconcat
|
||||
[ sortSchool $ to (\(quali `E.InnerJoin` _) -> quali E.^. QualificationSchool)
|
||||
, singletonMap "quali" $ SortColumn $ withType $ \(quali `E.InnerJoin` _) -> quali E.^. QualificationName
|
||||
, singletonMap "blocked-due" $ SortColumn $ withType $ \(_ `E.InnerJoin` quser) -> quser E.^. QualificationUserBlockedDue
|
||||
, singletonMap "valid-until" $ SortColumn $ withType $ \(_ `E.InnerJoin` quser) -> quser E.^. QualificationUserValidUntil
|
||||
, singletonMap "last-refresh" $ SortColumn $ withType $ \(_ `E.InnerJoin` quser) -> quser E.^. QualificationUserLastRefresh
|
||||
, singletonMap "first-held" $ SortColumn $ withType $ \(_ `E.InnerJoin` quser) -> quser E.^. QualificationUserFirstHeld
|
||||
]
|
||||
, dbtFilter = mempty
|
||||
, dbtFilterUI = mempty
|
||||
, dbtStyle = def
|
||||
, dbtParams = def
|
||||
, dbtCsvEncode = noCsvEncode
|
||||
, dbtCsvDecode = Nothing
|
||||
, dbtExtraReps = []
|
||||
}
|
||||
|
||||
|
||||
getAuthPredsR, postAuthPredsR :: Handler Html
|
||||
getAuthPredsR = postAuthPredsR
|
||||
postAuthPredsR = do
|
||||
|
||||
@ -268,17 +268,13 @@ courseCell Course{..} = anchorCell link name `mappend` desc
|
||||
|]
|
||||
|
||||
qualificationCell :: IsDBTable m a => Qualification -> DBCell m a
|
||||
qualificationCell Qualification{..} = anchorCell link name `mappend` desc
|
||||
qualificationCell Qualification{..} = anchorCell link name <> desc
|
||||
where
|
||||
link = QualificationR qualificationSchool qualificationShorthand
|
||||
name = citext2widget qualificationName
|
||||
desc = case qualificationDescription of
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell [whamlet|
|
||||
$newline never
|
||||
<div>
|
||||
^{modal "Beschreibung" (Right $ toWidget descr)}
|
||||
|]
|
||||
(Just descr) -> spacerCell <> markupCellLargeModal descr
|
||||
|
||||
sheetCell :: IsDBTable m a => CourseLink -> SheetName -> DBCell m a
|
||||
sheetCell crse shn =
|
||||
@ -323,4 +319,4 @@ lmsStatusCell ls = iconCell ic <> spacerCell <> dayCell (lmsStatusDay ls)
|
||||
|
||||
qualificationBlockedCell :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
|
||||
qualificationBlockedCell Nothing = mempty
|
||||
qualificationBlockedCell (Just qb) = iconCell IconBlocked <> msgCell qb <> dayCell (qualificationBlockedDay qb)
|
||||
qualificationBlockedCell (Just qb) = msgCell qb <> spacerCell <> iconCell IconBlocked <> spacerCell <> dayCell (qualificationBlockedDay qb)
|
||||
|
||||
@ -368,7 +368,7 @@ determineCrontab = execWriterT $ do
|
||||
{ cronInitial = CronAsap -- time after scheduling
|
||||
, cronRepeat = CronRepeatScheduled $ cronCalendarAny { cronHour = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] )
|
||||
, cronMinute = cronMatchOne 3
|
||||
, cronSecond = cronMatchOne 2
|
||||
, cronSecond = cronMatchOne 27
|
||||
}
|
||||
, cronRateLimit = nominalDay / 2 -- minimal time between two executions, before the second job is skipped
|
||||
, cronNotAfter = Left nominalDay -- maximal delay of an execution, before it is skipped entirely
|
||||
@ -380,7 +380,7 @@ determineCrontab = execWriterT $ do
|
||||
{ cronInitial = CronAsap -- time after scheduling
|
||||
, cronRepeat = CronRepeatScheduled $ cronCalendarAny { cronHour = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] )
|
||||
, cronMinute = cronMatchOne 33
|
||||
, cronSecond = cronMatchOne 2
|
||||
, cronSecond = cronMatchOne 27
|
||||
}
|
||||
, cronRateLimit = nominalDay / 2 -- minimal time between two executions, before the second job is skipped
|
||||
, cronNotAfter = Left nominalDay -- maximal delay of an execution, before it is skipped entirely
|
||||
|
||||
@ -131,7 +131,14 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
let qshort = CI.original $ qualificationShorthand quali
|
||||
$logInfoS "lms" $ "Processing e-learning results for qualification " <> qshort
|
||||
now <- liftIO getCurrentTime
|
||||
-- purge LmsUsers
|
||||
-- TODO: notify expired used
|
||||
-- let nowaday = utctDay now
|
||||
-- forM_ (E.unValue . snd <$> delusersVals) $ \uid ->
|
||||
-- queueDBJob JobSendNotification
|
||||
-- { jRecipient = uid
|
||||
-- , jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = nowaday }
|
||||
-- }
|
||||
-- purge outdated LmsUsers
|
||||
case qualificationAuditDuration quali of
|
||||
Nothing -> return () -- no automatic removal
|
||||
(Just auditDuration) -> do
|
||||
@ -158,8 +165,6 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
deleteWhere [LmsResultQualification ==. qid, LmsResultIdent <-. delusers]
|
||||
deleteWhere [LmsAuditQualification ==. qid, LmsAuditIdent <-. delusers]
|
||||
|
||||
|
||||
|
||||
-- processes received results and lengthen qualifications, if applicable
|
||||
dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX
|
||||
dispatchJobLmsResults qid = JobHandlerAtomic act
|
||||
@ -243,15 +248,21 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
|
||||
{ jRecipient = lmsUserUser luser
|
||||
, jNotification = NotificationQualificationRenewal { nQualification = qid }
|
||||
}
|
||||
-- update luid [ LmsUserNotified =. Just now ] -- wird erst beim tatsächlichen senden gesetzt!
|
||||
let lReceived = lmsUserlistTimestamp lulist
|
||||
isBlocked = lmsUserlistFailed lulist
|
||||
update luid [LmsUserReceived =. Just lReceived]
|
||||
isBlocked = lmsUserlistFailed lulist
|
||||
update luid [LmsUserReceived =. Just lReceived] -- LmsUserNotfied is only updated upon sending notifications
|
||||
$logInfoS "LmsUserlist" $ tshow lulist
|
||||
when isBlocked $ do
|
||||
let newStatus = LmsBlocked $ utctDay lReceived
|
||||
oldStatus = lmsUserStatus luser
|
||||
let blockedDay = utctDay lReceived
|
||||
newStatus = LmsBlocked blockedDay
|
||||
oldStatus = lmsUserStatus luser
|
||||
insert_ $ LmsAudit qid (lmsUserIdent luser) newStatus (Just $ "Old Status was " <> tshow oldStatus) lReceived now
|
||||
update luid [LmsUserStatus =. (oldStatus <> Just newStatus)]
|
||||
updateBy (UniqueQualificationUser qid (lmsUserUser luser)) [QualificationUserBlockedDue =. Just (QualificationBlockedLms (utctDay lReceived))]
|
||||
updateBy (UniqueQualificationUser qid (lmsUserUser luser)) [QualificationUserBlockedDue =. Just (QualificationBlockedLms blockedDay)]
|
||||
queueDBJob JobSendNotification
|
||||
{ jRecipient = lmsUserUser luser
|
||||
, jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = blockedDay }
|
||||
}
|
||||
|
||||
delete lulid
|
||||
$logInfoS "LmsUserlist" [st|Processed LMS Userlist with ${tshow (length results)} entries|]
|
||||
|
||||
@ -301,6 +301,7 @@ determineNotificationCandidates = awaitForever $ \notif -> do
|
||||
|
||||
return (hasOverride, user)
|
||||
NotificationQualificationExpiry{} -> return mempty -- Not to be used with JobQueueNotification; recipients already known
|
||||
NotificationQualificationExpired{} -> return mempty -- Not to be used with JobQueueNotification; recipients already known
|
||||
NotificationQualificationRenewal{} -> return mempty -- Not to be used with JobQueueNotification; recipients already known
|
||||
|
||||
|
||||
@ -339,4 +340,5 @@ classifyNotification NotificationSubmissionUserCreated{} = return NTSub
|
||||
classifyNotification NotificationSubmissionUserDeleted{} = return NTSubmissionUserDeleted
|
||||
classifyNotification NotificationAllocationNewCourse{} = return NTAllocationNewCourse
|
||||
classifyNotification NotificationQualificationExpiry{} = return NTQualification
|
||||
classifyNotification NotificationQualificationExpired{} = return NTQualification
|
||||
classifyNotification NotificationQualificationRenewal{} = return NTQualification
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
|
||||
module Jobs.Handler.SendNotification.Qualification
|
||||
( dispatchNotificationQualificationExpiry
|
||||
, dispatchNotificationQualificationExpired
|
||||
, dispatchNotificationQualificationRenewal
|
||||
) where
|
||||
|
||||
@ -22,16 +23,15 @@ import Text.Hamlet
|
||||
|
||||
|
||||
dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Handler ()
|
||||
dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = userMailT jRecipient $ do
|
||||
(recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
|
||||
dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = userMailT jRecipient $ do
|
||||
(recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,)
|
||||
<$> getJust jRecipient
|
||||
<*> getJust nQualification
|
||||
<*> getJustBy (UniqueQualificationUser nQualification jRecipient)
|
||||
|
||||
encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient
|
||||
let entRecipient = Entity jRecipient recipient
|
||||
qname = CI.original qualificationName
|
||||
expiryDate <- formatTimeUser SelFormatDate qualificationUserValidUntil $ Just entRecipient
|
||||
expiryDate <- formatTimeUser SelFormatDate dExpiry $ Just entRecipient
|
||||
|
||||
$logDebugS "LMS" $ "Notify " <> tshow encRecipient <> " about expiry of qualification " <> qname
|
||||
|
||||
@ -43,6 +43,27 @@ dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = use
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet")
|
||||
|
||||
|
||||
dispatchNotificationQualificationExpired :: QualificationId -> Day -> UserId -> Handler ()
|
||||
dispatchNotificationQualificationExpired nQualification dExpired jRecipient = userMailT jRecipient $ do
|
||||
(recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,)
|
||||
<$> getJust jRecipient
|
||||
<*> getJust nQualification
|
||||
|
||||
encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient
|
||||
let entRecipient = Entity jRecipient recipient
|
||||
qname = CI.original qualificationName
|
||||
expiryDate <- formatTimeUser SelFormatDate dExpired $ Just entRecipient
|
||||
|
||||
$logDebugS "LMS" $ "Notify " <> tshow encRecipient <> " about expired qualification " <> qname
|
||||
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI $ MsgMailSubjectQualificationExpired qname
|
||||
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpired.hamlet")
|
||||
|
||||
|
||||
-- NOTE: qualificationRenewal expects that LmsUser already exists for recipient
|
||||
dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler ()
|
||||
dispatchNotificationQualificationRenewal nQualification jRecipient = do
|
||||
@ -129,4 +150,3 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
|
||||
emailRenewal Nothing
|
||||
|
||||
when notifyOk $ runDB $ update luid [ LmsUserNotified =. Just now]
|
||||
|
||||
@ -144,6 +144,7 @@ data Notification
|
||||
| NotificationSubmissionUserCreated { nUser :: UserId, nSubmission :: SubmissionId }
|
||||
| NotificationSubmissionUserDeleted { nUser :: UserId, nSheet :: SheetId, nSubmission :: SubmissionId }
|
||||
| NotificationQualificationExpiry { nQualification :: QualificationId, nExpiry :: Day }
|
||||
| NotificationQualificationExpired { nQualification :: QualificationId, nExpiry :: Day }
|
||||
| NotificationQualificationRenewal { nQualification :: QualificationId }
|
||||
deriving (Eq, Ord, Show, Read, Generic, Typeable)
|
||||
|
||||
|
||||
31
templates/mail/qualificationExpired.hamlet
Normal file
31
templates/mail/qualificationExpired.hamlet
Normal file
@ -0,0 +1,31 @@
|
||||
$newline never
|
||||
\<!doctype html>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<style>
|
||||
h1 {
|
||||
font-size: 1.25em;
|
||||
font-variant: small-caps;
|
||||
font-weight: normal;
|
||||
}
|
||||
<body>
|
||||
<h1>
|
||||
_{SomeMessage $ MsgMailSubjectQualificationExpired qname}
|
||||
|
||||
<p>
|
||||
_{SomeMessage MsgMailBodyQualificationExpired}
|
||||
|
||||
<p>
|
||||
<dl>
|
||||
<dt>_{SomeMessage MsgQualificationName}
|
||||
<dd>
|
||||
<a href=@{QualificationR qualificationSchool qualificationShorthand}>
|
||||
#{qualificationName}
|
||||
<dt>_{SomeMessage MsgLmsUser}
|
||||
<dd>#{nameHtml userDisplayName userSurname}
|
||||
<dt>_{SomeMessage MsgLmsQualificationValidUntil}
|
||||
<dd>#{expiryDate}
|
||||
|
||||
|
||||
^{ihamletSomeMessage editNotifications}
|
||||
@ -146,6 +146,11 @@ $newline never
|
||||
<div .container>
|
||||
^{enrolledCoursesTable}
|
||||
|
||||
<div .container>
|
||||
<h2>_{MsgProfileQualifications}
|
||||
<div .container>
|
||||
^{qualificationsTable}
|
||||
|
||||
<div .container>
|
||||
<h2>_{MsgProfileCourseExamResults}
|
||||
<div .container>
|
||||
@ -171,7 +176,7 @@ $newline never
|
||||
<div .container>
|
||||
^{submissionTable}
|
||||
<em>_{MsgProfileRemark}
|
||||
_{MsgProfileGroupSubmissionDates}
|
||||
\ _{MsgProfileGroupSubmissionDates}
|
||||
|
||||
<div .container>
|
||||
<h2> _{MsgTableCorrector}
|
||||
@ -179,7 +184,7 @@ $newline never
|
||||
^{correctionsTable}
|
||||
|
||||
<em>_{MsgProfileRemark}
|
||||
_{MsgProfileCorrectorRemark}
|
||||
\ _{MsgProfileCorrectorRemark}
|
||||
<a href=@{CorrectionsR}>_{MsgProfileCorrections}
|
||||
|
||||
^{profileRemarks}
|
||||
|
||||
@ -505,7 +505,9 @@ fillDb = do
|
||||
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 2 3) False
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True
|
||||
void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) Nothing -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) Nothing -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) (Just $ QualificationBlockedLms $ n_day $ -5)-- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) Nothing -- TODO: better dates!
|
||||
void . insert' $ QualificationUser gkleen qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20) Nothing
|
||||
void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8) Nothing
|
||||
void . insert' $ QualificationUser svaupel qid_f (n_day 1) (n_day $ -1) (n_day $ -2) Nothing
|
||||
|
||||
Reference in New Issue
Block a user