chore(qualification): add expiry option and diversify expiry letter

2023-06-02 15:20:57 +02:00 · 2023-06-02 15:20:57 +02:00 · b72ee99e3e
commit b72ee99e3e
parent b982e59b63
8 changed files with 182 additions and 26 deletions
--- a/messages/uniworx/categories/qualification/de-de-formal.msg
+++ b/messages/uniworx/categories/qualification/de-de-formal.msg
@ -11,6 +11,8 @@ QualificationAuditDuration: Aufbewahrung Audit Log
 QualificationRefreshWithin: Erneurerungszeitraum
 QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E‑Learning
 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.
 TableQualificationCountActive: Aktive
 TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation
 TableQualificationCountTotal: Gesamt
--- a/messages/uniworx/categories/qualification/en-eu.msg
+++ b/messages/uniworx/categories/qualification/en-eu.msg
@ -11,6 +11,8 @@ QualificationAuditDuration: Audit log keept
 QualificationRefreshWithin: Refresh within
 QualificationRefreshWithinTooltip: Period before expiry to send a notification or to start e‑learning
 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.
 TableQualificationCountActive: Active
 TableQualificationCountActiveTooltip: Number of currently valid qualification holders
 TableQualificationCountTotal: Total
--- a/models/lms.model
+++ b/models/lms.model
@ -12,9 +12,8 @@ Qualification
  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
  elearningStart      Bool                      -- automatically schedule e-refresher
-  -- elearningOnly       Bool                   -- successful E-learing automatically increases validity. NO!
-  -- refreshInvitation   StoredMarkup           -- hard-coded I18N-MSGs used instead, but displayed on qualification page NO!
-  -- expiryNotification  StoredMarkup Maybe     -- configurable user-profile-notifcations are used instead NO!
+  -- elearningOnly       Bool                   -- successful E-learing automatically increases validity. NO!  
+  expiryNotification  Bool default=true         -- should expiryNotification be generated for this qualification?
  avsLicence          AvsLicence Maybe          -- if set, valid QualificationUsers are synchronized to AVS as a driving licence
  sapId               Text Maybe                -- if set, valid QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id
  SchoolQualificationShort school shorthand            -- must be unique per school and shorthand
--- a/src/Handler/Qualification.hs
+++ b/src/Handler/Qualification.hs
@ -101,6 +101,8 @@ mkQualificationAllTable isAdmin = do
          -- , sortable Nothing (i18nCell MsgQualificationRefreshWithin)   $ foldMap textCell . view (resultAllQualification . _qualificationRefreshWithin . to formatCalendarDiffDays) -- does not work, since there is a maybe in between
          , sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart) 
                                                                        $ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
+          , sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip) 
+                                                                        $ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification)
          , sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip) 
                  $ \(view (resultAllQualification . _qualificationAvsLicence) -> licence) -> maybeCell licence $ textCell . T.singleton . licence2char
          , sortable Nothing (i18nCell MsgTableQualificationSapExport & cellTooltip MsgTableQualificationSapExportTooltip)  
@ -115,6 +117,7 @@ mkQualificationAllTable isAdmin = do
          , singletonMap "qshort"       $ SortColumn (E.^. QualificationShorthand)
          , singletonMap "qname"        $ SortColumn (E.^. QualificationName)
          , singletonMap "qelearning"   $ SortColumn (E.^. QualificationElearningStart)
+          , singletonMap "noteexpiry"   $ SortColumn (E.^. QualificationExpiryNotification)
          ]
        dbtFilter = mconcat
          [
--- a/src/Jobs/Handler/LMS.hs
+++ b/src/Jobs/Handler/LMS.hs
@ -162,23 +162,24 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
             E.&&.  luser E.^. LmsUserQualification E.==. E.val qid
      $logInfoS "LMS" $ "Expired lms users " <> tshow nrExpired <> " for qualification " <> qshort

-      notifyInvalidDrivers <- E.select $ do 
-          quser <- E.from $ E.table @QualificationUser 
-          E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
-            E.&&.  E.not_ (validQualification nowaday quser)              
-            E.&&. (( E.isNothing (quser E.^. QualificationUserBlockedDue)
-                    E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
-            ) E.||. (
-                     E.isJust    (quser E.^. QualificationUserBlockedDue)
-                    E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day"))
-            ))
-          pure (quser E.^. QualificationUserUser)      
-      
-      forM_ notifyInvalidDrivers $ \(E.Value uid) ->
-        queueDBJob JobSendNotification
-          { jRecipient    = uid
-          , jNotification = NotificationQualificationExpired { nQualification = qid }
-          }
+      when (quali ^. _qualificationExpiryNotification) $ do
+        notifyInvalidDrivers <- E.select $ do 
+            quser <- E.from $ E.table @QualificationUser 
+            E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
+              E.&&.  E.not_ (validQualification nowaday quser)              
+              E.&&. (( E.isNothing (quser E.^. QualificationUserBlockedDue)
+                      E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
+              ) E.||. (
+                      E.isJust    (quser E.^. QualificationUserBlockedDue)
+                      E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day"))
+              ))
+            pure (quser E.^. QualificationUserUser)      
+        
+        forM_ notifyInvalidDrivers $ \(E.Value uid) ->
+          queueDBJob JobSendNotification
+            { jRecipient    = uid
+            , jNotification = NotificationQualificationExpired { nQualification = qid }
+            }

      -- purge outdated LmsUsers
      case qualificationAuditDuration quali of
--- a/src/Utils/Print/ExpireQualification.hs
+++ b/src/Utils/Print/ExpireQualification.hs
@ -33,11 +33,11 @@ data LetterExpireQualificationF = LetterExpireQualificationF
    }
  deriving (Eq, Show)

-- TODO: use markdown to generate the Letter
+-- TODO: use markdown to generate the Letter -- this is no linger used, I believe
 instance MDMail LetterExpireQualificationF where 
  attachPDFLetter _ = False
  getMailSubject    l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqfShort l  
-  getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } = return $
+  getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } = return $  -- TODO: can we use render Letter here?
    let expiryDate              = format SelFormatDate <$> leqfExpiry
        userDisplayName         = leqfHolderDN
        userSurname             = leqfHolderSN        
@ -59,7 +59,11 @@ instance MDLetter LetterExpireQualificationF where
  encryptPDFfor     _ = NoPassword
  getLetterKind     _ = Din5008
  getLetterEnvelope _ = 'e'
-  getTemplate       _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")
+
+  getTemplate LetterExpireQualificationF{leqfShort="F"} 
+                = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")
+  getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_generic_expiry.md")
+  

  letterMeta LetterExpireQualificationF{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = 
    let isSupervised = rcvrId /= leqfHolderID
@ -68,11 +72,17 @@ instance MDLetter LetterExpireQualificationF where
      [ toMeta "supervisor" userDisplayName      
      ] <>
      [ toMeta "lang"           lang
+      , toMeta "licencename"    leqfName
+      , toMeta "licenceshort"   leqfShort
      , toMeta "licenceholder"  leqfHolderDN
      , mbMeta "expiry"         (format SelFormatDate <$> leqfExpiry)      
      , mbMeta "licence-url"    leqfUrl
      , toMeta "de-opening" $ bool ("Guten Tag " <> leqfHolderDN <> ",") "Sehr geehrte Damen und Herren," isSupervised
      , toMeta "en-opening" $ bool ("Dear "      <> leqfHolderDN <> ",") "Dear supervisor,"               isSupervised
+      , toMeta "de-subject" $ "Entzug \"" <> leqfShort <> "\" (" <> leqfName <> ")"
+      , toMeta "en-subject" $ case leqfShort of
+                                "F" -> "Revocation of apron driving license"
+                                _   -> "Revocation of licence \"" <> leqfShort <> "\" (" <> leqfName <> ")"
      ] 

  getPJId LetterExpireQualificationF{..} =
--- a/templates/letter/fraport_generic_expiry.md
+++ b/templates/letter/fraport_generic_expiry.md
@ -0,0 +1,139 @@
+---
+### Metadaten, welche hier eingestellt werden:
+# Absender
+de-subject: Qualifikationsentzug
+en-subject: Qualification revocation
+author: Fraport AG - Fahrerausbildung (AVN-AR)
+phone: +49 69 690-30306
+email: fahrerausbildung@fraport.de
+place: Frankfurt am Main
+return-address: 
+ - 60547 Frankfurt
+de-opening: Liebe Fahrberechtigungsinhaber,
+en-opening: Dear driver,
+de-closing: |
+  Mit freundlichen Grüßen,  
+    Ihre Fraport Fahrerausbildung
+en-closing: |
+  With kind regards,  
+    Your Fraport Driver Training
+encludes:
+hyperrefoptions: hidelinks
+
+### Metadaten, welche automatisch ersetzt werden:
+date: 11.11.1111
+lang: de-de
+is-de: true
+# Emfpänger
+licenceholder: P. Rüfling
+address:
+ - E. M. Pfänger
+ - Musterfirma GmbH
+ - Musterstraße 11
+ - 12345 Musterstadt
+...
+$if(titleblock)$
+$titleblock$
+
+$endif$
+$for(header-includes)$
+$header-includes$
+        
+$endfor$
+$for(include-before)$
+$include-before$
+
+$endfor$
+
+$if(is-de)$
+
+<!-- deutsche Version des Briefes  -->
+leider ist die Fahrlizenz $licencename$
+$if(supervisor)$
+  für **$licenceholder$**
+$else$
+  Ihre
+$endif$
+ungültig geworden, z.B. weil die Ablauffrist erreicht wurde.
+
+
+Die Qualifikation „$licencename$“ ist somit 
+$if(expiry)$
+  seit $expiry$ 
+$endif$
+nicht mehr gültig.  
+
+
+$if(supervisor)$
+$if(licence-url)$
+[$licenceholder$]($licence-url$) 
+$else$
+$licenceholder$ 
+$endif$
+darf 
+$else$
+  Sie dürfen 
+$endif$
+ab sofort diese Qualifikation nicht mehr am Frankfurter Flughafens nutzen.
+
+Wenden Sie sich zur Wiedererlangung der Qualifikation bitte
+$if(supervisor)$
+an die Fahrerausbildung der Fraport AG unter:
+
+Telefon
+  
+  : [$phone$](tel:$phone$)
+
+Email
+  
+  : [$email$](mailto:$email$)
+
+$else$
+an Ihren Arbeitgeber.
+$endif$
+
+$else$ 
+<!-- englische Version des Briefes  -->
+we regret to inform you that the driving licence $licencename$ has expired for
+$if(supervisor)$
+  **$licenceholder$**.
+$else$
+  you.
+$endif$
+
+The qualification „$licencename$“ is therefore invalid
+$if(expiry)$
+  since $expiry$.
+$else$
+  now.
+$endif$ 
+
+$if(supervisor)$
+$if(licence-url)$
+[$licenceholder$]($licence-url$) 
+$else$
+$licenceholder$ 
+$endif$
+$else$
+  You
+$endif$
+may no use this qualification at Frankfurt airport, effective immediately.
+
+
+Please contact
+$if(supervisor)$
+the Fraport driving school team, if you want to book a course to regain this licence:
+
+Phone
+  
+  : [$phone$](tel:$phone$)
+
+Email
+  
+  : [$email$](mailto:$email$)
+
+$else$
+your employer to book a course for you in order to regain this licence.
+$endif$
+
+$endif$
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@ -695,9 +695,9 @@ fillDb = do
  let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
  let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
  let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
-  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
+  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
  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!