From 169d52bfbe8b7f95dcece3cef245cdd62336e2f8 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sun, 9 Aug 2015 00:21:03 +0200
Subject: Wording for sign in email

---
 src/server/SendMail.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 45 insertions(+)
 create mode 100644 src/server/SendMail.hs

(limited to 'src/server/SendMail.hs')

diff --git a/src/server/SendMail.hs b/src/server/SendMail.hs
new file mode 100644
index 0000000..74d48ab
--- /dev/null
+++ b/src/server/SendMail.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module SendMail
+  ( sendMail
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import Data.Either (isLeft)
+
+import Control.Exception (SomeException, try)
+import Control.Arrow (left)
+
+import qualified Network.Mail.Mime as M
+
+import Model.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))
+    else return ()
+  return result
+
+getMimeMail :: Mail -> M.Mail
+getMimeMail (Mail to subject plainBody htmlBody) =
+  let fromMail = M.emptyMail (address "no-reply@shared-cost.guyonvarch.me")
+  in  fromMail
+        { M.mailTo = map address to
+        , M.mailParts =
+            [ [ M.plainPart plainBody
+              , M.htmlPart htmlBody
+              ]
+            ]
+        , M.mailHeaders = [("Subject", subject)]
+        }
+
+address :: Text -> M.Address
+address addressEmail =
+  M.Address
+    { M.addressName = Nothing
+    , M.addressEmail = addressEmail
+    }
-- 
cgit v1.2.3