diff options
Diffstat (limited to 'src/Endpoints/LoginEndpoint.hs')
| -rw-r--r-- | src/Endpoints/LoginEndpoint.hs | 31 |
1 files changed, 19 insertions, 12 deletions
diff --git a/src/Endpoints/LoginEndpoint.hs b/src/Endpoints/LoginEndpoint.hs index f7edc3d..4b20b1e 100644 --- a/src/Endpoints/LoginEndpoint.hs +++ b/src/Endpoints/LoginEndpoint.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} @@ -28,6 +27,7 @@ import Control.Monad.IO.Class (MonadIO(..), liftIO) import Model.Login import Model.MatrixErrorResponse import Data.User +import Data.Device import Model.AuthenticationHolder (AuthenticationHolder (AuthenticationHolder), server_password) ---------------------------------------------------------------------------------------------------- @@ -47,18 +47,23 @@ handleLoginGet = return $ LoginFlowsResponse [LoginFlow "m.login.password"] type PostLogin = "_matrix" :> "client" :> "v3" :> "login" :> ReqBody '[JSON] LoginRequest :> Post '[JSON] LoginResponse -handleLoginPost :: LoginRequest -> Handler LoginResponse -handleLoginPost LoginRequest { device_id = maybe_device_id, password = input_password, identifier } = do - safe_device_id <- getDeviceId maybe_device_id +handleLoginPost :: LoginRequest -> Handler LoginResponse -- TODO: Let DB create device_id/primarykey? +handleLoginPost LoginRequest { + device_id = maybe_device_id, + password = input_password, + initial_device_display_name = maybe_device_name, + identifier +} = do + resolved_device_id <- resolveDeviceId maybe_device_id let username = user identifier - auth_holder = AuthenticationHolder username safe_device_id Nothing - either_token = hmacEncode HS256 server_password (BL.toStrict $ A.encode $ auth_holder) + auth_holder = AuthenticationHolder username resolved_device_id Nothing + 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 + maybe_db_user <- liftIO $ runDb $ getBy $ UniqueName username case maybe_db_user of Just (Entity _ db_user) -> do @@ -71,7 +76,7 @@ handleLoginPost LoginRequest { device_id = maybe_device_id, password = input_pas { user_id = T.concat ["@", username, ":localhost"] , access_token = T.decodeUtf8 token , home_server = "localhost" - , device_id = safe_device_id + , device_id = resolved_device_id } else throwError $ err403 { errBody = A.encode invalid_credentials_error } _ -> throwError $ err500 { errBody = A.encode password_decoding_error } @@ -83,13 +88,15 @@ handleLoginPost LoginRequest { device_id = maybe_device_id, password = input_pas invalid_credentials_error = MatrixErrorResponse "M_FORBIDDEN" "Invalid username or password" failed_token_generation = MatrixErrorResponse "M_UNKNOWN" "Access Token generation failed" - getDeviceId :: MonadIO m => Maybe T.Text -> m T.Text - getDeviceId mDeviceId = case mDeviceId of + resolveDeviceId :: MonadIO m => Maybe T.Text -> m T.Text + resolveDeviceId device_id = case device_id of Just did -> pure did - Nothing -> liftIO generateDeviceId + Nothing -> liftIO $ generateDeviceId generateDeviceId :: IO T.Text generateDeviceId = do bytes <- getRandomBytes 12 let encoded = BURL.encode bytes - pure $ T.pack $ UTF8.toString $ B.take 16 encoded
\ No newline at end of file + let generated_id = T.pack $ UTF8.toString $ B.take 16 encoded + _ <- liftIO $ runDb $ insert $ Device generated_id maybe_device_name + pure generated_id |