Make LBC to work

Use request headers to simulate a normal browser

1 files changed, 21 insertions, 8 deletions

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 =