blob: 1145f9f744ba8e118e65e2493c1aed0b866e157a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
{-# LANGUAGE OverloadedStrings #-}
module Mail
( send
) where
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Builder (toLazyText, fromText)
import Data.Either (isLeft)
import Control.Exception (SomeException, try)
import Control.Arrow (left)
import qualified Network.Mail.Mime as Mime
import Model.Mail (Mail)
import qualified Model.Mail as Mail
send :: Mail -> IO (Either Text ())
send mail = do
result <- left (T.pack . show) <$> (try (Mime.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ()))
if isLeft result
then putStrLn ("Error sending the following email:" ++ (show mail))
else return ()
return result
getMimeMail :: Mail -> Mime.Mail
getMimeMail mail =
let fromMail = Mime.emptyMail . address . Mail.from $ mail
in fromMail
{ Mime.mailTo = map address . Mail.to $ mail
, Mime.mailParts =
[ [ Mime.plainPart . strictToLazy . Mail.plainBody $ mail
, Mime.htmlPart . strictToLazy . Mail.htmlBody $ mail
]
]
, Mime.mailHeaders = [("Subject", Mail.subject mail)]
}
address :: Text -> Mime.Address
address addressEmail =
Mime.Address
{ Mime.addressName = Nothing
, Mime.addressEmail = addressEmail
}
strictToLazy :: Text -> LT.Text
strictToLazy = toLazyText . fromText
|
