From 3453fc34598581f88dd5696fd28ddd726b389ed1 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Fri, 7 Jan 2022 17:45:14 +0100
Subject: [PATCH] fix(mail): add debug info why setting reply to instead of
 sender does not work

---
 src/Mail.hs | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/src/Mail.hs b/src/Mail.hs
index 97c516308..d97d9df68 100644
--- a/src/Mail.hs
+++ b/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 }