1 files changed, 26 insertions, 9 deletions

diff --git a/src/Endpoints/LoginEndpoint.hs b/src/Endpoints/LoginEndpoint.hs
index f29a97a..f7edc3d 100644
--- a/src/Endpoints/LoginEndpoint.hs
+++ b/src/Endpoints/LoginEndpoint.hs
@@ -2,6 +2,8 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Endpoints.LoginEndpoint (LoginAPI, loginServer) where
 
@@ -9,7 +11,6 @@ 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)
@@ -18,6 +19,11 @@ import Jose.Jws (hmacEncode)
 import Jose.Jwa (JwsAlg(HS256))
 import Jose.Jwt (Jwt (Jwt))
 import Data.ByteString.Lazy as BL
+import Data.ByteString as B
+import Crypto.Random (getRandomBytes)
+import Data.ByteString.Base64.URL as BURL
+import qualified Data.ByteString.UTF8 as UTF8
+import Control.Monad.IO.Class (MonadIO(..), liftIO)
 
 import Model.Login
 import Model.MatrixErrorResponse
@@ -42,13 +48,13 @@ type PostLogin = "_matrix" :> "client" :> "v3" :> "login" :> ReqBody '[JSON] Log
                :> 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
+handleLoginPost LoginRequest { device_id = maybe_device_id, password = input_password, identifier } = do
+  safe_device_id <- getDeviceId maybe_device_id
 
-  let either_token = hmacEncode HS256 server_password (BL.toStrict $ A.encode $ auth_holder)
+  let
+    username = user identifier
+    auth_holder = AuthenticationHolder username safe_device_id Nothing
+    either_token = hmacEncode HS256 server_password (BL.toStrict $ A.encode $ auth_holder)
 
   case either_token of
     Right (Jwt token) -> do
@@ -65,7 +71,7 @@ handleLoginPost req = do
                   { user_id      = T.concat ["@", username, ":localhost"]
                   , access_token = T.decodeUtf8 token
                   , home_server  = "localhost"
-                  , device_id    = "DUMMY"
+                  , device_id    = safe_device_id
                   }
                 else throwError $ err403 { errBody = A.encode invalid_credentials_error }
             _ -> throwError $ err500 { errBody = A.encode password_decoding_error }
@@ -75,4 +81,15 @@ handleLoginPost req = do
     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"
\ No newline at end of file
+    failed_token_generation = MatrixErrorResponse "M_UNKNOWN" "Access Token generation failed"
+
+    getDeviceId :: MonadIO m => Maybe T.Text -> m T.Text
+    getDeviceId mDeviceId = case mDeviceId of
+      Just did -> pure did
+      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