blob: 4f4ae77f398a765823a4a3bda7e15476b4e4a23f (
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
|
module Controller.Index
( get
, signIn
, signOut
) where
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import Data.Validation (Validation (..))
import qualified Network.HTTP.Types.Status as Status
import Prelude hiding (error, init)
import Web.Scotty (ActionM)
import qualified Web.Scotty as S
import Common.Model (Init (..), SignInForm (..),
User (..))
import qualified Common.Msg as Msg
import Conf (Conf (..))
import qualified LoginSession
import Model.Query (Query)
import qualified Model.Query as Query
import Model.SignIn (SignIn (..))
import qualified Persistence.User as UserPersistence
import qualified Validation.SignIn as SignInValidation
import View.Page (page)
get :: Conf -> ActionM ()
get conf = do
init <- do
mbToken <- LoginSession.get
case mbToken of
Nothing ->
return Nothing
Just token -> do
liftIO . Query.run $ getInit conf token
S.html $ page init
signIn :: Conf -> SignInForm -> ActionM ()
signIn conf form =
case SignInValidation.signIn form of
Failure _ ->
textKey Status.badRequest400 Msg.SignIn_InvalidCredentials
Success (SignIn email password) -> do
result <- liftIO . Query.run $ do
isPasswordValid <- UserPersistence.checkPassword email password
if isPasswordValid then
do
signInToken <- UserPersistence.createSignInToken email
init <- getInit conf signInToken
return $ Just (signInToken, init)
else
return Nothing
case result of
Just (signInToken, init) -> do
LoginSession.put conf signInToken
S.json init
Nothing ->
textKey Status.badRequest400 Msg.SignIn_InvalidCredentials
where textKey st key = S.status st >> (S.text . TL.fromStrict $ Msg.get key)
getInit :: Conf -> Text -> Query (Maybe Init)
getInit conf signInToken = do
user <- UserPersistence.get signInToken
case user of
Just u ->
do
users <- UserPersistence.list
return . Just $ Init users (_user_id u) (Conf.currency conf)
Nothing ->
return Nothing
signOut :: Conf -> ActionM ()
signOut conf = LoginSession.delete conf >> S.status Status.ok200
|
