chore(qualifications): show qualifications on user profile page and send expired notifications

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -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

messages/uniworx/categories/qualification/en-eu.msg

@@ -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

messages/uniworx/categories/settings/personal_settings/de-de-formal.msg

@@ -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.

messages/uniworx/categories/settings/personal_settings/en-eu.msg

@@ -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.

models/lms.model

@@ -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

src/Application.hs

@@ -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

src/Handler/LMS.hs

@@ -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

src/Handler/Profile.hs

@@ -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

src/Handler/Utils/Table/Cells.hs

@@ -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|
+            (Just descr) -> spacerCell <> markupCellLargeModal descr
-              $newline never
-              <div>
-                ^{modal "Beschreibung" (Right $ toWidget 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)

src/Jobs/Crontab.hs

@@ -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

src/Jobs/Handler/LMS.hs

@@ -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
+              isBlocked = lmsUserlistFailed    lulist
-          update luid [LmsUserReceived =. Just lReceived]
+          update luid [LmsUserReceived =. Just lReceived] -- LmsUserNotfied is only updated upon sending notifications
+          $logInfoS "LmsUserlist" $ tshow lulist
           when isBlocked $ do
-            let newStatus = LmsBlocked $ utctDay lReceived
+            let blockedDay = utctDay lReceived
-                oldStatus = lmsUserStatus luser
+                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|]

src/Jobs/Handler/QueueNotification.hs

@@ -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

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -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
+dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = userMailT jRecipient $ do
-  (recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
+  (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]
-    

src/Jobs/Types.hs

@@ -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)
 

templates/mail/qualificationExpired.hamlet

@@ -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}

templates/profileData.hamlet

@@ -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}

test/Database/Fill.hs

@@ -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