From 4c54800b980663f420f7166927be9a429e95f7c8 Mon Sep 17 00:00:00 2001
From: Dennis Frieberg <dennis@frieberg.de>
Date: Fri, 6 Jun 2025 20:39:28 +0200
Subject: [PATCH] Added mandatory `Date:` header to E-Mail (why doesn't the
 library do that?)

---
 app/Sender.hs | 25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/app/Sender.hs b/app/Sender.hs
index efbe8d2..c78850d 100644
--- a/app/Sender.hs
+++ b/app/Sender.hs
@@ -1,19 +1,32 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Sender where
+module Sender
+  (generateMail
+  ,send
+  ) where
   
 import Network.Mail.Mime
 import Network.Mail.SMTP
 import qualified Data.Text as ST
 import qualified Data.Text.Lazy as LT
 import Monad
+import Control.Monad.IO.Class
+import Data.Time.LocalTime (getZonedTime)
+import Data.Time.Format (TimeLocale, formatTime, defaultTimeLocale)
 
+rfc5322Format :: String
+rfc5322Format = "%a, %d %b %0Y %T %z"
 
-generateMail :: ST.Text -> ST.Text -> ST.Text -> LT.Text -> Mail
-generateMail to from subj = simpleMail' (Address Nothing to) (Address Nothing from) subj
+generateMail :: (MonadIO m) => ST.Text -> ST.Text -> ST.Text -> LT.Text -> m Mail
+generateMail to from subj body = do
+  time <- liftIO getZonedTime
+  let timeString = ST.pack $ formatTime defaultTimeLocale rfc5322Format time
+      mailWithoutDate = simpleMail' (Address Nothing to) (Address Nothing from) subj body
+      mailWithDate = mailWithoutDate {mailHeaders = ("Date",timeString) : mailHeaders mailWithoutDate}
+  return mailWithDate
 
 --     domain -> Username -> password -> To  -> From   -> Subject -> Body
 send :: (MonadIO m) => String -> String -> String -> ST.Text -> ST.Text -> ST.Text -> LT.Text -> m ()
-send domain user pass to from subj body = liftIO $ sendMailWithLoginTLS domain user pass mail
-  where
-    mail = generateMail to from subj body
+send domain user pass to from subj body = do
+  mail <- liftIO $ generateMail to from subj body
+  liftIO $ sendMailWithLoginTLS domain user pass mail