chore(lms): introduce flag for cancelled qualifications that will no longer be renewed

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

@@ -22,6 +22,8 @@ TableQualificationLastRefresh: Zuletzt erneuert
 TableQualificationFirstHeld: Erstmalig
 TableQualificationBlockedDue: Suspendiert
 TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und wer hat das veranlasst?
+TableQualificationNoRenewal: Storniert
+TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versand, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein.
 LmsUser: Inhaber
 TableLmsEmail: E-Mail
 TableLmsIdent: LMS Identifikation
@@ -59,9 +61,9 @@ LmsErrorNoRefreshElearning: Fehler: E-Learning wird nicht automatisch gestartet,
 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 qname@Text: Sie müssen Qualifikaton #{qname} demnächst durch einen E-Learning Kurs erneuern, siehe Anhang.
+MailBodyQualificationRenewal qname@Text: Sie müssen Qualifikation #{qname} demnächst durch einen E-Learning Kurs erneuern, siehe Anhang.
-MailBodyQualificationExpiry: Diese Qualifikaton läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden!
+MailBodyQualificationExpiry: Diese Qualifikation 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-Learning.
+MailBodyQualificationExpired: Diese Qualifikation 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-Learning.
 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-Learning verlängert werden.
 LmsActNotify: Benachrichtigung E-Learning erneut per Post oder E-Mail versenden

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

@@ -22,6 +22,8 @@ TableQualificationLastRefresh: Last renewed
 TableQualificationFirstHeld: First held
 TableQualificationBlockedDue: Suspended
 TableQualificationBlockedTooltip: When was the qualification temporarily suspended and who requested this?
+TableQualificationNoRenewal: Canceled
+TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid.
 LmsUser: Licensee
 TableLmsEmail: Email
 TableLmsIdent: LMS Identifier
@@ -59,9 +61,9 @@ LmsErrorNoRefreshElearning: Error: E-learning will not be started automatically
 MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly
 MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon
 MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid
-MailBodyQualificationRenewal qname: You will soon need to renew qualficiation #{qname} by completing an e-learning course. For details see attachment.
+MailBodyQualificationRenewal qname: You will soon need to renew qualification #{qname} by completing an e-learning course. For details see attachment.
-MailBodyQualificationExpiry: This qualificaton expires soon. You may then no longer execute any duties that require this qualification as a precondition!
+MailBodyQualificationExpiry: This qualification 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.
+MailBodyQualificationExpired: This qualification 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

models/lms.model

@@ -61,6 +61,7 @@ QualificationUser
   lastRefresh       Day                           -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
   firstHeld         Day                           -- first time the qualification was earned, should never change
   blockedDue        QualificationBlocked Maybe    -- isJust means that the qualification is currently revoked
+  scheduleRenewal   Bool  default=true            -- if false, no automatic renewal is scheduled and the qualification expires
   -- temporärer Entzug vorsehen -- SAP Schnittstelle muss dann angepasst werden
   -- Begründungsfeld vorsehen
   UniqueQualificationUser qualification user

src/Handler/LMS.hs

@@ -396,17 +396,19 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
     dbtSorting = mconcat
       [ single $ sortUserNameLink queryUser
       , single $ sortUserEmail    queryUser      
-      , single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
+      , single ("valid-until"   , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
-      , single ("last-refresh", SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
+      , single ("last-refresh"  , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
-      , single ("first-held"  , SortColumn $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
+      , single ("first-held"    , SortColumn $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
-      , single ("blocked-due" , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
+      , single ("blocked-due"   , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
-      , single ("lms-ident"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserIdent))
+      , single ("schedule-renew", SortColumn $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))      
-      , single ("lms-status"  , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
+      , single ("lms-ident"     , SortColumn $ queryLmsUser  >>> (E.?. LmsUserIdent))
-      , single ("lms-started" , SortColumn $ queryLmsUser  >>> (E.?. LmsUserStarted))
+      , single ("lms-status"    , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
-      , single ("lms-datepin" , SortColumn $ queryLmsUser  >>> (E.?. LmsUserDatePin))
+      , single ("lms-started"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserStarted))
-      , single ("lms-received", SortColumn $ queryLmsUser  >>> (E.?. LmsUserReceived))
+      , single ("lms-datepin"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserDatePin))
-      , single ("lms-notified", SortColumn $ queryLmsUser  >>> (E.?. LmsUserNotified)) -- cannot include printJob acknowledge date
+      , single ("lms-received"  , SortColumn $ queryLmsUser  >>> (E.?. LmsUserReceived))
-      , single ("lms-ended"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserEnded))
+      , single ("lms-notified"  , SortColumn $ queryLmsUser  >>> (E.?. LmsUserNotified)) -- cannot include printJob acknowledge date
+      , single ("lms-ended"     , SortColumn $ queryLmsUser  >>> (E.?. LmsUserEnded))
+      
       ]
     dbtFilter = mconcat
       [ single ("may-access"  , FilterProjected $ (_ltProjFilterMayAccess  ?~) . getAny)
@@ -511,7 +513,9 @@ postLmsR sid qsh = do
           , 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 & cellTooltip MsgTableQualificationBlockedTooltip
-                                                                                     ) $ \(   view $ resultQualUser . _entityVal . _qualificationUserBlockedDue  -> b)  -> qualificationBlockedCell b
+                                                                                    )  $ \(   view $ resultQualUser . _entityVal . _qualificationUserBlockedDue  -> b)  -> qualificationBlockedCell b
+          , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal  & cellTooltip MsgTableQualificationNoRenewalTooltip
+                                                                                    )  $ \(   view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
           , 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/LMS/Fake.hs

@@ -122,12 +122,13 @@ fakeQualificationUsers (Entity qid Qualification{qualificationRefreshWithin}) (u
               -> return 0
           | otherwise -> do 
               let uid = either entityKey id euid
-                  qualificationUserUser          = uid
+                  qualificationUserUser             = uid
-                  qualificationUserQualification = qid
+                  qualificationUserQualification    = qid
-                  qualificationUserValidUntil    = addDays expOffset expiryNotifyDay
+                  qualificationUserValidUntil       = addDays expOffset expiryNotifyDay
-                  qualificationUserFirstHeld     = addGregorianMonthsClip (-24) qualificationUserValidUntil
+                  qualificationUserFirstHeld        = addGregorianMonthsClip (-24) qualificationUserValidUntil
-                  qualificationUserLastRefresh   = qualificationUserFirstHeld
+                  qualificationUserLastRefresh      = qualificationUserFirstHeld
-                  qualificationUserBlockedDue    = Nothing
+                  qualificationUserBlockedDue       = Nothing
+                  qualificationUserScheduleRenewal  = True
               _ <- upsert QualificationUser{..} 
                           [ QualificationUserValidUntil  =. qualificationUserValidUntil
                           , QualificationUserLastRefresh =. qualificationUserLastRefresh

src/Handler/Utils/Qualification.hs

@@ -15,9 +15,10 @@ upsertQualificationUser :: QualificationId -> Day -> Day -> UserId -> DB ()
 upsertQualificationUser  qualificationUserQualification today qualificationUserValidUntil qualificationUserUser = do   
   Entity quid _ <- upsert
     QualificationUser
-      { qualificationUserLastRefresh =  today
+      { qualificationUserLastRefresh      = today
-      , qualificationUserFirstHeld   =  today
+      , qualificationUserFirstHeld        = today
-      , qualificationUserBlockedDue  =  Nothing
+      , qualificationUserBlockedDue       = Nothing
+      , qualificationUserScheduleRenewal  = True
       , ..
       }
     [ QualificationUserValidUntil    =. qualificationUserValidUntil

src/Handler/Utils/Users.hs

@@ -801,12 +801,14 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
           E.<&> (qualificationUser E.^. QualificationUserLastRefresh)
           E.<&> (qualificationUser E.^. QualificationUserFirstHeld)
           E.<&> (qualificationUser E.^. QualificationUserBlockedDue)
+          E.<&> (qualificationUser E.^. QualificationUserScheduleRenewal)
     )
     (\current excluded ->
-      [ QualificationUserValidUntil  E.=. combineWith current excluded E.greatest QualificationUserValidUntil
+      [ QualificationUserValidUntil       E.=. combineWith current excluded E.greatest QualificationUserValidUntil
-      , QualificationUserLastRefresh E.=. combineWith current excluded E.greatest QualificationUserLastRefresh
+      , QualificationUserLastRefresh      E.=. combineWith current excluded E.greatest QualificationUserLastRefresh
-      , QualificationUserFirstHeld   E.=. combineWith current excluded E.least    QualificationUserFirstHeld
+      , QualificationUserFirstHeld        E.=. combineWith current excluded E.least    QualificationUserFirstHeld
-      , QualificationUserBlockedDue  E.=. combineWith current excluded E.greatest QualificationUserBlockedDue  -- Tested: PostgreSQL GREATEST/LEAST ignores NULL values
+      , QualificationUserBlockedDue       E.=. combineWith current excluded E.greatest QualificationUserBlockedDue  -- Tested: PostgreSQL GREATEST/LEAST ignores NULL values
+      , QualificationUserScheduleRenewal  E.=. combineWith current excluded E.greatest QualificationUserScheduleRenewal
       ]
     )
   deleteWhere [ QualificationUserUser ==. oldUserId ]

src/Jobs/Handler/LMS.hs

@@ -67,6 +67,7 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
           renewalUsers <- E.select $ do
             quser <- E.from $ E.table @QualificationUser
             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 renewalDate
                   E.&&. E.notExists (do

src/Utils/Icon.hs

@@ -176,7 +176,7 @@ iconText = \case
     IconStandaloneFieldError    -> "exclamation"
     IconFileUser                -> "file-user"
     IconNotification            -> "envelope"
-    IconNoNotification          -> "times"
+    IconNoNotification          -> "bell-slash"
     IconPersonalIdentification  -> "id-card"
     IconMenuWorkflows           -> "project-diagram"
     IconVideo                   -> "video"

test/Database/Fill.hs

@@ -519,20 +519,23 @@ fillDb = do
   qid_f  <- insert' $ Qualification avn "F" "Vorfeldführerschein"  f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True  (Just AvsLicenceVorfeld)  $ Just "F4466"
   qid_r  <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3)  False (Just AvsLicenceRollfeld) $ Just "R2801"
   qid_l  <- insert' $ Qualification ifi "L" "Lehrbefähigung"       l_descr Nothing   (Just 6) Nothing True Nothing Nothing
-  void . insert' $ QualificationUser jost       qid_f (n_day    9) (n_day $   -1) (n_day $   -22) (Just $ QualificationBlockedLms $ n_day $ -5) -- TODO: better dates!
+  void . insert' $ QualificationUser jost       qid_f (n_day    9) (n_day $   -1) (n_day $   -22) (Just $ QualificationBlockedLms $ n_day $ -5) True -- TODO: better dates!
-  void . insert' $ QualificationUser jost       qid_r (n_day   99) (n_day $  -11) (n_day $  -222) Nothing -- TODO: better dates!
+  void . insert' $ QualificationUser jost       qid_r (n_day   99) (n_day $  -11) (n_day $  -222) Nothing True -- 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 jost       qid_l (n_day  999) (n_day $ -111) (n_day $ -2222) Nothing True -- TODO: better dates!
-  void . insert' $ QualificationUser gkleen     qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20) Nothing
+  void . insert' $ QualificationUser gkleen     qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20) Nothing True
-  void . insert' $ QualificationUser maxMuster  qid_f (n_day    0) (n_day $ -2) (n_day $  -8) Nothing
+  void . insert' $ QualificationUser maxMuster  qid_f (n_day    0) (n_day $ -2) (n_day $  -8) Nothing False
-  void . insert' $ QualificationUser svaupel    qid_f (n_day    1) (n_day $ -1) (n_day $  -2) Nothing
+  void . insert' $ QualificationUser svaupel    qid_f (n_day    1) (n_day $ -1) (n_day $  -2) Nothing True
-  void . insert' $ QualificationUser sbarth     qid_f (n_day  400) (n_day $ -40) (n_day $ -1200) Nothing
+  void . insert' $ QualificationUser sbarth     qid_f (n_day  400) (n_day $ -40) (n_day $ -1200) Nothing True
-  void . insert' $ QualificationUser tinaTester qid_f (n_day    3) (n_day $ -60) (n_day $ -250)  Nothing
+  void . insert' $ QualificationUser tinaTester qid_f (n_day    3) (n_day $ -60) (n_day $ -250)  Nothing False
-  void . insert' $ QualificationUser tinaTester qid_r (n_day    3) (n_day $ -60) (n_day $ -250)  Nothing
+  void . insert' $ QualificationUser tinaTester qid_r (n_day    3) (n_day $ -60) (n_day $ -250)  Nothing False
-  void . insert' $ QualificationUser gkleen     qid_r (n_day $ -7) (n_day $ -2) (n_day $  -9) Nothing
+  void . insert' $ QualificationUser gkleen     qid_r (n_day $ -7) (n_day $ -2) (n_day $  -9) Nothing True
-  void . insert' $ QualificationUser maxMuster  qid_r (n_day    1) (n_day $ -1) (n_day $  -2) Nothing
+  void . insert' $ QualificationUser maxMuster  qid_r (n_day    1) (n_day $ -1) (n_day $  -2) Nothing False
-  -- void . insert' $ QualificationUser fhamann    qid_r (n_day $ -3) (n_day $ -1) (n_day $  -2) Nothing
+  -- void . insert' $ QualificationUser fhamann    qid_r (n_day $ -3) (n_day $ -1) (n_day $  -2) Nothing True
-  void . insert' $ QualificationUser svaupel    qid_l (n_day    1) (n_day $ -1) (n_day $  -2) Nothing
+  void . insert' $ QualificationUser svaupel    qid_l (n_day    1) (n_day $ -1) (n_day $  -2) Nothing True
-  void . insert' $ QualificationUser gkleen     qid_l (n_day    9) (n_day $ -1) (n_day $  -7) Nothing
+  void . insert' $ QualificationUser gkleen     qid_l (n_day    9) (n_day $ -1) (n_day $  -7) Nothing True
+  qidfUsers <- Set.fromAscList . fmap (qualificationUserUser . entityVal)
+               <$> selectList [QualificationUserQualification ==. qid_f] [Asc QualificationUserUser]
+  insertMany_ [QualificationUser uid qid_f (n_day 42) (n_day $ -42) (n_day $ -365) Nothing True | Entity uid _ <- take 200 matUsers, uid `Set.notMember` qidfUsers]
   void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (n_day (-1)) now
   void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (n_day (-2)) now
   void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (n_day (-3)) now