fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Dates in emails

Browse Source
This commit is contained in:
Gregor Kleen 2018-10-03 18:40:06 +02:00
parent e650d5c2c0
commit 7553182cf9
2 changed files with 17 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Foundation.hs
View File

@ -1292,6 +1292,7 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
instance YesodMail UniWorX where instance YesodMail UniWorX where
defaultFromAddress = getsYesod $ appMailFrom . appSettings defaultFromAddress = getsYesod $ appMailFrom . appSettings
mailObjectIdDomain = getsYesod $ appMailObjectDomain . appSettings mailObjectIdDomain = getsYesod $ appMailObjectDomain . appSettings
mailDateTZ = return appTZ
instance (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => MonadCrypto m where instance (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => MonadCrypto m where

16
src/Mail.hs
View File

@ -31,6 +31,7 @@ module Mail
, replaceMailHeader, addMailHeader, removeMailHeader , replaceMailHeader, addMailHeader, removeMailHeader
, replaceMailHeaderI, addMailHeaderI , replaceMailHeaderI, addMailHeaderI
, setSubjectI, setMailObjectId, setMailObjectId' , setSubjectI, setMailObjectId, setMailObjectId'
, setDateCurrent
, _mailFrom, _mailTo, _mailCc, _mailBcc, _mailHeaders, _mailParts , _mailFrom, _mailTo, _mailCc, _mailBcc, _mailHeaders, _mailParts
, _partType, _partEncoding, _partFilename, _partHeaders, _partContent , _partType, _partEncoding, _partFilename, _partHeaders, _partContent
) where ) where
@ -73,6 +74,10 @@ import GHC.TypeLits (KnownSymbol)
import Network.BSD (getHostName) import Network.BSD (getHostName)
import Data.Time.Zones (TZ, utcTZ, utcToLocalTimeTZ, timeZoneForUTCTime)
import Data.Time.LocalTime (ZonedTime(..))
import Data.Time.Format
makeLenses_ ''Mail makeLenses_ ''Mail
makeLenses_ ''Part makeLenses_ ''Part
@ -108,6 +113,9 @@ class YesodMail site where
mailObjectIdDomain :: (MonadHandler m, HandlerSite m ~ site) => m Text mailObjectIdDomain :: (MonadHandler m, HandlerSite m ~ site) => m Text
mailObjectIdDomain = pack <$> liftIO getHostName mailObjectIdDomain = pack <$> liftIO getHostName
mailDateTZ :: (MonadHandler m, HandlerSite m ~ site) => m TZ
mailDateTZ = return utcTZ
mailT :: ( MonadHandler m mailT :: ( MonadHandler m
, YesodMail (HandlerSite m) , YesodMail (HandlerSite m)
) => [Text] -- ^ Languages in priority order ) => [Text] -- ^ Languages in priority order
@ -241,3 +249,11 @@ setMailObjectId' :: ( MonadHandler m
, Binary plain , Binary plain
) => plain -> MailT m MailObjectId ) => plain -> MailT m MailObjectId
setMailObjectId' oid = setMailObjectUUID . ciphertext =<< encrypt oid 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