blob: a46894a9aeff4a3196583b4995b9d3b02fdc6618 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
{-# LANGUAGE OverloadedStrings #-}
module Controller.SignIn
( signInAction
, validateSignInAction
) where
import Web.Scotty
import Network.HTTP.Types.Status (ok200, badRequest400)
import Database.Persist
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as TE
import Data.Time.Clock (getCurrentTime, diffUTCTime)
import qualified LoginSession
import Config
import SendMail
import Text.Email.Validate (isValid)
import Model.Database
import Model.User
import Model.SignIn
import Model.Message
import qualified View.Mail.SignIn as SignIn
signInAction :: Config -> Text -> ActionM ()
signInAction config login =
if isValid (TE.encodeUtf8 login)
then do
maybeUser <- liftIO . runDb $ getUser login
case maybeUser of
Just user -> do
token <- liftIO . runDb $ createSignInToken login
let url = T.concat ["http://", hostname config, "/validateSignIn?token=", token]
maybeSentMail <- liftIO . sendMail $ SignIn.getMail (entityVal user) url [login]
case maybeSentMail of
Right _ ->
status ok200
Left _ ->
errorResponse "Sorry, we failed to send you the sign up email."
Nothing ->
errorResponse "You are not authorized to sign in."
else
errorResponse "Please enter a valid email address."
errorResponse :: Text -> ActionM ()
errorResponse msg = do
status badRequest400
json (Message msg)
validateSignInAction :: Text -> ActionM ()
validateSignInAction token = do
maybeSignIn <- liftIO . runDb $ getSignInToken token
now <- liftIO getCurrentTime
case maybeSignIn of
Just signIn ->
if signInIsUsed . entityVal $ signIn
then
redirectError "The token has already been used."
else
let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn)
in if diffTime > 2 * 60 -- 2 minutes
then
redirectError "The token has expired."
else do
LoginSession.put (signInEmail . entityVal $ signIn)
liftIO . runDb . signInTokenToUsed . entityKey $ signIn
redirect "/"
Nothing ->
redirectError "The token is invalid."
redirectError :: Text -> ActionM ()
redirectError msg =
redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg]
|
