diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs
index ca0d2aae8..2699c4f0e 100644
--- a/src/Handler/Admin/Test.hs
+++ b/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
diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs
index c80c669a9..1efb0dd4d 100644
--- a/src/Handler/PrintCenter.hs
+++ b/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
diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs
index 852bee308..32a3d942d 100644
--- a/src/Jobs/Handler/SendNotification/Qualification.hs
+++ b/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
diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs
index 72e689947..5b00aa3bf 100644
--- a/src/Utils/Print.hs
+++ b/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)
-renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
+renderLetterPDF :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
+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
- renderLetter rcvrEnt letter apcIdent >>= \case
+ -- mailBody <- getMailBody letter formatter
+ 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
diff --git a/src/Utils/Print/ExpireQualification.hs b/src/Utils/Print/ExpireQualification.hs
index c7f5e8167..d596cbc1d 100644
--- a/src/Utils/Print/ExpireQualification.hs
+++ b/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 } =
- let expiryDate = format SelFormatDate leqfExpiry
+ getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } = return $
+ 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{..} =
diff --git a/src/Utils/Print/Letters.hs b/src/Utils/Print/Letters.hs
index 22ad52518..83759315e 100644
--- a/src/Utils/Print/Letters.hs
+++ b/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
diff --git a/src/Utils/Print/RenewQualification.hs b/src/Utils/Print/RenewQualification.hs
index fc6a05038..a7900105c 100644
--- a/src/Utils/Print/RenewQualification.hs
+++ b/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")
diff --git a/templates/letter/fraport_f_expiry.md b/templates/letter/fraport_f_expiry.md
index 8cb3768e5..ee8b76fe1 100644
--- a/templates/letter/fraport_f_expiry.md
+++ b/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$
diff --git a/templates/mail/qualificationExpired.hamlet b/templates/mail/qualificationExpired.hamlet
index a8ba9c974..a7d84f549 100644
--- a/templates/mail/qualificationExpired.hamlet
+++ b/templates/mail/qualificationExpired.hamlet
@@ -29,8 +29,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
#{qualificationName}
_{SomeMessage MsgLmsUser}
#{nameHtml userDisplayName userSurname}
- _{SomeMessage MsgQualificationExpired}
- #{expiryDate}
+ $maybe expDate <- expiryDate
+ _{SomeMessage MsgQualificationExpired}
+ #{expDate}
^{ihamletSomeMessage editNotifications}