diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index cf6e1b500..e93ead7ba 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -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"} \ No newline at end of file +CourseQualifications n@Int: Assoziierte #{pluralDE n "Qualifikation" "Qualifikationen"} +CourseCertificate course@Text: Teilnahmebescheinung #{course} \ No newline at end of file diff --git a/messages/uniworx/categories/courses/courses/en-eu.msg b/messages/uniworx/categories/courses/courses/en-eu.msg index abfbba6cc..087463a3c 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/en-eu.msg @@ -243,4 +243,5 @@ CourseAvsRegisterTitle: Register participants CourseAvsRegisterParticipants: Participants CourseAvsRegisterParticipantsTip: Separate multiple participants with comma -CourseQualifications n: Associated #{pluralENs n "Qualification"} \ No newline at end of file +CourseQualifications n: Associated #{pluralENs n "Qualification"} +CourseCertificate course@Text: Certificate of attendance: #{course} \ No newline at end of file diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index f12f5b9af..98fe75cca 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -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." diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 241af0bc3..2200b12c3 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -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 diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index f1d3054de..0d17e1781 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -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 diff --git a/src/Utils/Print/CourseCertificate.hs b/src/Utils/Print/CourseCertificate.hs index 4474ac754..babcdfa54 100644 --- a/src/Utils/Print/CourseCertificate.hs +++ b/src/Utils/Print/CourseCertificate.hs @@ -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 diff --git a/src/Utils/Print/ExpireQualification.hs b/src/Utils/Print/ExpireQualification.hs index d261d0f8d..ddbba609e 100644 --- a/src/Utils/Print/ExpireQualification.hs +++ b/src/Utils/Print/ExpireQualification.hs @@ -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 diff --git a/src/Utils/Print/Letters.hs b/src/Utils/Print/Letters.hs index 7fe8b4a68..37ffde18c 100644 --- a/src/Utils/Print/Letters.hs +++ b/src/Utils/Print/Letters.hs @@ -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 diff --git a/src/Utils/Print/RenewQualification.hs b/src/Utils/Print/RenewQualification.hs index a7900105c..31a5a23dc 100644 --- a/src/Utils/Print/RenewQualification.hs +++ b/src/Utils/Print/RenewQualification.hs @@ -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 diff --git a/src/Utils/Print/SomeLetter.hs b/src/Utils/Print/SomeLetter.hs index b10ed63c0..e0ba66645 100644 --- a/src/Utils/Print/SomeLetter.hs +++ b/src/Utils/Print/SomeLetter.hs @@ -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 \ No newline at end of file diff --git a/templates/mail/qualificationExpired.hamlet b/templates/mail/qualificationExpired.hamlet deleted file mode 100644 index a7d84f549..000000000 --- a/templates/mail/qualificationExpired.hamlet +++ /dev/null @@ -1,37 +0,0 @@ -$newline never - -$# SPDX-FileCopyrightText: 2022 Steffen Jost -$# -$# SPDX-License-Identifier: AGPL-3.0-or-later - -\ - - - -