Add actual access tokens through JWT

1 files changed, 31 insertions, 17 deletions

diff --git a/src/Endpoints/LoginEndpoint.hs b/src/Endpoints/LoginEndpoint.hs
index cca10d4..f29a97a 100644
--- a/src/Endpoints/LoginEndpoint.hs
+++ b/src/Endpoints/LoginEndpoint.hs
@@ -6,7 +6,7 @@
 module Endpoints.LoginEndpoint (LoginAPI, loginServer) where
 
 import Servant
-import Data.Aeson
+import Data.Aeson as A
 import Database (runDb)
 import Database.Persist
 import Control.Monad.IO.Class (liftIO)
@@ -14,10 +14,15 @@ 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
@@ -41,24 +46,33 @@ handleLoginPost req = do
   let
     input_password = password req
     username = user $ identifier req
+    auth_holder = AuthenticationHolder username "DUMMY" Nothing
 
-  maybe_user <- liftIO $ runDb $ getBy $ UniqueName $ username
+  let either_token = hmacEncode HS256 server_password (BL.toStrict $ A.encode $ auth_holder)
 
-  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 }
+  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"
\ No newline at end of file
+    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