From f687b15d4d3f55fb231cd03b773b163ed131b129 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sun, 19 Jul 2015 18:50:49 +0200
Subject: Send the login token by email

---
 src/server/Application.hs | 27 ++++++++++++++++++---------
 1 file changed, 18 insertions(+), 9 deletions(-)

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

diff --git a/src/server/Application.hs b/src/server/Application.hs
index 6a18102..7bb305e 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -23,7 +23,6 @@ import Control.Monad.IO.Class (liftIO)
 
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
 import qualified Data.Text.Encoding as TE
 import Data.String (fromString)
 
@@ -41,6 +40,8 @@ import Model.Message
 
 import View.Page (page)
 
+import Mail
+
 getIndexAction :: ActionM ()
 getIndexAction = html page
 
@@ -87,14 +88,22 @@ signInAction login =
         (Just _, Just host) -> do
           token <- liftIO . runDb $ createSignInToken login
           let url = T.concat ["http://", host ,"/validateSignIn?token=", token]
-          liftIO . TIO.putStrLn $ url
-          status ok200
-        _ -> do
-          status badRequest400
-          json (Message "You are not authorized to sign in.")
-    else do
-      status badRequest400
-      json (Message "Please enter a valid email address.")
+          let mail = Mail [login] "Sign in" url url
+          maybeSentMail <- liftIO . sendMail $ mail
+          case maybeSentMail of
+            Right _ ->
+              status ok200
+            Left _ ->
+              errorResponse "Sorry, we failed to send you the sign up email."
+        _ ->
+          errorResponse "You are not authorized to sign in."
+    else
+      errorResponse "Please enter a valid email address."
+
+errorResponse :: Text -> ActionM ()
+errorResponse message = do
+  status badRequest400
+  json (Message message)
 
 validateSignInAction :: Text -> ActionM ()
 validateSignInAction token = do
-- 
cgit v1.2.3