Using mime-mail instead of MissingH to send mail so that we have a correct encoding

2 files changed, 19 insertions, 18 deletions

diff --git a/leboncoin-listener.cabal b/leboncoin-listener.cabal
index 0c3123f..e48cdb3 100644
--- a/leboncoin-listener.cabal
+++ b/leboncoin-listener.cabal
@@ -13,4 +13,4 @@ executable leboncoin-listener
                      , time == 1.5.0.1
                      , HTTP == 4000.2.19
                      , tagsoup == 0.13.3
-                     , MissingH == 1.3.0.1
+                     , mime-mail == 0.4.8.2
diff --git a/src/Mail.hs b/src/Mail.hs
index 5fc2f24..1b15f30 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -5,28 +5,29 @@ module Mail
   ) where
 
 import Data.Text (Text)
+import Data.Text.Lazy.Builder (toLazyText, fromText)
 import qualified Data.Text as T
 
 import Control.Exception (SomeException, try)
 
-import Network.Email.Sendmail (sendmail)
+import Network.Mail.Mime
 
 import Utils.Either (mapLeft)
 
 sendMail :: [Text] -> Text -> Text -> IO (Either Text ())
-sendMail mailTo subject message =
-  let from = Just "no-reply@leboncoin-listener.com"
-  in  safeSendMail from (map T.unpack $ mailTo) (T.unpack $ makeBody subject message)
-
-makeBody :: Text -> Text -> Text
-makeBody subject message =
-  T.concat
-    [ "Subject: "
-    , subject
-    , "\n\n"
-    , message
-    ]
-
-safeSendMail :: Maybe String -> [String] -> String -> IO (Either Text ())
-safeSendMail from to body =
-  mapLeft (T.pack . show) <$> (try (sendmail from to body) :: IO (Either SomeException ()))
+sendMail mailTo subject body = safeSendMail (mail mailTo subject body)
+
+mail :: [Text] -> Text -> Text -> Mail
+mail mailTo subject body =
+  (emptyMail (address "no-reply@leboncoin-listener.com"))
+    { mailTo = map address mailTo
+    , mailParts = [[plainPart (toLazyText . fromText $ body)]]
+    , mailHeaders = [("Subject", subject)]
+    }
+
+address :: Text -> Address
+address mail = Address { addressName = Nothing, addressEmail = mail }
+
+safeSendMail :: Mail -> IO (Either Text ())
+safeSendMail mail =
+  mapLeft (T.pack . show) <$> (try (renderSendMail mail) :: IO (Either SomeException ()))