aboutsummaryrefslogtreecommitdiff
path: root/src/server/Controller/SignIn.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Controller/SignIn.hs')
-rw-r--r--src/server/Controller/SignIn.hs21
1 files changed, 8 insertions, 13 deletions
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]