From 4bd2e84a47e5b74f736973fb3555c7ee9a5af0d5 Mon Sep 17 00:00:00 2001
From: Spencer Janssen <sjanssen@masterword.com>
Date: Tue, 17 Oct 2023 13:38:22 -0500
Subject: [PATCH] Remove BCC before sending mail

---
 CHANGELOG.md         | 5 +++++
 Network/Mail/SMTP.hs | 7 +++++--
 smtp-mail.cabal      | 2 +-
 3 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 42158af..41a950b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -20,6 +20,11 @@ A template is provided:
   - Indicate if changes are major, minor, or patch changes.
 ```
 
+## 0.5.0.1
+ - [#39](https://github.com/jhickner/smtp-mail/pull/39) @spencerjanssen
+    - The `Bcc` field is stripped from the message before sending to the SMTP
+      server. This is to prevent leaking the BCC contents to recipients.
+
 ## 0.5.0.0
 
 - Adds support for OAuth authentication with a new function `sendMailWithLoginOAuthSTARTTLS`.
diff --git a/Network/Mail/SMTP.hs b/Network/Mail/SMTP.hs
index 148c984..1ab6b44 100644
--- a/Network/Mail/SMTP.hs
+++ b/Network/Mail/SMTP.hs
@@ -326,12 +326,15 @@ sendRenderedMail sender receivers dat conn = do
 -- 'SMTPConnection'
 renderAndSend ::SMTPConnection -> Mail -> IO ()
 renderAndSend conn mail@Mail{..} = do
-    rendered <- lazyToStrict `fmap` renderMail' mail
+    rendered <- lazyToStrict `fmap` renderMail' (removeBcc mail)
     sendRenderedMail from to rendered conn
   where enc  = encodeUtf8 . addressEmail
         from = enc mailFrom
         to   = map enc $ mailTo ++ mailCc ++ mailBcc
 
+removeBcc :: Mail -> Mail
+removeBcc mail = mail {mailBcc = []}
+
 sendMailOnConnection :: Mail -> SMTPConnection -> IO ()
 sendMailOnConnection mail con = do
   renderAndSend con mail
@@ -436,7 +439,7 @@ sendMailWithSenderIntern sender mail con = do
 
 renderAndSendFrom :: ByteString -> SMTPConnection -> Mail -> IO ()
 renderAndSendFrom sender conn mail@Mail{..} = do
-    rendered <- BL.toStrict `fmap` renderMail' mail
+    rendered <- BL.toStrict `fmap` renderMail' (removeBcc mail)
     sendRenderedMail sender to rendered conn
   where enc  = encodeUtf8 . addressEmail
         to   = map enc $ mailTo ++ mailCc ++ mailBcc
diff --git a/smtp-mail.cabal b/smtp-mail.cabal
index 19c9bd3..aa79915 100644
--- a/smtp-mail.cabal
+++ b/smtp-mail.cabal
@@ -1,5 +1,5 @@
 name:                smtp-mail
-version:             0.5.0.0
+version:             0.5.0.1
 synopsis:            Simple email sending via SMTP
 description:         This packages provides a simple interface for mail over SMTP. Please see the README for more information.
 homepage:            http://github.com/haskell-github-trust/smtp-mail