mirror of
https://git.nerfingen.de/nerf/choirMail.git
synced 2025-06-08 09:41:00 +00:00
Compare commits
1 commit
ab7c39b707
...
4c54800b98
Author | SHA1 | Date | |
---|---|---|---|
4c54800b98 |
1 changed files with 19 additions and 6 deletions
|
@ -1,19 +1,32 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Sender where
|
module Sender
|
||||||
|
(generateMail
|
||||||
|
,send
|
||||||
|
) where
|
||||||
|
|
||||||
import Network.Mail.Mime
|
import Network.Mail.Mime
|
||||||
import Network.Mail.SMTP
|
import Network.Mail.SMTP
|
||||||
import qualified Data.Text as ST
|
import qualified Data.Text as ST
|
||||||
import qualified Data.Text.Lazy as LT
|
import qualified Data.Text.Lazy as LT
|
||||||
import Monad
|
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 :: (MonadIO m) => ST.Text -> ST.Text -> ST.Text -> LT.Text -> m Mail
|
||||||
generateMail to from subj = simpleMail' (Address Nothing to) (Address Nothing from) subj
|
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
|
-- domain -> Username -> password -> To -> From -> Subject -> Body
|
||||||
send :: (MonadIO m) => String -> String -> String -> ST.Text -> ST.Text -> ST.Text -> LT.Text -> m ()
|
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
|
send domain user pass to from subj body = do
|
||||||
where
|
mail <- liftIO $ generateMail to from subj body
|
||||||
mail = generateMail to from subj body
|
liftIO $ sendMailWithLoginTLS domain user pass mail
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue