From 5cedcecd6ae31e2485dcab2ddd74c74a4779545d Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 3 Sep 2019 21:01:53 +0200 Subject: Make LBC to work Use request headers to simulate a normal browser --- src/executable/haskell/Service/MailService.hs | 29 +++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) (limited to 'src/executable/haskell/Service/MailService.hs') diff --git a/src/executable/haskell/Service/MailService.hs b/src/executable/haskell/Service/MailService.hs index 955dea1..cb61c47 100644 --- a/src/executable/haskell/Service/MailService.hs +++ b/src/executable/haskell/Service/MailService.hs @@ -4,9 +4,9 @@ module Service.MailService import Control.Arrow (left) import Control.Exception (SomeException, try) -import Data.Either (isLeft) 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 qualified Network.Mail.Mime as Mime @@ -14,13 +14,26 @@ 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 +send :: Bool -> Mail -> IO (Either Text ()) +send isMock mail = + if isMock then do + putStrLn $ "MOCK sending mail " ++ (show mail) + return . Right $ () + else do + result <- + left (T.pack . show) <$> + (try (Mime.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ())) + case result of + Left err -> + T.putStrLn . T.concat $ + [ "Error sending the following email (" + , T.pack . show $ mail + , ":\n" + , err + ] + Right _ -> + return () + return result getMimeMail :: Mail -> Mime.Mail getMimeMail mail = -- cgit v1.2.3