chore(letter): expiry letter phone and expiry date fixes

src/Handler/Admin/Test.hs

@@ -319,7 +319,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/PrintCenter.hs

@@ -46,7 +46,7 @@ data LRQF = LRQF
     , lrqfQuali   :: Entity Qualification 
     , lrqfIdent   :: LmsIdent
     , lrqfPin     :: Text
-    , lrqfExpiry  :: Day
+    , lrqfExpiry  :: Maybe Day
     } deriving (Eq, Generic)
 
 makeRenewalForm :: Maybe LRQF -> Form LRQF
@@ -59,7 +59,7 @@ makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRe
     <*> 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
@@ -305,7 +306,7 @@ postPrintSendR = do
         , lrqfQuali     = qual
         , lrqfIdent     = LmsIdent  "stuvwxyz"
         , lrqfPin       =           "76543210"
-        , lrqfExpiry    = succ nowaday
+        , lrqfExpiry    = Just $ succ nowaday
         }
       def_lrqf = mkLetter <$> mbQual
 

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -51,7 +51,7 @@ dispatchNotificationQualificationExpired nQualification dExpired jRecipient = us
   encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient
   let entRecipient = Entity jRecipient recipient
       qname = CI.original qualificationName
-  expiryDate <- formatTimeUser SelFormatDate dExpired $ Just entRecipient
+  expiryDate <- fmap Just $ formatTimeUser SelFormatDate dExpired $ Just entRecipient
 
   $logDebugS "LMS" $ "Notify " <> tshow encRecipient <> " about expired qualification " <> qname
 

src/Utils/Print.hs

@@ -5,7 +5,7 @@
 {-# 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
@@ -145,8 +145,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 +165,25 @@ 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 $ pdfLaTeX kind
+
 -- 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 
@@ -208,7 +227,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
@@ -266,8 +285,8 @@ sendEmailOrLetter recipient letter = do
     encRecipient :: CryptoUUIDUser <- encrypt svr
     apcIdent <- letterApcIdent letter encRecipient now
     let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr        
-    -- mailBody = getMailBody letter formatter
+    -- mailBody <- getMailBody letter formatter
-    renderLetter rcvrEnt letter apcIdent >>= \case
+    renderLetterPDF 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
@@ -303,7 +322,7 @@ sendEmailOrLetter recipient letter = do
         formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
         let isSupervised  = recipient /= svr
             supername     = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
-            mailBody      = getMailBody letter formatter
+        mailBody <- getMailBody letter formatter
         userMailTdirect svr $ do
           replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
           setSubjectI mailSubject

src/Utils/Print/ExpireQualification.hs

@@ -24,7 +24,7 @@ data LetterExpireQualificationF = LetterExpireQualificationF
     , leqfHolderID  :: UserId
     , leqfHolderDN  :: UserDisplayName
     , leqfHolderSN  :: UserSurname
-    , leqfExpiry    :: Day
+    , leqfExpiry    :: Maybe Day
     , leqfId        :: QualificationId
     , leqfName      :: Text             
     , leqfShort     :: Text             
@@ -34,9 +34,10 @@ data LetterExpireQualificationF = LetterExpireQualificationF
 
 -- 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 +47,11 @@ 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 +69,7 @@ instance MDLetter LetterExpireQualificationF where
       ] <>
       [ toMeta "lang"           lang
       , toMeta "licenceholder"  leqfHolderDN
-      , toMeta "expiry"         (format SelFormatDate leqfExpiry)
+      , mbMeta "expiry"         (format SelFormatDate <$> leqfExpiry)
       ] 
 
   getPJId LetterExpireQualificationF{..} =

src/Utils/Print/Letters.hs

@@ -217,7 +217,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 +249,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,7 +57,11 @@ 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)$
@@ -98,8 +101,12 @@ 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$

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}