fix(mail): honor userCsvOptions and userDisplayEmail
This commit is contained in:
parent
8a688cc795
commit
89adf7f2dc
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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))
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
@ -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) ()
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user