Merge branch 'fradrive/letter-expiry'

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

@@ -21,4 +21,5 @@ PrintQualification: Qualifikation
 PrintPDF !ident-ok: PDF
 PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden
 PrintLmsUser: E‑Learning Id
-PrintJobs: Druckaufräge
+PrintJobs: Druckaufräge
+PrintLetterType: Brieftypkürzel

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

@@ -21,4 +21,5 @@ PrintQualification: Qualification
 PrintPDF: PDF
 PrintManualRenewal: Manual sending of an apron driver's licence renewal letter
 PrintLmsUser: E‑learning id
-PrintJobs: Print jobs
+PrintJobs: Print jobs
+PrintLetterType: Letter type shorthand

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

@@ -19,6 +19,7 @@ TableQualificationSapExport: SAP
 TableQualificationSapExportTooltip: Wird die Qualifikation an das SAP übermittelt? Betrifft nur Benutzer mit Fraport Personalnummer.
 LmsQualificationValidUntil: Gültig bis
 TableQualificationLastRefresh: Zuletzt erneuert
+TableQualificationLastNotified: Letzte Benachrichtigung
 TableQualificationFirstHeld: Erstmalig
 TableQualificationBlockedDue: Entzogen
 TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst?

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

@@ -19,6 +19,7 @@ TableQualificationSapExport: Sent to SAP
 TableQualificationSapExportTooltip: Is this qualification transmitted to SAP? Only applies to qualification holder having a Fraport AG personnel number.
 LmsQualificationValidUntil: Valid until
 TableQualificationLastRefresh: Last renewed
+TableQualificationLastNotified: Last notified
 TableQualificationFirstHeld: First held
 TableQualificationBlockedDue: Revoked
 TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended?

models/lms.model

@@ -62,6 +62,7 @@ QualificationUser
   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
+  lastNotified      UTCTime default=now()         -- last notficiation about being invalid
   -- temporärer Entzug vorsehen -- SAP Schnittstelle muss dann angepasst werden
   -- Begründungsfeld vorsehen
   UniqueQualificationUser qualification user

src/Handler/Admin/Test.hs

@@ -320,7 +320,7 @@ getAdminTestPdfR = do
         , qualDuration  = qual ^. _qualificationValidDuration
         }  
   apcIdent <- letterApcIdent letter encRecipient now
-  renderLetter usr letter apcIdent >>= \case
+  renderLetterPDF usr letter apcIdent >>= \case
     Left err  -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
     Right pdf -> do
       liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf

src/Handler/LMS/Fake.hs

@@ -131,6 +131,7 @@ fakeQualificationUsers (Entity qid Qualification{qualificationRefreshWithin}) (u
                   qualificationUserLastRefresh      = qualificationUserFirstHeld
                   qualificationUserBlockedDue       = Nothing
                   qualificationUserScheduleRenewal  = True
+                  qualificationUserLastNotified     = now
               _ <- upsert QualificationUser{..} 
                           [ QualificationUserValidUntil  =. qualificationUserValidUntil
                           , QualificationUserLastRefresh =. qualificationUserLastRefresh

src/Handler/PrintCenter.hs

@@ -46,20 +46,20 @@ data LRQF = LRQF
     , lrqfQuali   :: Entity Qualification 
     , lrqfIdent   :: LmsIdent
     , lrqfPin     :: Text
-    , lrqfExpiry  :: Day
+    , lrqfExpiry  :: Maybe Day
     } 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 MsgLmsUser)                      (lrqfLetter <$> 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)
-    <*> areq dayField                   (fslI MsgLmsQualificationValidUntil)   (lrqfExpiry <$> tmpl)
+    <*> aopt dayField                   (fslI MsgLmsQualificationValidUntil)   (lrqfExpiry <$> tmpl)
   where 
     lmsField = convertField LmsIdent getLmsIdent textField
 
@@ -73,13 +73,14 @@ lrqf2letter LRQF{..}
   | lrqfLetter == "r" = do 
     usr   <-      getUser lrqfUser
     rcvr  <- mapM getUser lrqfSuper
+    now   <- liftIO getCurrentTime
     let letter = LetterRenewQualificationF 
           { lmsLogin      = lrqfIdent
           , lmsPin        = lrqfPin
           , qualHolderID  = usr ^. _entityKey
           , qualHolderDN  = usr ^. _userDisplayName
           , qualHolderSN  = usr ^. _userSurname
-          , qualExpiry    = lrqfExpiry
+          , qualExpiry    = fromMaybe (utctDay now) lrqfExpiry
           , qualId        = lrqfQuali ^. _entityKey
           , qualName      = lrqfQuali ^. _qualificationName      . _CI
           , qualShort     = lrqfQuali ^. _qualificationShorthand . _CI
@@ -87,10 +88,11 @@ lrqf2letter LRQF{..}
           , qualDuration  = lrqfQuali ^. _qualificationValidDuration
           }
     return (fromMaybe usr rcvr, SomeLetter letter)
-  | lrqfLetter == "e" = do 
+  | lrqfLetter == "e" || lrqfLetter == "E" = do 
     rcvr    <- mapM getUser lrqfSuper
     usr     <-      getUser lrqfUser
     usrUuid <- encrypt $ entityKey usr
+    urender <- liftHandler getUrlRender
     let letter = LetterExpireQualificationF 
           { leqfHolderUUID  = usrUuid
           , leqfHolderID    = usr ^. _entityKey
@@ -101,6 +103,7 @@ lrqf2letter LRQF{..}
           , leqfName        = lrqfQuali ^. _qualificationName      . _CI
           , leqfShort       = lrqfQuali ^. _qualificationShorthand . _CI
           , leqfSchool      = lrqfQuali ^. _qualificationSchool          
+          , leqfUrl         = pure . urender $ ForProfileDataR usrUuid
           }
     return (fromMaybe usr rcvr, SomeLetter letter)
   | otherwise = error "Unknown Letter Type encountered. Use 'e' or 'r' only."
@@ -305,23 +308,31 @@ postPrintSendR = do
         , lrqfQuali     = qual
         , lrqfIdent     = LmsIdent  "stuvwxyz"
         , lrqfPin       =           "76543210"
-        , lrqfExpiry    = succ nowaday
+        , lrqfExpiry    = Just $ succ nowaday
         }
       def_lrqf = mkLetter <$> mbQual
 
   ((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
-  let procFormSend lrqf = do
+  let procFormSend lrqf = case lrqfLetter lrqf of 
-        ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case
+        "E" -> (runDB (lrqf2letter lrqf) >>= printHtml (Just uid)) >>= \case
-          Left err -> do
+            Right html -> sendResponse $ toTypedContent html
-            let msg = "PDF printing failed with error: " <> err
+            Left err -> do
-            $logErrorS "LPR" msg
+              let msg = "PDF printing failed with error: " <> err
-            addMessage Error $ toHtml msg
+              $logErrorS "LPR" msg
-            pure False
+              addMessage Error $ toHtml msg
-          Right (ok, fpath) -> do
+              pure ()
-            let response = if null ok then mempty else  " Response: " <> ok
+        _ -> do 
-            addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> pack fpath <> response
+            ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case
-            pure True
+              Left err -> do
-        when ok $ redirect PrintCenterR
+                let msg = "PDF printing failed with error: " <> err
+                $logErrorS "LPR" msg
+                addMessage Error $ toHtml msg
+                pure False
+              Right (ok, fpath) -> do
+                let response = if null ok then mempty else  " Response: " <> ok
+                addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> pack fpath <> response
+                pure True
+            when ok $ redirect PrintCenterR
   formResult sendResult procFormSend
   -- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
   siteLayoutMsg MsgPrintManualRenewal $ do

src/Handler/Qualification.hs

@@ -339,7 +339,8 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
       , single $ sortUserEmail      queryUser
       , single $ sortUserMatriclenr queryUser
       , single ("valid-until"   , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
-      , single ("last-refresh"  , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))      
+      , single ("last-refresh"  , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
+      , single ("last-notified" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastNotified))
       , single ("blocked-due"   , SortColumnNeverNull $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
       -- , single ("lms-started"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserStarted))
       -- , single ("lms-status"    , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
@@ -520,7 +521,8 @@ postQualificationR sid qsh = do
           --                                                                              $ \(preview $ resultLmsUser  . _entityVal . _lmsUserStarted  -> d) -> foldMap dateTimeCell d
           -- , sortable (Just "lms-status")    (i18nCell MsgTableLmsStatus)               $ \(preview $ resultLmsUser  . _entityVal . _lmsUserStatus -> status)  -> foldMap lmsStatusCell $ join status          
           , sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths))
-                                                                                       $ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusPlusCell linkLmsUser) lu                                                                                       
+                                                                                       $ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusPlusCell linkLmsUser) lu
+          , sortable (Just "last-notified") (i18nCell MsgTableQualificationLastNotified) $ \( view $ resultQualUser . _entityVal . _qualificationUserLastNotified -> d) -> dateTimeCell d
           ]
         psValidator = def & defaultSorting [SortDescBy "last-refresh"]
     tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator

src/Handler/Utils/Qualification.hs

@@ -14,7 +14,7 @@ import Database.Persist.Sql (updateWhereCount)
 import qualified Database.Esqueleto.Experimental as E   -- might need TypeApplications Lang-Pragma
 import qualified Database.Esqueleto.Utils as E
 
-
+import Handler.Utils.DateTime (toMidnight)
 
 ------------------
 -- SQL Snippets --
@@ -57,6 +57,7 @@ upsertQualificationUser  qualificationUserQualification qualificationUserLastRef
       { qualificationUserFirstHeld        = qualificationUserLastRefresh
       , qualificationUserBlockedDue       = Nothing
       , qualificationUserScheduleRenewal  = fromMaybe True mbScheduleRenewal
+      , qualificationUserLastNotified     = toMidnight qualificationUserLastRefresh
       , ..
       }
     (

src/Handler/Utils/Users.hs

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

src/Jobs/Handler/LMS.hs

@@ -145,7 +145,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
       -- end users that expired by doing nothing
       expiredLearners <- E.select $ do 
           (quser :& luser) <- E.from $
-            E.table @QualificationUser 
+            E.table @QualificationUser
             `E.innerJoin` E.table @LmsUser
             `E.on` (\(quser :& luser) ->
                               luser E.^. LmsUserUser           E.==. quser   E.^. QualificationUserUser
@@ -158,13 +158,23 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
         E.set luser [LmsUserStatus E.=. E.justVal (LmsExpired nowaday)]
         E.where_ $ (luser E.^. LmsUserId) `E.in_` E.valList (E.unValue <$> expiredLearners)
       $logInfoS "LMS" $ "Expired lms users " <> tshow nrExpired <> " for qualification " <> qshort
-      -- TODO: notify expired used 
+
-          -- 
+      notifyInvalidDrivers <- E.select $ do 
-          -- forM_ expiredLearners $ \uid ->
+          quser <- E.from $ E.table @QualificationUser 
-          --   queueDBJob JobSendNotification
+          E.where_ $ E.not_ (validQualification nowaday quser)              
-          --     { jRecipient    = uid
+            E.&&. ((  E.isNothing (quser E.^. QualificationUserBlockedDue)
-          --     , jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = nowaday }
+                    E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
-          --     }
+            ) E.||. (
+                      E.isJust    (quser E.^. QualificationUserBlockedDue)
+                    E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. ((quser E.^. QualificationUserBlockedDue) E.->. "day" :: E.SqlExpr (E.Value 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
@@ -306,10 +316,11 @@ dispatchJobLmsUserlist  qid = JobHandlerAtomic act
               }
             update luid [LmsUserStatus =. newStatus]
             void $ qualificationUserBlocking qid [lmsUserUser luser] $ Just $ mkQualificationBlocked QualificationBlockFailedELearning lmsMsgDay
-            queueDBJob JobSendNotification
+            -- DEACTIVATED FOR NOW; UPON REACTIVATION: DELAY Sending to check for unblocking a few hours later!
-              { jRecipient    = lmsUserUser luser
+            -- queueDBJob JobSendNotification
-              , jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = lmsMsgDay }
+            --   { jRecipient    = lmsUserUser luser
-              }
+            --   , jNotification = NotificationQualificationExpired { nQualification = qid }
+            --   }
 
           delete lulid
       $logInfoS "LmsUserlist" [st|Processed LMS Userlist with ${tshow (length results)} entries|]

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -42,25 +42,44 @@ dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = user
   addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet")
 
 
-dispatchNotificationQualificationExpired :: QualificationId -> Day -> UserId -> Handler ()
+dispatchNotificationQualificationExpired :: QualificationId -> UserId -> Handler ()
-dispatchNotificationQualificationExpired nQualification dExpired jRecipient = userMailT jRecipient $ do
+dispatchNotificationQualificationExpired nQualification jRecipient = do
-  (recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,)
+  encRecipient :: CryptoUUIDUser <- encrypt jRecipient
-    <$> getJust jRecipient
+  dbRes <- runDB $ (,,)
-    <*> getJust nQualification
+    <$> get jRecipient
+    <*> get nQualification
+    <*> getBy (UniqueQualificationUser nQualification jRecipient)
 
-  encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient
+  case dbRes of 
-  let entRecipient = Entity jRecipient recipient
+    ( Just User{..}, Just Qualification{..}, Just (Entity quId QualificationUser{..})) -> do
-      qname = CI.original qualificationName
+      urender <- getUrlRender
-  expiryDate <- formatTimeUser SelFormatDate dExpired $ Just entRecipient
+      let expDay  = maybe qualificationUserValidUntil (min qualificationUserValidUntil . qualificationBlockedDay) qualificationUserBlockedDue
-
+          qname   = CI.original qualificationName
-  $logDebugS "LMS" $ "Notify " <> tshow encRecipient <> " about expired qualification " <> qname
+          qshort  = CI.original qualificationShorthand
-
+          letter  = LetterExpireQualificationF 
-  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+            { leqfHolderUUID = encRecipient
-  setSubjectI $ MsgMailSubjectQualificationExpired qname
+            , leqfHolderID   = jRecipient
-
+            , leqfHolderDN   = userDisplayName
-  editNotifications <- mkEditNotifications jRecipient
+            , leqfHolderSN   = userSurname
-
+            , leqfExpiry     = Just expDay
-  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpired.hamlet")
+            , leqfId         = nQualification
+            , leqfName       = qname
+            , leqfShort      = qshort
+            , leqfSchool     = qualificationSchool
+            , leqfUrl        = pure . urender $ ForProfileDataR encRecipient
+            }
+      if expDay > utctDay qualificationUserLastNotified 
+        then do
+          notifyOk <- sendEmailOrLetter jRecipient letter
+          if notifyOk
+            then do 
+              now <- liftIO getCurrentTime
+              runDB $ update quId [QualificationUserLastNotified =. now]
+              $logInfoS  "LMS" $ "Notified " <> tshow encRecipient <> " about expired qualification " <> qname
+            else 
+              $logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> qname
+        else  $logErrorS "LMS" $ "Suppressed repeated notification " <> tshow encRecipient <> " about expired qualification " <> qname
+    _ ->  $logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> tshow nQualification
 
 
 -- NOTE: Renewal expects that LmsUser already exists for recipient
@@ -75,7 +94,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
   case query of 
     (Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do
       let qname = CI.original qualificationName
-      let letter = LetterRenewQualificationF
+          letter = LetterRenewQualificationF
             { lmsLogin     = lmsUserIdent
             , lmsPin       = lmsUserPin
             , qualHolderID = jRecipient

src/Jobs/Types.hs

@@ -142,7 +142,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 }
+  | NotificationQualificationExpired { nQualification :: QualificationId }
   | NotificationQualificationRenewal { nQualification :: QualificationId }
   deriving (Eq, Ord, Show, Read, Generic)
 

src/Model/Types/Avs.hs

@@ -138,7 +138,7 @@ instance {-# OVERLAPS #-} Canonical (Maybe AvsInternalPersonalNo) where
 -- where x is an 8 digit AvsCardNo prefixed by zeros, see normalizeAvsCardNo
 --   and y is the 1 digit AvsVersionNo
 type AvsVersionNo = Text -- always 1 digit 
-newtype AvsCardNo = AvsCardNo { avsCardNo :: Text }  -- always 8 digits
+newtype AvsCardNo = AvsCardNo { avsCardNo :: Text }  -- always 8 digits -- TODO: Create Smart Constructor
   deriving (Eq, Ord, Show, Generic)
   deriving newtype (NFData, PathPiece, Csv.ToField, Csv.FromField) 
 -- No longer needed:
@@ -162,7 +162,7 @@ data AvsFullCardNo = AvsFullCardNo { avsFullCardNo :: AvsCardNo, avsFullCardVers
   deriving (Eq, Ord, Generic, NFData)
 
 tshowAvsFullCardNo :: AvsFullCardNo -> Text
-tshowAvsFullCardNo AvsFullCardNo{..} = avsCardNo avsFullCardNo <> Text.cons '.' avsFullCardVersion
+tshowAvsFullCardNo AvsFullCardNo{..} = avsCardNo (canonical avsFullCardNo) <> Text.cons '.' avsFullCardVersion
 
 instance Show AvsFullCardNo where 
   show = Text.unpack . tshowAvsFullCardNo
@@ -170,7 +170,7 @@ instance Show AvsFullCardNo where
 readAvsFullCardNo :: Text -> Maybe AvsFullCardNo
 readAvsFullCardNo (Text.span Char.isDigit -> (c, Text.uncons -> Just ('.',v)))
   | not $ Text.null c, Just (Char.isDigit -> True, "") <- Text.uncons v
-    = Just $ AvsFullCardNo (AvsCardNo c) v
+    = Just $ AvsFullCardNo (AvsCardNo $ normalizeAvsCardNo c) v
 readAvsFullCardNo _ = Nothing
 
 instance PersistField AvsFullCardNo where

src/Utils/Print.hs

@@ -5,10 +5,11 @@
 {-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
 
 module Utils.Print
-  ( renderLetter        -- used for generating letter pdfs
+  ( renderLetterPDF        -- used for generating letter pdfs
   , renderLetters
   , sendEmailOrLetter   -- directly print or sends by email
   , printLetter         -- always send a letter
+  , printHtml           -- return letter as Html only
   , letterApcIdent      -- create acknowledge string for APC
   , letterFileName      -- default filename
   , encryptPDF
@@ -145,8 +146,8 @@ pdfLaTeX lk doc = do
       makePDF writerOpts $ appMeta setIsDeFromLang doc
       
 
-renderLetter :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
+renderLetterPDF :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
-renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
+renderLetterPDF rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
   now <- liftIO getCurrentTime  
   formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
   let lang = selectDeEn $ rcvr & userLanguages   -- select either German or English only, default de; see Utils.Lang
@@ -165,6 +166,30 @@ renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
   actRight e_md $ pdfLaTeX kind
 
 
+renderLetterHtml :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text Html)
+renderLetterHtml rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
+    now <- liftIO getCurrentTime  
+    formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
+    let lang = selectDeEn $ rcvr & userLanguages   -- select either German or English only, default de; see Utils.Lang
+        kind = getLetterKind        mdl
+        tmpl = getTemplate          mdl
+        meta = addApcIdent apcIdent
+            <> letterMeta mdl formatter lang rcvrEnt
+            <> mkMeta
+              [ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages
+                toMeta "date"       $ format SelFormatDate now
+              , toMeta "rcvr-name"  $ rcvr & userDisplayName
+              , toMeta "address"    $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
+              --, toMeta "rcvr-email"    $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise
+              ]
+    e_md <- mdTemplating tmpl meta
+    actRight e_md $ \md -> pure . over _Left P.renderError . P.runPure $ do   
+      html_tmpl <- compileTemplate $ templateHtml kind
+      -- html_tmpl <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("LetterKind-Html: \n" <> tshow lk) (pure . over _Left P.renderError . P.runPure $ compileTemplate $ templateHtml lk)
+      let writerOpts  = def { P.writerExtensions = P.pandocExtensions
+                            , P.writerTemplate   = Just html_tmpl }
+      P.writeHtml5 writerOpts $ appMeta setIsDeFromLang md
+
 -- TODO: apcIdent does not make sense for multiple letters 
 renderLetters :: (MDLetter l, Foldable f) => Entity User -> f l -> Text -> Handler (Either Text LBS.ByteString)
 renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent 
@@ -201,6 +226,15 @@ renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent
 -- PrintJobs --
 ---------------
 
+-- Only used in print-test-handler for PrintSendR
+printHtml ::  (MDLetter l) => Maybe UserId -> (Entity User, l) -> Handler (Either Text Html)
+printHtml _senderId (rcvr, letter) = do
+  let rcvrId = rcvr ^. _entityKey
+  encRecipient :: CryptoUUIDUser <- encrypt rcvrId
+  now <- liftIO getCurrentTime
+  apcIdent <- letterApcIdent letter encRecipient now
+  renderLetterHtml rcvr letter apcIdent
+  
 -- Only used in print-test-handler for PrintSendR
 printLetter :: (MDLetter l) => Maybe UserId -> (Entity User, l) -> Handler (Either Text (Text, FilePath))
 printLetter senderId (rcvr, letter) = do
@@ -208,7 +242,7 @@ printLetter senderId (rcvr, letter) = do
   encRecipient :: CryptoUUIDUser <- encrypt rcvrId
   now <- liftIO getCurrentTime
   apcIdent <- letterApcIdent letter encRecipient now
-  pdf <- renderLetter rcvr letter apcIdent
+  pdf <- renderLetterPDF rcvr letter apcIdent
   let protoPji = getPJId letter 
       pji = protoPji 
               { pjiRecipient = Just rcvrId
@@ -254,7 +288,7 @@ printLetter'' _ = do
 -}
 
 sendEmailOrLetter :: (MDLetter l, MDMail l) => UserId -> l -> Handler Bool
-sendEmailOrLetter recipient letter = do
+sendEmailOrLetter recipient letter = do  
   (underling, receivers, undercopy) <- updateReceivers recipient -- TODO: check to avoid this almost circular dependency
   now <- liftIO getCurrentTime
   let pjid  = getPJId letter
@@ -262,58 +296,85 @@ sendEmailOrLetter recipient letter = do
       mailSubject = getMailSubject letter       -- these are only needed if sent by email, but we're lazy anyway
       undername = underling ^. _userDisplayName -- nameHtml' underling
       undermail = CI.original $ underling ^. _userEmail
+  mr <- getMessageRender  
+  let mailSupervisorSubject = SomeMessage $ "[SUPERVISOR] " <> mr mailSubject
   oks <- forM receivers $ \rcvrEnt@Entity{ entityKey = svr, entityVal = rcvrUsr } -> do
     encRecipient :: CryptoUUIDUser <- encrypt svr
     apcIdent <- letterApcIdent letter encRecipient now
-    let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr        
+    case getPostalPreferenceAndAddress rcvrUsr of 
-    -- mailBody = getMailBody letter formatter
+      (True, Nothing) -> do -- neither email nor postal is known
-    renderLetter rcvrEnt letter apcIdent >>= \case
-      _ | preferPost, isNothing postal -> do -- neither email nor postal is known        
         let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid
         $logErrorS "LETTER" msg
         return False
-      Left err -> do -- pdf generation failed        
+
-        let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
+      (True , Just _postal) -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send printed letter
-        $logErrorS "LETTER" msg
+          Left err -> do -- pdf generation failed 
-        return False
+            let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
-      Right pdf | preferPost -> -- send printed letter
-        runDB (printLetter' pjid{pjiRecipient = Just svr, pjiApcAcknowledge = apcIdent} pdf) >>= \case
-          Left err -> do            
-            let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
             $logErrorS "LETTER" msg
-            return False
+            return False  
-          Right (msg,_)
+          Right pdf -> runDB (printLetter' pjid{pjiRecipient = Just svr, pjiApcAcknowledge = apcIdent} pdf) >>= \case
-            | null msg  -> return True
+            Left err -> do            
-            | otherwise -> do
+              let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
-                $logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
+              $logErrorS "LETTER" msg
-                return True
+              return False
-      Right pdf -> do -- send email
+            Right (msg,_)
-        let pdfPass = case encryptPDFfor letter of 
+              | null msg  -> return True
-              NoPassword          -> Nothing
+              | otherwise -> do
-              PasswordSupervisor  -> rcvrUsr   ^. _userPinPassword
+                  $logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
-              PasswordUnderling   -> underling ^. _userPinPassword
+                  return True
-        attachment <- case pdfPass of
+
-          Nothing     -> return pdf
+      (False, _) | attachPDFLetter letter -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send Email, with pdf attached 
-          Just passwd -> encryptPDF passwd pdf >>= \case
+          Left err -> do -- pdf generation failed 
-            Right encPdf -> return encPdf
+            let msg = "Notification failed for " <> tshow encRecipient <> ". PDF attachment generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
-            Left err -> do              
+            $logErrorS "LETTER" msg
-              let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
+            return False  
-              $logWarnS "LETTER" msg
+          Right pdf -> do -- pdf generated, send as email attachment now
-              return pdf
+            let pdfPass = case encryptPDFfor letter of 
-        formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
+                  NoPassword          -> Nothing
-        let isSupervised  = recipient /= svr
+                  PasswordSupervisor  -> rcvrUsr   ^. _userPinPassword
-            supername     = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
+                  PasswordUnderling   -> underling ^. _userPinPassword
-            mailBody      = getMailBody letter formatter
+            attachment <- case pdfPass of
-        userMailTdirect svr $ do
+              Nothing     -> return pdf
-          replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+              Just passwd -> encryptPDF passwd pdf >>= \case
-          setSubjectI mailSubject
+                Right encPdf -> return encPdf
-          editNotifications <- mkEditNotifications svr
+                Left err -> do              
-          addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
+                  let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
-          addPart (File { fileTitle     = fName
+                  $logWarnS "LETTER" msg
-                        , fileModified  = now
+                  return pdf
-                        , fileContent   = Just $ yield $ LBS.toStrict attachment
+            formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
-                        } :: PureFile)
+            let isSupervised  = recipient /= svr
-          return True
+                supername     = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
+            mailBody <- getMailBody letter formatter
+            userMailTdirect svr $ do
+              replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+              setSubjectI mailSubject
+              editNotifications <- mkEditNotifications svr
+              addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
+              addPart (File { fileTitle     = fName
+                            , fileModified  = now
+                            , fileContent   = Just $ yield $ LBS.toStrict attachment
+                            } :: PureFile)
+            return True
+
+      (False, _) -> renderLetterHtml rcvrEnt letter apcIdent >>= \case -- send Email, render letter directly to html
+          Left err -> do -- html generation failed 
+            let msg = "Notification failed for " <> tshow encRecipient <> ". HTML generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
+            $logErrorS "LETTER" msg
+            return False  
+          Right html -> do -- html generated, send directly now      
+            let isSupervised = recipient /= svr
+                -- subject = if isSupervised 
+                --              then "[SUPERVISOR] " <> mailSubject
+                --              else mailSubject
+                subject = if isSupervised 
+                             then mailSupervisorSubject
+                             else mailSubject
+            userMailTdirect svr $ do
+              replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+              setSubjectI subject
+              -- when isSupervised $ mapSubject ("[SUPERVISOR] " <>)
+              addHtmlMarkdownAlternatives html
+            return True        
   return $ or oks
 
 

src/Utils/Print/ExpireQualification.hs

@@ -24,19 +24,21 @@ data LetterExpireQualificationF = LetterExpireQualificationF
     , leqfHolderID  :: UserId
     , leqfHolderDN  :: UserDisplayName
     , leqfHolderSN  :: UserSurname
-    , leqfExpiry    :: Day
+    , leqfExpiry    :: Maybe Day
     , leqfId        :: QualificationId
     , leqfName      :: Text             
     , leqfShort     :: Text             
-    , leqfSchool    :: SchoolId         
+    , leqfSchool    :: SchoolId
+    , leqfUrl       :: Maybe Text   
     }
   deriving (Eq, Show)
 
 -- TODO: use markdown to generate the Letter
 instance MDMail LetterExpireQualificationF where 
+  attachPDFLetter _ = False
   getMailSubject    l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqfShort l  
-  getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } = 
+  getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } = return $
-    let expiryDate              = format SelFormatDate leqfExpiry
+    let expiryDate              = format SelFormatDate <$> leqfExpiry
         userDisplayName         = leqfHolderDN
         userSurname             = leqfHolderSN        
         qualificationName       = leqfName
@@ -46,6 +48,12 @@ instance MDMail LetterExpireQualificationF where
         ihamletSomeMessage _ _ _ = (mempty :: Html)  -- TODO: use markdown for letter
         editNotifications        = ()                -- TODO: use markdown for letter
     in $(ihamletFile "templates/mail/qualificationExpired.hamlet")
+    -- const $ const html
+  -- Html -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
+  -- foo _ _ html -> html
+     -- [shamlet|#Ansprache #{html}|] um Html umzuwandeln!
+     -- 
+
 
 instance MDLetter LetterExpireQualificationF where  
   encryptPDFfor     _ = NoPassword
@@ -63,7 +71,8 @@ instance MDLetter LetterExpireQualificationF where
       ] <>
       [ toMeta "lang"           lang
       , toMeta "licenceholder"  leqfHolderDN
-      , toMeta "expiry"         (format SelFormatDate leqfExpiry)
+      , mbMeta "expiry"         (format SelFormatDate <$> leqfExpiry)      
+      , mbMeta "licence-url"    leqfUrl
       ] 
 
   getPJId LetterExpireQualificationF{..} =

src/Utils/Print/Letters.hs

@@ -152,6 +152,9 @@ paperKind Plain     = "a4wht"   -- Ohne Logo
 paperKind Din5008   = "a4log"   -- Mit Logo
 paperKind PlainLogo = "a4log"
 
+templateHtml :: LetterKind -> Text
+-- templateHtml Din5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/generic_template.html")
+templateHtml _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/generic_template.html")
 
 
 ---------------
@@ -217,7 +220,7 @@ data EncryptPDFfor = NoPassword | PasswordSupervisor | PasswordUnderling
 
 class MDLetter l where
   letterMeta        :: l -> DateTimeFormatter -> Lang -> Entity User -> P.Meta -- formatter/lang for individual receiver, set Meta "lang" for individually translated letters
-  -- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetter for each receiver
+  -- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetterPDF for each receiver
   getPJId           :: l -> PrintJobIdentification
   getLetterEnvelope :: l -> Char
   getLetterKind     :: l -> LetterKind
@@ -249,4 +252,7 @@ getApcIdent _ = Nothing
 
 class MDMail l where -- 
   getMailSubject    :: l -> SomeMessage UniWorX                                                     -- only used if letter is sent by email as pdf attachment
-  getMailBody       :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)  -- only used if letter is sent by email as pdf attachment
+  getMailBody       :: (MonadHandler m) => l -> DateTimeFormatter -> m (HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))  -- only used if letter is sent by email as pdf attachment
+  -- | should the email also contain the letter as a PDF attachment?
+  attachPDFLetter   :: l -> Bool
+  attachPDFLetter = const True

src/Utils/Print/RenewQualification.hs

@@ -48,7 +48,7 @@ letterRenewalQualificationFData LetterRenewQualificationF{lmsLogin} = LetterRene
 
 instance MDMail LetterRenewQualificationF where 
   getMailSubject    l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l  
-  getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } = 
+  getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } = return $
     let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
     in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
 

templates/letter/fraport_f_expiry.md

@@ -4,7 +4,7 @@
 de-subject: 'Entzug "F" (Vorfeldführerschein)'
 en-subject: Revocation of apron driving license
 author: Fraport AG - Fahrerausbildung (AVN-AR)
-phone: +49 69 690-28467
+phone: +49 69 690-30306
 email: fahrerausbildung@fraport.de
 place: Frankfurt am Main
 return-address: 
@@ -22,7 +22,6 @@ hyperrefoptions: hidelinks
 
 ### Metadaten, welche automatisch ersetzt werden:
 date: 11.11.1111
-expiry: 00.00.0000
 lang: de-de
 is-de: true
 # Emfpänger
@@ -58,11 +57,20 @@ den Wissenstest im Rahmen des Recurrent Trainings Vorfeldführerschein nicht bes
 oder die Ablauffrist nicht eingehalten.  
 
 
-Die Qualifikation „Vorfeldführerschein“ ist somit nicht mehr gültig.  
+Die Qualifikation „Vorfeldführerschein“ ist somit 
+$if(expiry)$
+  seit $expiry$ 
+$endif$
+nicht mehr gültig.  
 
 
 $if(supervisor)$
-$licenceholder$ darf 
+$if(licence-url)$
+[$licenceholder$]($licence-url$) 
+$else$
+$licenceholder$ 
+$endif$
+darf 
 $else$
   Sie dürfen
 $endif$
@@ -80,7 +88,7 @@ Telefon
 
 Email
   
-  : $email$
+  : [$email$](mailto:$email$)
 
 $else$
 Hierfür wenden Sie sich bitte an Ihren Arbeitgeber.
@@ -98,11 +106,19 @@ did not pass the required knowledge test within the allotted time
 for the renewal of the apron driving licence.
 
 
-The qualification „Vorfeldführerschein“ (apron driving lincence) is therefore invalid now.
+The qualification „Vorfeldführerschein“ (apron driving lincence) is therefore invalid
-
+$if(expiry)$
+  since $expiry$.
+$else$
+  now.
+$endif$ 
 
 $if(supervisor)$
-  $licenceholder$
+$if(licence-url)$
+[$licenceholder$]($licence-url$) 
+$else$
+$licenceholder$ 
+$endif$  
 $else$
   You
 $endif$
@@ -121,7 +137,7 @@ Phone
 
 Email
   
-  : $email$
+  : [$email$](mailto:$email$)
 
 $else$
 Please contact your employer to book a course for you.

templates/letter/generic_template.html

@@ -0,0 +1,262 @@
+<!DOCTYPE html>
+<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"$lang$\" xml:lang=\"$lang$\"$if(dir)$ dir=\"$dir$\"$endif$>
+
+<head>
+  <meta charset=\"utf-8\" />
+  <meta name=\"generator\" content=\"pandoc\" />
+  <meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0, user-scalable=yes\" /> 
+  $for(author-meta)$ <meta name=\"author\" content=\"$author-meta$\" /> $endfor$ 
+  $if(date-meta)$ <meta name=\"dcterms.date\" content=\"$date-meta$\" /> $endif$ 
+  $if(keywords)$ <meta name=\"keywords\" content=\"$for(keywords)$$keywords$$sep$, $endfor$\" /> 
+  $endif$ 
+  <title>$if(title-prefix)$$title-prefix$ \8211 $endif$$pagetitle$</title>
+  <style>
+    $if(document-css)$
+html {
+$if(mainfont)$
+  font-family: $mainfont$;
+$endif$
+$if(fontsize)$
+  font-size: $fontsize$;
+$endif$
+$if(linestretch)$
+  line-height: $linestretch$;
+$endif$
+  color: $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$;
+  background-color: $if(backgroundcolor)$$backgroundcolor$$else$#fdfdfd$endif$;
+}
+body {
+  margin: 0 auto;
+  max-width: $if(maxwidth)$$maxwidth$$else$36em$endif$;
+  padding-left: $if(margin-left)$$margin-left$$else$50px$endif$;
+  padding-right: $if(margin-right)$$margin-right$$else$50px$endif$;
+  padding-top: $if(margin-top)$$margin-top$$else$50px$endif$;
+  padding-bottom: $if(margin-bottom)$$margin-bottom$$else$50px$endif$;
+  hyphens: auto;
+  overflow-wrap: break-word;
+  text-rendering: optimizeLegibility;
+  font-kerning: normal;
+}
+@media (max-width: 600px) {
+  body {
+    font-size: 0.9em;
+    padding: 12px;
+  }
+  h1 {
+    font-size: 1.8em;
+  }
+}
+@media print {
+  html {
+    background-color: $if(backgroundcolor)$$backgroundcolor$$else$white$endif$;
+  }
+  body {
+    background-color: transparent;
+    color: black;
+    font-size: 12pt;
+  }
+  p, h2, h3 {
+    orphans: 3;
+    widows: 3;
+  }
+  h2, h3, h4 {
+    page-break-after: avoid;
+  }
+}
+p {
+  margin: 1em 0;
+}
+a {
+  color: $if(linkcolor)$$linkcolor$$else$#1a1a1a$endif$;
+}
+a:visited {
+  color: $if(linkcolor)$$linkcolor$$else$#1a1a1a$endif$;
+}
+img {
+  max-width: 100%;
+}
+h1, h2, h3, h4, h5, h6 {
+  margin-top: 1.4em;
+}
+h5, h6 {
+  font-size: 1em;
+  font-style: italic;
+}
+h6 {
+  font-weight: normal;
+}
+ol, ul {
+  padding-left: 1.7em;
+  margin-top: 1em;
+}
+li > ol, li > ul {
+  margin-top: 0;
+}
+blockquote {
+  margin: 1em 0 1em 1.7em;
+  padding-left: 1em;
+  border-left: 2px solid #e6e6e6;
+  color: #606060;
+}
+$if(abstract)$
+div.abstract {
+  margin: 2em 2em 2em 2em;
+  text-align: left;
+  font-size: 85%;
+}
+div.abstract-title {
+  font-weight: bold;
+  text-align: center;
+  padding: 0;
+  margin-bottom: 0.5em;
+}
+$endif$
+code {
+  font-family: $if(monofont)$$monofont$$else$Menlo, Monaco, Consolas, 'Lucida Console', monospace$endif$;
+$if(monobackgroundcolor)$
+  background-color: $monobackgroundcolor$;
+  padding: .2em .4em;
+$endif$
+  font-size: 85%;
+  margin: 0;
+  hyphens: manual;
+}
+pre {
+  margin: 1em 0;
+$if(monobackgroundcolor)$
+  background-color: $monobackgroundcolor$;
+  padding: 1em;
+$endif$
+  overflow: auto;
+}
+pre code {
+  padding: 0;
+  overflow: visible;
+  overflow-wrap: normal;
+}
+.sourceCode {
+ background-color: transparent;
+ overflow: visible;
+}
+hr {
+  background-color: #1a1a1a;
+  border: none;
+  height: 1px;
+  margin: 1em 0;
+}
+table {
+  margin: 1em 0;
+  border-collapse: collapse;
+  width: 100%;
+  overflow-x: auto;
+  display: block;
+  font-variant-numeric: lining-nums tabular-nums;
+}
+table caption {
+  margin-bottom: 0.75em;
+}
+tbody {
+  margin-top: 0.5em;
+  border-top: 1px solid $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$;
+  border-bottom: 1px solid $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$;
+}
+th {
+  border-top: 1px solid $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$;
+  padding: 0.25em 0.5em 0.25em 0.5em;
+}
+td {
+  padding: 0.125em 0.5em 0.25em 0.5em;
+}
+header {
+  margin-bottom: 4em;
+  text-align: center;
+}
+#TOC li {
+  list-style: none;
+}
+#TOC ul {
+  padding-left: 1.3em;
+}
+#TOC > ul {
+  padding-left: 0;
+}
+#TOC a:not(:hover) {
+  text-decoration: none;
+}
+$endif$
+code{white-space: pre-wrap;}
+span.smallcaps{font-variant: small-caps;}
+div.columns{display: flex; gap: min(4vw, 1.5em);}
+div.column{flex: auto; overflow-x: auto;}
+div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;}
+/* The extra [class] is a hack that increases specificity enough to
+   override a similar rule in reveal.js */
+ul.task-list[class]{list-style: none;}
+ul.task-list li input[type="checkbox"] {
+  font-size: inherit;
+  width: 0.8em;
+  margin: 0 0.8em 0.2em -1.6em;
+  vertical-align: middle;
+}
+$if(quotes)$
+q { quotes: "“" "”" "‘" "’"; }
+$endif$
+$if(displaymath-css)$
+.display.math{display: block; text-align: center; margin: 0.5rem auto;}
+$endif$
+$if(highlighting-css)$
+/* CSS for syntax highlighting */
+$highlighting-css$
+$endif$
+$if(csl-css)$
+/* CSS for citations */
+div.csl-bib-body { }
+div.csl-entry {
+  clear: both;
+$if(csl-entry-spacing)$
+  margin-bottom: $csl-entry-spacing$;
+$endif$
+}
+.hanging-indent div.csl-entry {
+  margin-left:2em;
+  text-indent:-2em;
+}
+div.csl-left-margin {
+  min-width:2em;
+  float:left;
+}
+div.csl-right-inline {
+  margin-left:2em;
+  padding-left:1em;
+}
+div.csl-indent {
+  margin-left: 2em;
+}
+$endif$
+  </style> 
+  $for(css)$ <link rel=\"stylesheet\" href=\"$css$\" /> $endfor$ 
+  $if(math)$ $math$ $endif$
+  <!--[if lt IE 9]>     <script src=\"//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js\"></script>   <![endif]-->
+  $for(header-includes)$ $header-includes$ $endfor$
+</head>
+
+<body> 
+  $for(include-before)$ $include-before$ $endfor$ 
+  $if(title)$ <header id=\"title-block-header\">
+    <h1 class=\"title\">$title$</h1> $if(subtitle)$ <p class=\"subtitle\">$subtitle$</p> $endif$ $for(author)$ <p
+      class=\"author\">$author$</p> $endfor$ $if(date)$ <p class=\"date\">$date$</p> $endif$
+    </header>
+  $endif$ 
+  $if(toc)$ <nav id=\"$idprefix$TOC\" role=\"doc-toc\"> 
+    $if(toc-title)$ <h2 id=\"$idprefix$toc-title\"> $toc-title$</h2> $endif$ 
+    $table-of-contents$ </nav>
+  $endif$ 
+  
+  $if(is-de)$ $de-opening$ $else$ $en-opening$ $endif$
+  $body$ 
+  $if(is-de)$ $de-closing$ $else$ $en-closing$ $endif$
+  
+  $for(include-after)$ $include-after$ $endfor$ 
+</body>
+
+</html>

templates/mail/qualificationExpired.hamlet

@@ -29,8 +29,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
             #{qualificationName}
         <dt>_{SomeMessage MsgLmsUser}
         <dd>#{nameHtml userDisplayName userSurname}
-        <dt>_{SomeMessage MsgQualificationExpired}
+        $maybe expDate <- expiryDate
-        <dd>#{expiryDate}
+          <dt>_{SomeMessage MsgQualificationExpired}
+          <dd>#{expDate}
 
 
     ^{ihamletSomeMessage editNotifications}

test/Database/Fill.hs

@@ -691,23 +691,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 $ QualificationBlocked (n_day $ -5) "LMS") True -- TODO: better dates!
+  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 -- 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 -- 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!
-  void . insert' $ QualificationUser gkleen     qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20) Nothing True
+  void . insert' $ QualificationUser gkleen     qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20) Nothing True (n_day' $ -9)
-  void . insert' $ QualificationUser maxMuster  qid_f (n_day    0) (n_day $ -2) (n_day $  -8) Nothing False
+  void . insert' $ QualificationUser maxMuster  qid_f (n_day    0) (n_day $ -2) (n_day $  -8) Nothing False (n_day' $ -1)
-  void . insert' $ QualificationUser svaupel    qid_f (n_day    1) (n_day $ -1) (n_day $  -2) Nothing True
+  void . insert' $ QualificationUser svaupel    qid_f (n_day    1) (n_day $ -1) (n_day $  -2) Nothing True (n_day' $ -9)
-  void . insert' $ QualificationUser sbarth     qid_f (n_day  400) (n_day $ -40) (n_day $ -1200) Nothing True
+  void . insert' $ QualificationUser sbarth     qid_f (n_day  400) (n_day $ -40) (n_day $ -1200) Nothing True (n_day' $ -2)
-  void . insert' $ QualificationUser tinaTester qid_f (n_day    3) (n_day $ -60) (n_day $ -250)  (Just $ QualificationBlocked (n_day $ -7) "Some long explanation for the block!") False
+  void . insert' $ QualificationUser tinaTester qid_f (n_day    3) (n_day $ -60) (n_day $ -250)  (Just $ QualificationBlocked (n_day $ -7) "Some long explanation for the block!") False (n_day' $ -9)
-  void . insert' $ QualificationUser tinaTester qid_r (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 False (n_day' $ -3)
-  void . insert' $ QualificationUser gkleen     qid_r (n_day $ -7) (n_day $ -2) (n_day $  -9) Nothing True
+  void . insert' $ QualificationUser gkleen     qid_r (n_day $ -7) (n_day $ -2) (n_day $  -9) Nothing True (n_day' $ -4)
-  void . insert' $ QualificationUser maxMuster  qid_r (n_day    1) (n_day $ -1) (n_day $  -2) Nothing False
+  void . insert' $ QualificationUser maxMuster  qid_r (n_day    1) (n_day $ -1) (n_day $  -2) Nothing False (n_day' $ -6)
-  -- void . insert' $ QualificationUser fhamann    qid_r (n_day $ -3) (n_day $ -1) (n_day $  -2) Nothing True
+  -- void . insert' $ QualificationUser fhamann    qid_r (n_day $ -3) (n_day $ -1) (n_day $  -2) Nothing True (n_day' $ -9)
-  void . insert' $ QualificationUser svaupel    qid_l (n_day    1) (n_day $ -1) (n_day $  -2) Nothing True
+  void . insert' $ QualificationUser svaupel    qid_l (n_day    1) (n_day $ -1) (n_day $  -2) Nothing True (n_day' $ -7)
-  void . insert' $ QualificationUser gkleen     qid_l (n_day    9) (n_day $ -1) (n_day $  -7) Nothing True
+  void . insert' $ QualificationUser gkleen     qid_l (n_day    9) (n_day $ -1) (n_day $  -7) Nothing True (n_day' $ -8)
   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]
+  insertMany_ [QualificationUser uid qid_f (n_day 42) (n_day $ -42) (n_day $ -365) Nothing True (n_day' $ -11)| 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