aboutsummaryrefslogtreecommitdiff
path: root/server/src/SendMail.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/SendMail.hs')
-rw-r--r--server/src/SendMail.hs39
1 files changed, 31 insertions, 8 deletions
diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs
index c15ed62..3b17a0a 100644
--- a/server/src/SendMail.hs
+++ b/server/src/SendMail.hs
@@ -9,18 +9,41 @@ 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 Model.Mail (Mail (Mail))
+import Conf (Conf)
+import qualified Conf
+import Model.Mail (Mail (..))
-sendMail :: Mail -> IO (Either Text ())
-sendMail mail = 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 putStrLn "OK"
- return result
+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
+ ]
getMimeMail :: Mail -> M.Mail
getMimeMail (Mail mailFrom mailTo mailSubject mailPlainBody) =