fix(mail): honor userCsvOptions and userDisplayEmail

This commit is contained in:
Gregor Kleen 2019-10-01 09:07:21 +02:00
parent 8a688cc795
commit 89adf7f2dc
7 changed files with 28 additions and 16 deletions

View File

@ -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. 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 CommDuplicateRecipients n@Int: #{n} #{pluralDE n "doppelter" "doppelte"} Empfänger ignoriert
CommSuccess n@Int: Nachricht wurde an #{n} Empfänger versandt CommSuccess n@Int: Nachricht wurde an #{n} Empfänger versandt
CommUndisclosedRecipients: Verborgene Empfänger
CommAllRecipients: alle-empfaenger
CommCourseHeading: Kursmitteilung CommCourseHeading: Kursmitteilung
CommTutorialHeading: Tutorium-Mitteilung CommTutorialHeading: Tutorium-Mitteilung

View File

@ -1,6 +1,6 @@
module Handler.Utils.Mail module Handler.Utils.Mail
( addRecipientsDB ( addRecipientsDB
, userAddress , userAddress, userAddressFrom
, userMailT , userMailT
, addFileDB , addFileDB
) where ) where
@ -28,7 +28,16 @@ addRecipientsDB uFilter = runConduit $ transPipe (liftHandler . runDB) (selectSo
let addr = Address (Just userDisplayName) $ CI.original userEmail let addr = Address (Just userDisplayName) $ CI.original userEmail
_mailTo %= flip snoc addr _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 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 userAddress User{userEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userEmail
userMailT :: ( MonadHandler m userMailT :: ( MonadHandler m

View File

@ -20,7 +20,7 @@ dispatchJobInvitation jInviter jInvitee jInvitationUrl jInvitationSubject jInvit
whenIsJust mInviter $ \jInviter' -> mailT def $ do whenIsJust mInviter $ \jInviter' -> mailT def $ do
_mailTo .= [Address Nothing $ CI.original jInvitee] _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 "Auto-Submitted" $ Just "auto-generated"
replaceMailHeader "Subject" $ Just jInvitationSubject replaceMailHeader "Subject" $ Just jInvitationSubject
addPart ($(ihamletFile "templates/mail/invitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) addPart ($(ihamletFile "templates/mail/invitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

View File

@ -22,13 +22,15 @@ dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCours
<$> getJust jSender <$> getJust jSender
<*> getJust jCourse <*> getJust jCourse
either (\email -> mailT def . (assign _mailTo (pure . Address Nothing $ CI.original email) *>)) userMailT jRecipientEmail $ do either (\email -> mailT def . (assign _mailTo (pure . Address Nothing $ CI.original email) *>)) userMailT jRecipientEmail $ do
MsgRenderer mr <- getMailMsgRenderer
void $ setMailObjectUUID jMailObjectUUID void $ setMailObjectUUID jMailObjectUUID
_mailFrom .= userAddress sender _mailFrom .= userAddressFrom sender
addMailHeader "Cc" "Undisclosed Recipients:;" addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|]
addMailHeader "Auto-Submitted" "no" addMailHeader "Auto-Submitted" "no"
setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgCommCourseSubject) SomeMessage jSubject setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgCommCourseSubject) SomeMessage jSubject
void $ addPart jMailContent void $ addPart jMailContent
when (jRecipientEmail == Right jSender) $ when (jRecipientEmail == Right jSender) $
addPart' $ do addPart' $ do
partIsAttachment $ "all-recipients" `addExtension` unpack extensionCsv partIsAttachment $ unpack (mr MsgCommAllRecipients) `addExtension` unpack extensionCsv
toMailPart $ toDefaultOrderedCsvRendered jAllRecipientAddresses toMailPart (toDefaultOrderedCsvRendered jAllRecipientAddresses, userCsvOptions sender)

View File

@ -23,7 +23,7 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien
return (course, sheet, submission, corrector) return (course, sheet, submission, corrector)
whenIsJust corrector $ \corrector' -> whenIsJust corrector $ \corrector' ->
addMailHeader "Reply-To" . renderAddress $ userAddress corrector' addMailHeader "Reply-To" . renderAddress $ userAddressFrom corrector'
replaceMailHeader "Auto-Submitted" $ Just "auto-generated" replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectSubmissionRated courseShorthand setSubjectI $ MsgMailSubjectSubmissionRated courseShorthand

View File

@ -74,9 +74,6 @@ import qualified Data.ByteString.Lazy as LBS
import Utils (MsgRendererS(..), MonadSecretBox(..), maybeT) import Utils (MsgRendererS(..), MonadSecretBox(..), maybeT)
import Utils.Lens.TH import Utils.Lens.TH
import Utils.Csv (CsvRendered(..), typeCsv')
import qualified Data.Csv as Csv
import Control.Lens hiding (from) import Control.Lens hiding (from)
import Control.Lens.Extras (is) import Control.Lens.Extras (is)
@ -382,12 +379,6 @@ instance YesodMail site => ToMailPart site Aeson.Value where
_partEncoding .= QuotedPrintableText _partEncoding .= QuotedPrintableText
_partContent .= Aeson.encodePretty val _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) addAlternatives :: (MonadMail m)
=> Writer (PrioritisedAlternatives m) () => Writer (PrioritisedAlternatives m) ()

View File

@ -123,3 +123,11 @@ instance FromJSON CsvOptions where
derivePersistFieldJSON ''CsvOptions derivePersistFieldJSON ''CsvOptions
nullaryPathPiece ''CsvPreset $ camelToPathPiece' 2 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)