From 89adf7f2dc1caa90fc71adbcf0dc04936b685bd3 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 1 Oct 2019 09:07:21 +0200 Subject: [PATCH] fix(mail): honor userCsvOptions and userDisplayEmail --- messages/uniworx/de.msg | 2 ++ src/Handler/Utils/Mail.hs | 11 ++++++++++- src/Jobs/Handler/Invitation.hs | 2 +- src/Jobs/Handler/SendCourseCommunication.hs | 10 ++++++---- src/Jobs/Handler/SendNotification/SubmissionRated.hs | 2 +- src/Mail.hs | 9 --------- src/Model/Types/Misc.hs | 8 ++++++++ 7 files changed, 28 insertions(+), 16 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 02c290484..730487adc 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -1142,6 +1142,8 @@ CommRecipientsTip: Sie selbst erhalten immer eine Kopie der Nachricht CommRecipientsList: Die an Sie selbst verschickte Kopie der Nachricht wird, zu Archivierungszwecken, eine vollständige Liste aller Empfänger enthalten. Die Empfängerliste wird im CSV-Format and die E-Mail angehängt. Andere Empfänger erhalten die Liste nicht. Bitte entfernen Sie dementsprechend den Anhang bevor Sie die E-Mail weiterleiten oder anderweitig mit Dritten teilen. CommDuplicateRecipients n@Int: #{n} #{pluralDE n "doppelter" "doppelte"} Empfänger ignoriert CommSuccess n@Int: Nachricht wurde an #{n} Empfänger versandt +CommUndisclosedRecipients: Verborgene Empfänger +CommAllRecipients: alle-empfaenger CommCourseHeading: Kursmitteilung CommTutorialHeading: Tutorium-Mitteilung diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs index 726d7c975..814657010 100644 --- a/src/Handler/Utils/Mail.hs +++ b/src/Handler/Utils/Mail.hs @@ -1,6 +1,6 @@ module Handler.Utils.Mail ( addRecipientsDB - , userAddress + , userAddress, userAddressFrom , userMailT , addFileDB ) where @@ -28,7 +28,16 @@ addRecipientsDB uFilter = runConduit $ transPipe (liftHandler . runDB) (selectSo let addr = Address (Just userDisplayName) $ CI.original userEmail _mailTo %= flip snoc addr +userAddressFrom :: User -> Address +-- ^ Format an e-mail address suitable for usage in a @From@-header +-- +-- Uses `userDisplayEmail` +userAddressFrom User{userDisplayEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userDisplayEmail + userAddress :: User -> Address +-- ^ Format an e-mail address suitable for usage as a recipient +-- +-- Uses `userEmail` userAddress User{userEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userEmail userMailT :: ( MonadHandler m diff --git a/src/Jobs/Handler/Invitation.hs b/src/Jobs/Handler/Invitation.hs index 08526c0e8..87bab06cf 100644 --- a/src/Jobs/Handler/Invitation.hs +++ b/src/Jobs/Handler/Invitation.hs @@ -20,7 +20,7 @@ dispatchJobInvitation jInviter jInvitee jInvitationUrl jInvitationSubject jInvit whenIsJust mInviter $ \jInviter' -> mailT def $ do _mailTo .= [Address Nothing $ CI.original jInvitee] - replaceMailHeader "Reply-To" . Just . renderAddress $ userAddress jInviter' + replaceMailHeader "Reply-To" . Just . renderAddress $ userAddressFrom jInviter' replaceMailHeader "Auto-Submitted" $ Just "auto-generated" replaceMailHeader "Subject" $ Just jInvitationSubject addPart ($(ihamletFile "templates/mail/invitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendCourseCommunication.hs b/src/Jobs/Handler/SendCourseCommunication.hs index 7a35229d0..0f05d72a1 100644 --- a/src/Jobs/Handler/SendCourseCommunication.hs +++ b/src/Jobs/Handler/SendCourseCommunication.hs @@ -22,13 +22,15 @@ dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCours <$> getJust jSender <*> getJust jCourse either (\email -> mailT def . (assign _mailTo (pure . Address Nothing $ CI.original email) *>)) userMailT jRecipientEmail $ do + MsgRenderer mr <- getMailMsgRenderer + void $ setMailObjectUUID jMailObjectUUID - _mailFrom .= userAddress sender - addMailHeader "Cc" "Undisclosed Recipients:;" + _mailFrom .= userAddressFrom sender + addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|] addMailHeader "Auto-Submitted" "no" setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgCommCourseSubject) SomeMessage jSubject void $ addPart jMailContent when (jRecipientEmail == Right jSender) $ addPart' $ do - partIsAttachment $ "all-recipients" `addExtension` unpack extensionCsv - toMailPart $ toDefaultOrderedCsvRendered jAllRecipientAddresses + partIsAttachment $ unpack (mr MsgCommAllRecipients) `addExtension` unpack extensionCsv + toMailPart (toDefaultOrderedCsvRendered jAllRecipientAddresses, userCsvOptions sender) diff --git a/src/Jobs/Handler/SendNotification/SubmissionRated.hs b/src/Jobs/Handler/SendNotification/SubmissionRated.hs index a4448e1e6..466a9586f 100644 --- a/src/Jobs/Handler/SendNotification/SubmissionRated.hs +++ b/src/Jobs/Handler/SendNotification/SubmissionRated.hs @@ -23,7 +23,7 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien return (course, sheet, submission, corrector) whenIsJust corrector $ \corrector' -> - addMailHeader "Reply-To" . renderAddress $ userAddress corrector' + addMailHeader "Reply-To" . renderAddress $ userAddressFrom corrector' replaceMailHeader "Auto-Submitted" $ Just "auto-generated" setSubjectI $ MsgMailSubjectSubmissionRated courseShorthand diff --git a/src/Mail.hs b/src/Mail.hs index 60baf72b5..53b0e6611 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -74,9 +74,6 @@ import qualified Data.ByteString.Lazy as LBS import Utils (MsgRendererS(..), MonadSecretBox(..), maybeT) import Utils.Lens.TH -import Utils.Csv (CsvRendered(..), typeCsv') -import qualified Data.Csv as Csv - import Control.Lens hiding (from) import Control.Lens.Extras (is) @@ -382,12 +379,6 @@ instance YesodMail site => ToMailPart site Aeson.Value where _partEncoding .= QuotedPrintableText _partContent .= Aeson.encodePretty val -instance YesodMail site => ToMailPart site CsvRendered where - toMailPart CsvRendered{..} = do - _partType .= decodeUtf8 typeCsv' - _partEncoding .= QuotedPrintableText - _partContent .= Csv.encodeByName csvRenderedHeader csvRenderedData - addAlternatives :: (MonadMail m) => Writer (PrioritisedAlternatives m) () diff --git a/src/Model/Types/Misc.hs b/src/Model/Types/Misc.hs index 7d20c7bca..3444afb07 100644 --- a/src/Model/Types/Misc.hs +++ b/src/Model/Types/Misc.hs @@ -123,3 +123,11 @@ instance FromJSON CsvOptions where derivePersistFieldJSON ''CsvOptions nullaryPathPiece ''CsvPreset $ camelToPathPiece' 2 + +instance YesodMail site => ToMailPart site (CsvRendered, CsvOptions) where + toMailPart (CsvRendered{..}, encOpts) = do + _partType .= decodeUtf8 typeCsv' + _partEncoding .= QuotedPrintableText + _partContent .= Csv.encodeByNameWith (encOpts ^. _CsvEncodeOptions) csvRenderedHeader csvRenderedData +instance YesodMail site => ToMailPart site CsvRendered where + toMailPart = toMailPart . (, def :: CsvOptions)