module SendMail ( sendMail ) where import Control.Arrow (left) import Control.Exception (SomeException, try) import Data.Either (isLeft) import qualified Network.Mail.Mime as M import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import Data.Text.Lazy.Builder (fromText, toLazyText) import Conf (Conf) import qualified Conf import Model.Mail (Mail (..)) sendMail :: Conf -> Mail -> IO (Either Text ()) sendMail conf mail = if Conf.devMode conf then do T.putStrLn . mockMailMessage $ mail return (Right ()) else do result <- left (T.pack . show) <$> (try (M.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ())) if isLeft result then putStrLn ("Error sending the following email:" ++ (show mail) ++ "\n" ++ (show result)) else return () return result mockMailMessage :: Mail -> Text mockMailMessage mail = T.concat $ [ "[MOCK MAIL] " , subject mail , " (from: " , from mail , ") (to: " , T.intercalate ", " $ to mail , ")" , "\n" , body mail , "\n" ] getMimeMail :: Mail -> M.Mail getMimeMail (Mail mailFrom mailTo mailSubject mailPlainBody) = let fromMail = M.emptyMail (address mailFrom) in fromMail { M.mailTo = map address mailTo , M.mailParts = [ [ M.plainPart . strictToLazy $ mailPlainBody ] ] , M.mailHeaders = [("Subject", mailSubject)] } address :: Text -> M.Address address addressEmail = M.Address { M.addressName = Nothing , M.addressEmail = addressEmail } strictToLazy :: Text -> LT.Text strictToLazy = toLazyText . fromText