fix(mail): add debug info why setting reply to instead of sender does not work
This commit is contained in:
parent
ddb1a15c18
commit
3453fc3459
16
src/Mail.hs
16
src/Mail.hs
@ -72,7 +72,7 @@ import qualified Data.Text.Lazy.Builder as LTB
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.ByteString as BS
|
||||
|
||||
import Utils (MsgRendererS(..), MonadSecretBox(..), YamlValue, maybeMonoid, insertAssoc, maybeT, guardM)
|
||||
import Utils (MsgRendererS(..), MonadSecretBox(..), YamlValue, maybeMonoid, insertAssoc) -- , maybeT, guardM)
|
||||
import Utils.Lens.TH
|
||||
|
||||
import Control.Lens hiding (from)
|
||||
@ -314,7 +314,7 @@ defMailT :: ( MonadHandler m
|
||||
defMailT ls (MailT mailC) = do
|
||||
fromAddress <- defaultFromAddress
|
||||
(ret, mail, smtpData) <- runRWST mailC ls (emptyMail fromAddress)
|
||||
|
||||
{- -- Doesn't work somehow
|
||||
mail' <- maybeT (return mail) $ do
|
||||
guardM useReplyToInstead -- if sender must be fixed within ObjectIdDomain, use replyTo instead
|
||||
let sender = mail ^. _mailFrom
|
||||
@ -323,9 +323,17 @@ defMailT ls (MailT mailC) = do
|
||||
return $ mail
|
||||
& _mailFrom .~ fromAddress
|
||||
& _mailReplyTo .~ sender
|
||||
|
||||
-}
|
||||
useReply <- useReplyToInstead
|
||||
domain <- mailObjectIdDomain
|
||||
let sender = mail ^. _mailFrom
|
||||
mail' = mail & _mailFrom .~ fromAddress
|
||||
& _mailReplyTo .~ sender
|
||||
suffixFilter = domain `Text.isSuffixOf` (sender ^. _addressEmail)
|
||||
$logDebugS "Mail" $ "Use ReplyTo instead of Sender: " <> tshow useReply <> ", " <> tshow suffixFilter <> " From was: " <> renderAddress sender <> " From is: " <> renderAddress fromAddress
|
||||
|
||||
mail'' <- liftIO $ LBS.toStrict <$> renderMail' mail'
|
||||
-- logDebugS "Mail" $ "Rendered mail:\n" <> decodeUtf8 mail''
|
||||
$logDebugS "Mail" $ "Rendered mail:\n" <> decodeUtf8 mail''
|
||||
ret <$ case smtpData of
|
||||
MailSmtpData{ smtpEnvelopeFrom = Last Nothing } -> throwM MailNoSenderSpecified
|
||||
MailSmtpData{ smtpRecipients }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user