aboutsummaryrefslogtreecommitdiff
path: root/src/Endpoints/LoginEndpoint.hs
blob: cca10d4277042d4e60ff7b33a131e2f75373f932 (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
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module Endpoints.LoginEndpoint (LoginAPI, loginServer) where

import Servant
import Data.Aeson
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 Model.Login
import Model.MatrixErrorResponse
import Data.User

----------------------------------------------------------------------------------------------------
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

  maybe_user <- liftIO $ runDb $ getBy $ UniqueName $ username

  case maybe_user of
    Just (Entity _ db_user) -> do
      case Base16.decode $ T.encodeUtf8 $ userPassword db_user of
        Right hashedPasswordBytes -> 
          if validatePassword hashedPasswordBytes (T.encodeUtf8 input_password)
            then return $ LoginResponse
              { user_id      = T.concat ["@", username, ":localhost"]
              , access_token = T.concat ["dummy", username]
              , home_server  = "localhost"
              , device_id    = "DUMMY"
              }
            else throwError $ err403 { errBody = encode invalid_credentials_error }
        Left _ -> throwError $ err500 { errBody = encode password_decoding_error }
    _ -> throwError $ err403 { errBody = encode invalid_username_error }
  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"