{-# 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"