fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

refactor(letter): remove class MDMail

Browse Source
This commit is contained in:
Steffen Jost 2023-06-05 11:20:31 +00:00
parent 3322d965ce
commit c57ab17d25
11 changed files with 86 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/categories/courses/courses/de-de-formal.msg
View File

@ -244,4 +244,5 @@ CourseAvsRegisterTitle: Teilnehmer:innen anmelden
CourseAvsRegisterParticipants: Teilnehmer:innen
CourseAvsRegisterParticipantsTip: Mehrere Teilnehmer:innen mit Komma separieren
CourseQualifications n@Int: Assoziierte #{pluralDE n "Qualifikation" "Qualifikationen"}
CourseQualifications n@Int: Assoziierte #{pluralDE n "Qualifikation" "Qualifikationen"}
CourseCertificate course@Text: Teilnahmebescheinung #{course}

3
messages/uniworx/categories/courses/courses/en-eu.msg
View File

@ -243,4 +243,5 @@ CourseAvsRegisterTitle: Register participants
CourseAvsRegisterParticipants: Participants
CourseAvsRegisterParticipantsTip: Separate multiple participants with comma
CourseQualifications n: Associated #{pluralENs n "Qualification"}
CourseQualifications n: Associated #{pluralENs n "Qualification"}
CourseCertificate course@Text: Certificate of attendance: #{course}

22
src/Handler/PrintCenter.hs
View File

@ -94,17 +94,17 @@ lrqf2letter LRQF{..}
usrShrt <- encrypt $ entityKey usr
usrUuid <- encrypt $ entityKey usr
urender <- liftHandler getUrlRender
let letter = LetterExpireQualificationF
{ leqfHolderCFN = usrShrt
, leqfHolderID = usr ^. _entityKey
, leqfHolderDN = usr ^. _userDisplayName
, leqfHolderSN = usr ^. _userSurname
, leqfExpiry = lrqfExpiry
, leqfId = lrqfQuali ^. _entityKey
, leqfName = lrqfQuali ^. _qualificationName . _CI
, leqfShort = lrqfQuali ^. _qualificationShorthand . _CI
, leqfSchool = lrqfQuali ^. _qualificationSchool
, leqfUrl = pure . urender $ ForProfileDataR usrUuid
let letter = LetterExpireQualification
{ leqHolderCFN = usrShrt
, leqHolderID = usr ^. _entityKey
, leqHolderDN = usr ^. _userDisplayName
, leqHolderSN = usr ^. _userSurname
, leqExpiry = lrqfExpiry
, leqId = lrqfQuali ^. _entityKey
, leqName = lrqfQuali ^. _qualificationName . _CI
, leqShort = lrqfQuali ^. _qualificationShorthand . _CI
, leqSchool = lrqfQuali ^. _qualificationSchool
, leqUrl = pure . urender $ ForProfileDataR usrUuid
}
return (fromMaybe usr rcvr, SomeLetter letter)
| otherwise = error "Unknown Letter Type encountered. Use 'e' or 'r' only."

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

@ -57,17 +57,17 @@ dispatchNotificationQualificationExpired nQualification jRecipient = do
let expDay = maybe qualificationUserValidUntil (min qualificationUserValidUntil . qualificationBlockedDay) qualificationUserBlockedDue
qname = CI.original qualificationName
qshort = CI.original qualificationShorthand
letter = LetterExpireQualificationF
{ leqfHolderCFN = encRecShort
, leqfHolderID = jRecipient
, leqfHolderDN = userDisplayName
, leqfHolderSN = userSurname
, leqfExpiry = Just expDay
, leqfId = nQualification
, leqfName = qname
, leqfShort = qshort
, leqfSchool = qualificationSchool
, leqfUrl = pure . urender $ ForProfileDataR encRecipient
letter = LetterExpireQualification
{ leqHolderCFN = encRecShort
, leqHolderID = jRecipient
, leqHolderDN = userDisplayName
, leqHolderSN = userSurname
, leqExpiry = Just expDay
, leqId = nQualification
, leqName = qname
, leqShort = qshort
, leqSchool = qualificationSchool
, leqUrl = pure . urender $ ForProfileDataR encRecipient
}
if expDay > utctDay qualificationUserLastNotified
then do

40
src/Utils/Print.hs
View File

@ -22,7 +22,7 @@ module Utils.Print
-- , MDLetter
, SomeLetter(..)
, LetterRenewQualificationF(..)
, LetterExpireQualificationF(..)
, LetterExpireQualification(..)
-- , LetterCourseCertificate()
, makeCourseCertificates
) where
@ -287,18 +287,24 @@ printLetter'' _ = do
}
-}
sendEmailOrLetter :: (MDLetter l, MDMail l) => UserId -> l -> Handler Bool
sendEmailOrLetter :: (MDLetter l) => UserId -> l -> Handler Bool
sendEmailOrLetter recipient letter = do
(underling, receivers, undercopy) <- updateReceivers recipient -- TODO: check to avoid this almost circular dependency
now <- liftIO getCurrentTime
mr <- getMessageRender
let pjid = getPJId letter
fName = letterFileName letter
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
-- these are only needed if sent by email, but we're lazy anyway
undername = underling ^. _userDisplayName -- nameHtml' underling
undermail = CI.original $ underling ^. _userEmail
mailSubjectRaw = getMailSubject letter
mailSubjectSuper = SomeMessage $ "[SUPERVISOR] " <> mr mailSubjectRaw
mkMailSubject = bool mailSubjectRaw mailSubjectSuper
mkMailBody = getMailBody letter
oks <- forM receivers $ \rcvrEnt@Entity{ entityKey = svr, entityVal = rcvrUsr } -> do
let supername = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
isSupervised = recipient /= svr
mailSubject = mkMailSubject isSupervised
encRecipient :: CryptoUUIDUser <- encrypt svr
apcIdent <- letterApcIdent letter encRecipient now
case getPostalPreferenceAndAddress rcvrUsr of
@ -323,7 +329,7 @@ sendEmailOrLetter recipient letter = do
$logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
return True
(False, _) | attachPDFLetter letter -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send Email, with pdf attached
(False, _) | Just mkMail <- mkMailBody -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send Email, but with pdf attached
Left err -> do -- pdf generation failed
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF attachment generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
$logErrorS "LETTER" msg
@ -342,14 +348,12 @@ sendEmailOrLetter recipient letter = do
$logWarnS "LETTER" msg
return pdf
formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
let isSupervised = recipient /= svr
supername = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
mailBody <- getMailBody letter formatter
let mailBody = mkMail formatter
userMailTdirect svr $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI mailSubject
editNotifications <- mkEditNotifications svr
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet") -- wrapper for mailBody
addPart (File { fileTitle = fName
, fileModified = now
, fileContent = Just $ yield $ LBS.toStrict attachment
@ -361,18 +365,10 @@ sendEmailOrLetter recipient letter = do
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
Right html -> do -- html generated, send directly now
userMailTdirect svr $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI subject
-- when isSupervised $ mapSubject ("[SUPERVISOR] " <>)
setSubjectI mailSubject
addHtmlMarkdownAlternatives html
return True
return $ or oks

1
src/Utils/Print/CourseCertificate.hs
View File

@ -45,6 +45,7 @@ instance MDLetter LetterCourseCertificate where
Text.replace "%%%course-content%%%" (unlines ccc) $
decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_qualification.md")
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_qualification.md")
getMailSubject l = SomeMessage . MsgCourseCertificate $ ccCourseName l
letterMeta LetterCourseCertificate{..} DateTimeFormatter{ format } lang _rcvrEnt =
mkMeta

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

@ -7,7 +7,6 @@
module Utils.Print.ExpireQualification where
import Import
import Text.Hamlet
-- import Data.Char as Char
-- import qualified Data.Text as Text
@ -16,85 +15,64 @@ import qualified Data.CaseInsensitive as CI
import Data.FileEmbed (embedFile)
import Utils.Print.Letters
import Handler.Utils.Widgets (nameHtml) -- , nameHtml')
data LetterExpireQualificationF = LetterExpireQualificationF
{ leqfHolderCFN :: CryptoFileNameUser
, leqfHolderID :: UserId
, leqfHolderDN :: UserDisplayName
, leqfHolderSN :: UserSurname
, leqfExpiry :: Maybe Day
, leqfId :: QualificationId
, leqfName :: Text
, leqfShort :: Text
, leqfSchool :: SchoolId
, leqfUrl :: Maybe Text
data LetterExpireQualification = LetterExpireQualification
{ leqHolderCFN :: CryptoFileNameUser
, leqHolderID :: UserId
, leqHolderDN :: UserDisplayName
, leqHolderSN :: UserSurname
, leqExpiry :: Maybe Day
, leqId :: QualificationId
, leqName :: Text
, leqShort :: Text
, leqSchool :: SchoolId
, leqUrl :: Maybe Text
}
deriving (Eq, Show)
-- 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 $ -- TODO: can we use render Letter here?
let expiryDate = format SelFormatDate <$> leqfExpiry
userDisplayName = leqfHolderDN
userSurname = leqfHolderSN
qualificationName = leqfName
qualificationShorthand = CI.mk leqfShort
qualificationSchool = leqfSchool
qname = qualificationName
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
instance MDLetter LetterExpireQualification where
encryptPDFfor _ = NoPassword
getLetterKind _ = Din5008
getLetterEnvelope _ = 'e'
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqShort l
getTemplate LetterExpireQualificationF{leqfShort="F"}
getTemplate LetterExpireQualification{leqShort="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
letterMeta LetterExpireQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
let isSupervised = rcvrId /= leqHolderID
in mkMeta $
guardMonoid isSupervised
[ 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
, toMeta "licencename" leqName
, toMeta "licenceshort" leqShort
, toMeta "licenceholder" leqHolderDN
, mbMeta "expiry" (format SelFormatDate <$> leqExpiry)
, mbMeta "licence-url" leqUrl
, toMeta "de-opening" $ bool ("Guten Tag " <> leqHolderDN <> ",") "Sehr geehrte Damen und Herren," isSupervised
, toMeta "en-opening" $ bool ("Dear " <> leqHolderDN <> ",") "Dear supervisor," isSupervised
, toMeta "de-subject" $ "Entzug \"" <> leqShort <> "\" (" <> leqName <> ")"
, toMeta "en-subject" $ case leqShort of
"F" -> "Revocation of apron driving license"
_ -> "Revocation of licence \"" <> leqfShort <> "\" (" <> leqfName <> ")"
_ -> "Revocation of licence \"" <> leqShort <> "\" (" <> leqName <> ")"
]
getPJId LetterExpireQualificationF{..} =
getPJId LetterExpireQualification{..} =
PrintJobIdentification
{ pjiName = "Expiry"
, pjiApcAcknowledge = "ex-" <> toPathPiece leqfHolderCFN
, pjiApcAcknowledge = "ex-" <> toPathPiece leqHolderCFN
, pjiRecipient = Nothing -- to be filled later
, pjiSender = Nothing
, pjiCourse = Nothing
, pjiQualification = Just leqfId
, pjiQualification = Just leqId
, pjiLmsUser = Nothing
, pjiFileName = "expire_" <> CI.original (unSchoolKey leqfSchool) <> "-" <> leqfShort <> "_" <> leqfHolderSN
, pjiFileName = "expire_" <> CI.original (unSchoolKey leqSchool) <> "-" <> leqShort <> "_" <> leqHolderSN
-- let nameRecipient = abbrvName <$> recipient
-- nameSender = abbrvName <$> sender
-- nameCourse = CI.original . courseShorthand <$> course

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

@ -226,6 +226,9 @@ class MDLetter l where
getLetterKind :: l -> LetterKind
getTemplate :: l -> Text
encryptPDFfor :: l -> EncryptPDFfor
getMailSubject :: l -> SomeMessage UniWorX -- currently only used as email subject
getMailBody :: l -> Maybe (DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -- Just returns cover-lettter for attaching PDF to, Nothing indicates that the letter should be sent as direct Html Email
getMailBody = const Nothing
letterApcIdent :: (MDLetter l, MonadHandler m) => l -> CryptoUUIDUser -> UTCTime -> m Text
letterApcIdent l uuid now = do
@ -242,17 +245,3 @@ addApcIdent = P.Meta . toMeta "apc-ident"
getApcIdent :: P.Meta -> Maybe Text
getApcIdent (P.lookupMeta "apc-ident" -> Just (P.MetaString t)) = Just t
getApcIdent _ = Nothing
----------------
-- Mail Class --
----------------
-- this is for letters that may alternatively be sent as attachments to emails
class MDMail l where --
getMailSubject :: l -> SomeMessage 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

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

@ -46,17 +46,16 @@ letterRenewalQualificationFData LetterRenewQualificationF{lmsLogin} = LetterRene
lmsUrlLogin = lmsUrl <> "/?login=" <> lmsIdent
lmsIdent = getLmsIdent lmsLogin
instance MDMail LetterRenewQualificationF where
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } = return $
let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
instance MDLetter LetterRenewQualificationF where
encryptPDFfor _ = PasswordUnderling
encryptPDFfor _ = PasswordUnderling
getLetterKind _ = PinLetter
getLetterEnvelope _ = 'f' -- maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
getMailBody l@LetterRenewQualificationF{..} = Just $ \DateTimeFormatter{ format } ->
let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
letterMeta l@LetterRenewQualificationF{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l

8
src/Utils/Print/SomeLetter.hs
View File

@ -8,11 +8,7 @@ module Utils.Print.SomeLetter where
import Utils.Print.Letters
data SomeLetter = forall l . (MDLetter l, MDMail l) => SomeLetter l -- a record selector would be useless here due to the escaped type variable
instance MDMail SomeLetter where
getMailSubject (SomeLetter l) = getMailSubject l
getMailBody (SomeLetter l) = getMailBody l
data SomeLetter = forall l . (MDLetter l) => SomeLetter l -- a record selector would be useless here due to the escaped type variable
instance MDLetter SomeLetter where
letterMeta (SomeLetter l) = letterMeta l
@ -20,4 +16,6 @@ instance MDLetter SomeLetter where
getLetterEnvelope (SomeLetter l) = getLetterEnvelope l
getLetterKind (SomeLetter l) = getLetterKind l
getTemplate (SomeLetter l) = getTemplate l
getMailSubject (SomeLetter l) = getMailSubject l
getMailBody (SomeLetter l) = getMailBody l
encryptPDFfor (SomeLetter l) = encryptPDFfor l

37
templates/mail/qualificationExpired.hamlet
View File

@ -1,37 +0,0 @@
$newline never
$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
\<!doctype html>
<html>
<head>
<meta charset="UTF-8">
<style>
h1 {
font-size: 1.25em;
font-variant: small-caps;
font-weight: normal;
}
<body>
<h1>
_{SomeMessage $ MsgMailSubjectQualificationExpired qname}
<p>
_{SomeMessage MsgMailBodyQualificationExpired}
<p>
<dl>
<dt>_{SomeMessage MsgQualificationName}
<dd>
<a href=@{QualificationR qualificationSchool qualificationShorthand}>
#{qualificationName}
<dt>_{SomeMessage MsgLmsUser}
<dd>#{nameHtml userDisplayName userSurname}
$maybe expDate <- expiryDate
<dt>_{SomeMessage MsgQualificationExpired}
<dd>#{expDate}
^{ihamletSomeMessage editNotifications}