From 1360b4e49d4ddcf3230e423ca528430d985399c1 Mon Sep 17 00:00:00 2001 From: Joris Guyonvarch Date: Wed, 15 Apr 2015 23:47:31 +0200 Subject: Using mime-mail instead of MissingH to send mail so that we have a correct encoding --- leboncoin-listener.cabal | 2 +- src/Mail.hs | 35 ++++++++++++++++++----------------- 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 ())) -- cgit v1.2.3