From a11ad41b52ed3682d33382f2a378bf3294d688b2 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 23 Mar 2016 00:45:33 +0100
Subject: Sign in token link to /

---
 src/server/Controller/SignIn.hs | 21 ++++++++-------------
 1 file changed, 8 insertions(+), 13 deletions(-)

(limited to 'src/server/Controller/SignIn.hs')

diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 0153784..b87f7a1 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -9,7 +9,7 @@ import Web.Scotty
 
 import Network.HTTP.Types.Status (ok200, badRequest400)
 
-import Database.Persist
+import Database.Persist hiding (Key)
 
 import Control.Monad.IO.Class (liftIO)
 
@@ -32,7 +32,6 @@ import Model.Database
 import Model.User
 import Model.SignIn
 import Model.Message.Key
-import Model.Message (getMessage)
 
 import Secure (getUserFromToken)
 
@@ -46,7 +45,7 @@ signIn conf login =
       case maybeUser of
         Just user -> do
           token <- liftIO . runDb $ createSignInToken login
-          let url = T.concat ["http://", hostname conf, "/validateSignIn?token=", token]
+          let url = T.concat ["http://", hostname conf, "?signInToken=", token]
           maybeSentMail <- liftIO . sendMail $ SignIn.getMail (entityVal user) url [login]
           case maybeSentMail of
             Right _ ->
@@ -61,12 +60,12 @@ signIn conf login =
       status badRequest400
       text . TL.pack . show $ EnterValidEmail
 
-validateSignIn :: Conf -> Text -> ActionM ()
+validateSignIn :: Conf -> Text -> ActionM (Either Key ())
 validateSignIn conf textToken = do
   alreadySigned <- isAlreadySigned
   if alreadySigned
     then
-      redirect "/"
+      return . Right $ ()
     else do
       mbSignIn <- liftIO . runDb $ getSignIn textToken
       now <- liftIO getCurrentTime
@@ -74,18 +73,18 @@ validateSignIn conf textToken = do
         Just signInValue ->
           if signInIsUsed . entityVal $ signInValue
             then
-              redirectError (getMessage SignInUsed)
+              return . Left $ SignInUsed
             else
               let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signInValue)
               in  if diffTime > (fromIntegral $ (signInExpirationMn conf) * 60)
                     then
-                      redirectError (getMessage SignInExpired)
+                      return . Left $ SignInExpired
                     else do
                       LoginSession.put (signInToken . entityVal $ signInValue)
                       liftIO . runDb . signInTokenToUsed . entityKey $ signInValue
-                      redirect "/"
+                      return . Right $ ()
         Nothing ->
-          redirectError (getMessage SignInInvalid)
+          return . Left $ SignInInvalid
 
 isAlreadySigned :: ActionM Bool
 isAlreadySigned = do
@@ -95,7 +94,3 @@ isAlreadySigned = do
       return False
     Just token -> do
       liftIO . runDb . fmap isJust $ getUserFromToken token
-
-redirectError :: Text -> ActionM ()
-redirectError msg =
-  redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg]
-- 
cgit v1.2.3