fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Steffen Jost 2023-05-05 15:28:05 +00:00
parent ab090deec8
commit cdf7f5c3b9
9 changed files with 64 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Handler/Admin/Test.hs
View File

@ -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

9
src/Handler/PrintCenter.hs
View File

@ -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

2
src/Jobs/Handler/SendNotification/Qualification.hs
View File

@ -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

33
src/Utils/Print.hs
View File

@ -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

14
src/Utils/Print/ExpireQualification.hs
View File

@ -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{..} =

7
src/Utils/Print/Letters.hs
View File

@ -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

2
src/Utils/Print/RenewQualification.hs
View File

@ -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")

17
templates/letter/fraport_f_expiry.md
View File

@ -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$

5
templates/mail/qualificationExpired.hamlet
View File

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