From 331d506281760ac62e8f1715ef729e1b2a91e280 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sun, 19 Jul 2015 17:28:19 +0200
Subject: Showing either error or success message at sign in page

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

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

diff --git a/src/server/Application.hs b/src/server/Application.hs
index 75d0323..6a18102 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -15,6 +15,7 @@ module Application
 import Web.Scotty
 
 import Network.HTTP.Types.Status (ok200, badRequest400)
+import Network.Wai (requestHeaderHost)
 
 import Database.Persist
 
@@ -23,8 +24,11 @@ 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)
 
+import Text.Email.Validate (isValid)
+
 import qualified LoginSession
 
 import qualified Secure
@@ -33,6 +37,7 @@ import Model.Database
 import Model.User
 import Model.Payment
 import Model.SignIn
+import Model.Message
 
 import View.Page (page)
 
@@ -73,16 +78,23 @@ createPaymentAction email name cost = do
       status ok200
 
 signInAction :: Text -> ActionM ()
-signInAction login = do
-  maybeUser <- liftIO . runDb $ getUser login
-  case maybeUser of
-    Just _ -> do
-      token <- liftIO . runDb $ createSignInToken login
-      let url = T.concat ["http://localhost:3000/validateSignIn?token=", token]
-      liftIO . TIO.putStrLn $ url
-      status ok200
-    Nothing ->
+signInAction login =
+  if isValid (TE.encodeUtf8 login)
+    then do
+      maybeUser <- liftIO . runDb $ getUser login
+      maybeHost <- fmap TE.decodeUtf8 . requestHeaderHost <$> request
+      case (maybeUser, maybeHost) of
+        (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.")
 
 validateSignInAction :: Text -> ActionM ()
 validateSignInAction token = do
-- 
cgit v1.2.3