From a4f60df0f3b72553380bdd3ca960abf42048ed7e Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sat, 8 Aug 2015 19:50:58 +0200
Subject: Getting the hostname and the port in config file

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

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

diff --git a/src/server/Application.hs b/src/server/Application.hs
index 59aa252..5306e17 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -17,7 +17,6 @@ module Application
 import Web.Scotty
 
 import Network.HTTP.Types.Status (ok200, badRequest400)
-import Network.Wai (requestHeaderHost)
 
 import Database.Persist
 
@@ -29,6 +28,7 @@ import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Encoding as TE
 import Data.String (fromString)
 import Data.Time.Clock (getCurrentTime, diffUTCTime)
+import Data.Maybe (isJust)
 
 import Text.Email.Validate (isValid)
 
@@ -42,20 +42,21 @@ import Model.Payment
 import Model.SignIn
 import Model.Message
 
+import Config
+
 import View.Page (page)
 
 import Mail
 
-signInAction :: Text -> ActionM ()
-signInAction login =
+signInAction :: Config -> Text -> ActionM ()
+signInAction config 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
+      if isJust maybeUser
+        then do
           token <- liftIO . runDb $ createSignInToken login
-          let url = T.concat ["http://", host ,"/validateSignIn?token=", token]
+          let url = T.concat ["http://", hostname config, "/validateSignIn?token=", token]
           let mail = Mail [login] "Sign in" url url
           maybeSentMail <- liftIO . sendMail $ mail
           case maybeSentMail of
@@ -63,8 +64,8 @@ signInAction login =
               status ok200
             Left _ ->
               errorResponse "Sorry, we failed to send you the sign up email."
-        _ ->
-          errorResponse "You are not authorized to sign in."
+        else
+            errorResponse "You are not authorized to sign in."
     else
       errorResponse "Please enter a valid email address."
 
-- 
cgit v1.2.3