From 34cba7d0f9faffe7b97692ccc6b3402fced63cbb Mon Sep 17 00:00:00 2001 From: adambrangenberg Date: Wed, 24 Dec 2025 05:09:10 +0100 Subject: Refactor --- package.yaml | 1 + src/Endpoints/APILib.hs | 2 ++ src/Endpoints/LoginEndpoint.hs | 8 ++++---- src/Endpoints/ProfileEndpoint.hs | 6 +++--- src/Endpoints/ServerLib.hs | 2 ++ src/Endpoints/VersionsEndpoint.hs | 6 +++--- src/Endpoints/WellKnownEndpoint.hs | 10 +++++----- 7 files changed, 20 insertions(+), 15 deletions(-) diff --git a/package.yaml b/package.yaml index 576f609..82d8a40 100644 --- a/package.yaml +++ b/package.yaml @@ -38,6 +38,7 @@ dependencies: - mtl - bcrypt - base16-bytestring + - containers ghc-options: - -Wall diff --git a/src/Endpoints/APILib.hs b/src/Endpoints/APILib.hs index 1db3f47..2ceecd1 100644 --- a/src/Endpoints/APILib.hs +++ b/src/Endpoints/APILib.hs @@ -9,9 +9,11 @@ import Endpoints.WellKnownEndpoint import Endpoints.VersionsEndpoint import Endpoints.LoginEndpoint import Endpoints.ProfileEndpoint +import Endpoints.CapabilitiesEndpoint ---------------------------------------------------------------------------------------------------- type API = WellKnownAPI :<|> VersionsAPI :<|> LoginAPI :<|> ProfileAPI + :<|> CapabilitiesAPI diff --git a/src/Endpoints/LoginEndpoint.hs b/src/Endpoints/LoginEndpoint.hs index ad4a514..cca10d4 100644 --- a/src/Endpoints/LoginEndpoint.hs +++ b/src/Endpoints/LoginEndpoint.hs @@ -40,9 +40,9 @@ handleLoginPost :: LoginRequest -> Handler LoginResponse handleLoginPost req = do let input_password = password req - username = T.unpack $ user $ identifier req + username = user $ identifier req - maybe_user <- liftIO $ runDb $ getBy $ UniqueName $ T.pack username + maybe_user <- liftIO $ runDb $ getBy $ UniqueName $ username case maybe_user of Just (Entity _ db_user) -> do @@ -50,8 +50,8 @@ handleLoginPost req = do Right hashedPasswordBytes -> if validatePassword hashedPasswordBytes (T.encodeUtf8 input_password) then return $ LoginResponse - { user_id = T.pack ("@" ++ username ++ ":localhost") - , access_token = T.pack ("dummy" ++ username) + { user_id = T.concat ["@", username, ":localhost"] + , access_token = T.concat ["dummy", username] , home_server = "localhost" , device_id = "DUMMY" } diff --git a/src/Endpoints/ProfileEndpoint.hs b/src/Endpoints/ProfileEndpoint.hs index 8aaaa52..3b04a02 100644 --- a/src/Endpoints/ProfileEndpoint.hs +++ b/src/Endpoints/ProfileEndpoint.hs @@ -6,7 +6,7 @@ module Endpoints.ProfileEndpoint (ProfileAPI, profileServer) where import Servant import Data.Aeson -import Data.Text (Text, pack) +import Data.Text (Text) import qualified Data.Text as T import Database.Persist import Database (runDb) @@ -34,11 +34,11 @@ handleProfileGet user_id = do case maybe_user of Just (Entity _ db_user) -> return $ ProfileResponse - { display_name = (userDisplayName db_user) <> (Just $ userIdent $ db_user) + { display_name = (userDisplayName db_user) , avatar_url = userAvatarUrl db_user , tz = Nothing } Nothing -> throwError err404 { errBody = encode user_not_found_error } where - user_not_found_error = (MatrixErrorResponse (pack "M_NOT_FOUND") (pack "Profile not found")) \ No newline at end of file + user_not_found_error = (MatrixErrorResponse "M_NOT_FOUND" "Profile not found") \ No newline at end of file diff --git a/src/Endpoints/ServerLib.hs b/src/Endpoints/ServerLib.hs index 7bcf72a..b5e2b2b 100644 --- a/src/Endpoints/ServerLib.hs +++ b/src/Endpoints/ServerLib.hs @@ -9,6 +9,7 @@ import Endpoints.APILib import Endpoints.VersionsEndpoint import Endpoints.LoginEndpoint import Endpoints.ProfileEndpoint +import Endpoints.CapabilitiesEndpoint ---------------------------------------------------------------------------------------------------- server :: Server API @@ -16,3 +17,4 @@ server = wellKnownServer :<|> versionsServer :<|> loginServer :<|> profileServer + :<|> capabilitiesServer diff --git a/src/Endpoints/VersionsEndpoint.hs b/src/Endpoints/VersionsEndpoint.hs index e5739cf..73113a7 100644 --- a/src/Endpoints/VersionsEndpoint.hs +++ b/src/Endpoints/VersionsEndpoint.hs @@ -1,10 +1,10 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} module Endpoints.VersionsEndpoint (VersionsAPI, versionsServer) where import Servant -import Data.Text (pack) import Model.Versions @@ -13,10 +13,10 @@ type VersionsAPI = GetVersions versionsServer :: Server VersionsAPI versionsServer = handleVersionsGet --- http://localhost:8080 + --- GET /_matrix/client/versions ------------------------------------------------------------------- type GetVersions = "_matrix" :> "client" :> "versions" :> Get '[JSON] VersionsResponse handleVersionsGet :: Handler VersionsResponse -handleVersionsGet = return $ VersionsResponse [pack "v1.12"] +handleVersionsGet = return $ VersionsResponse ["v1.12"] diff --git a/src/Endpoints/WellKnownEndpoint.hs b/src/Endpoints/WellKnownEndpoint.hs index c63c5e5..7f0b451 100644 --- a/src/Endpoints/WellKnownEndpoint.hs +++ b/src/Endpoints/WellKnownEndpoint.hs @@ -1,10 +1,10 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} module Endpoints.WellKnownEndpoint (WellKnownAPI, wellKnownServer) where import Servant -import Data.Text (pack) import Model.WellKnown @@ -21,8 +21,8 @@ type GetWellKnownClient = ".well-known" :> "matrix" :> "client" handleWellKnownClientGet :: Handler WellKnownClientResponse handleWellKnownClientGet = return $ WellKnownClientResponse - { homeserver = BaseUrlHolder (pack "http://localhost:8080") - , identity_server = BaseUrlHolder (pack "https://vector.im") + { homeserver = BaseUrlHolder "http://localhost:8080" + , identity_server = BaseUrlHolder "https://vector.im" } --- GET /.well-known/matrix/support ---------------------------------------------------------------- @@ -31,7 +31,7 @@ type GetWellKnownSupport = ".well-known" :> "matrix" :> "support" handleWellKnownSupportGet :: Handler WellKnownSupportResponse handleWellKnownSupportGet = return $ WellKnownSupportResponse - { contacts = [Contact (pack "email") (pack "mxid") (pack "m.role.admin")] - , support_page = pack "http://localhost:8080/support.html" + { contacts = [Contact "email" "mxid" "m.role.admin"] + , support_page = "http://localhost:8080/support.html" } -- cgit v1.2.3