blob: f29a97a0b0115e6bedf0e8873a11a6d82708853f (
plain) (
blame)
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
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Endpoints.LoginEndpoint (LoginAPI, loginServer) where
import Servant
import Data.Aeson as A
import Database (runDb)
import Database.Persist
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Crypto.BCrypt (validatePassword)
import qualified Data.ByteString.Base16 as Base16
import Jose.Jws (hmacEncode)
import Jose.Jwa (JwsAlg(HS256))
import Jose.Jwt (Jwt (Jwt))
import Data.ByteString.Lazy as BL
import Model.Login
import Model.MatrixErrorResponse
import Data.User
import Model.AuthenticationHolder (AuthenticationHolder (AuthenticationHolder), server_password)
----------------------------------------------------------------------------------------------------
type LoginAPI = GetLogin :<|> PostLogin
loginServer :: Server LoginAPI
loginServer = handleLoginGet :<|> handleLoginPost
--- GET /_matrix/client/v3/login -------------------------------------------------------------------
type GetLogin = "_matrix" :> "client" :> "v3" :> "login"
:> Get '[JSON] LoginFlowsResponse
handleLoginGet :: Handler LoginFlowsResponse
handleLoginGet = return $ LoginFlowsResponse [LoginFlow "m.login.password"]
--- POST /_matrix/client/v3/login ------------------------------------------------------------------
type PostLogin = "_matrix" :> "client" :> "v3" :> "login" :> ReqBody '[JSON] LoginRequest
:> Post '[JSON] LoginResponse
handleLoginPost :: LoginRequest -> Handler LoginResponse
handleLoginPost req = do
let
input_password = password req
username = user $ identifier req
auth_holder = AuthenticationHolder username "DUMMY" Nothing
let either_token = hmacEncode HS256 server_password (BL.toStrict $ A.encode $ auth_holder)
case either_token of
Right (Jwt token) -> do
maybe_db_user <- liftIO $ runDb $ getBy $ UniqueName $ username
case maybe_db_user of
Just (Entity _ db_user) -> do
let either_hashed_password = Base16.decode $ T.encodeUtf8 $ userPassword db_user
case either_hashed_password of
Right hashedPasswordBytes ->
if validatePassword hashedPasswordBytes (T.encodeUtf8 input_password)
then return $ LoginResponse
{ user_id = T.concat ["@", username, ":localhost"]
, access_token = T.decodeUtf8 token
, home_server = "localhost"
, device_id = "DUMMY"
}
else throwError $ err403 { errBody = A.encode invalid_credentials_error }
_ -> throwError $ err500 { errBody = A.encode password_decoding_error }
_ -> throwError $ err403 { errBody = A.encode invalid_username_error }
_ -> throwError $ err403 { errBody = A.encode failed_token_generation }
where
invalid_username_error = MatrixErrorResponse "M_FORBIDDEN" "Invalid username"
password_decoding_error = MatrixErrorResponse "M_UNKNOWN" "Password hash decoding failed"
invalid_credentials_error = MatrixErrorResponse "M_FORBIDDEN" "Invalid username or password"
failed_token_generation = MatrixErrorResponse "M_UNKNOWN" "Access Token generation failed"
|