From 7553182cf968410fe33664a9f4d75f85fedcefb9 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 3 Oct 2018 18:40:06 +0200
Subject: [PATCH] Dates in emails

---
 src/Foundation.hs |  1 +
 src/Mail.hs       | 16 ++++++++++++++++
 2 files changed, 17 insertions(+)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index b8b3d2e7e..c8ed085f6 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1292,6 +1292,7 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
 instance YesodMail UniWorX where
   defaultFromAddress = getsYesod $ appMailFrom . appSettings
   mailObjectIdDomain = getsYesod $ appMailObjectDomain . appSettings
+  mailDateTZ = return appTZ
 
 
 instance (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => MonadCrypto m where
diff --git a/src/Mail.hs b/src/Mail.hs
index 0275c1ac2..d289f1ac9 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -31,6 +31,7 @@ module Mail
   , replaceMailHeader, addMailHeader, removeMailHeader
   , replaceMailHeaderI, addMailHeaderI
   , setSubjectI, setMailObjectId, setMailObjectId'
+  , setDateCurrent
   , _mailFrom, _mailTo, _mailCc, _mailBcc, _mailHeaders, _mailParts
   , _partType, _partEncoding, _partFilename, _partHeaders, _partContent
   ) where
@@ -73,6 +74,10 @@ import GHC.TypeLits (KnownSymbol)
 
 import Network.BSD (getHostName)
 
+import Data.Time.Zones (TZ, utcTZ, utcToLocalTimeTZ, timeZoneForUTCTime)
+import Data.Time.LocalTime (ZonedTime(..))
+import Data.Time.Format
+
 
 makeLenses_ ''Mail
 makeLenses_ ''Part
@@ -108,6 +113,9 @@ class YesodMail site where
   mailObjectIdDomain :: (MonadHandler m, HandlerSite m ~ site) => m Text
   mailObjectIdDomain = pack <$> liftIO getHostName
 
+  mailDateTZ :: (MonadHandler m, HandlerSite m ~ site) => m TZ
+  mailDateTZ = return utcTZ
+
 mailT :: ( MonadHandler m
          , YesodMail (HandlerSite m)
          ) => [Text] -- ^ Languages in priority order
@@ -241,3 +249,11 @@ setMailObjectId' :: ( MonadHandler m
                     , Binary plain
                     ) => plain -> MailT m MailObjectId
 setMailObjectId' oid = setMailObjectUUID . ciphertext =<< encrypt oid
+
+
+setDateCurrent :: (MonadHandler m, YesodMail (HandlerSite m)) => MailT m ()
+setDateCurrent = do
+  now <- liftIO getCurrentTime
+  tz <- mailDateTZ
+  let timeStr = formatTime defaultTimeLocale "%a, %d %b %Y %T %z" $ ZonedTime (utcToLocalTimeTZ tz now) (timeZoneForUTCTime tz now)
+  replaceMailHeader "Date" . Just $ pack timeStr