module Service.MailService ( send ) where import Control.Arrow (left) import Control.Exception (SomeException, try) import qualified Control.Logging as Logging import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as LT import Data.Text.Lazy.Builder (fromText, toLazyText) import qualified Network.Mail.Mime as Mime import Model.Mail (Mail) import qualified Model.Mail as Mail send :: Bool -> Mail -> IO (Either Text ()) send isMock mail = if isMock then do Logging.log $ T.concat [ "MOCK sending mail ", T.pack . show $ mail ] return . Right $ () else do result <- left (T.pack . show) <$> (try (Mime.renderSendMailCustom "sendmail" ["-t"] . getMimeMail $ mail) :: IO (Either SomeException ())) case result of Left err -> Logging.loggingLogger Logging.LevelError "" . T.concat $ [ "Error sending the following email (" , T.pack . show $ mail , ":\n" , err ] Right _ -> 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.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