From a0886694f73fc382d78da79ab8bfb27475757bab Mon Sep 17 00:00:00 2001
From: adambrangenberg <adabran06@gmail.com>
Date: Wed, 24 Dec 2025 03:40:10 +0100
Subject: Implemented basic auth, refactor

---
 src/Model/Authentication.hs      | 12 +++++++++
 src/Model/Login.hs               | 58 ++++++++++++++++++++++++++++++++++++++++
 src/Model/MatrixErrorResponse.hs | 20 ++++++++++++++
 src/Model/Profile.hs             | 26 ++++++++++++++++++
 src/Model/Versions.hs            | 15 +++++++++++
 src/Model/WellKnown.hs           | 51 +++++++++++++++++++++++++++++++++++
 6 files changed, 182 insertions(+)
 create mode 100644 src/Model/Authentication.hs
 create mode 100644 src/Model/Login.hs
 create mode 100644 src/Model/MatrixErrorResponse.hs
 create mode 100644 src/Model/Profile.hs
 create mode 100644 src/Model/Versions.hs
 create mode 100644 src/Model/WellKnown.hs

(limited to 'src/Model')

diff --git a/src/Model/Authentication.hs b/src/Model/Authentication.hs
new file mode 100644
index 0000000..be1337a
--- /dev/null
+++ b/src/Model/Authentication.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Authentication (AuthenticationResponse (..)) where
+
+import GHC.Generics
+import Data.Text (Text)
+
+----------------------------------------------------------------------------------------------------
+data AuthenticationResponse = AuthenticationResponse -- delete?
+  { userId :: Text
+  }
+  deriving (Show, Eq, Generic)
diff --git a/src/Model/Login.hs b/src/Model/Login.hs
new file mode 100644
index 0000000..0fbb2fa
--- /dev/null
+++ b/src/Model/Login.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Model.Login (LoginRequest (..), LoginResponse (..), LoginFlowsResponse (..), LoginFlow (..), PasswordIdentifier (..)) where
+
+import Data.Aeson
+import GHC.Generics
+import Data.Text (Text)
+
+import Util (Normalisable(..))
+
+type UserId = Text
+
+----------------------------------------------------------------------------------------------------
+data PasswordIdentifier = PasswordIdentifier
+  { user :: UserId
+  }
+  deriving (Show, Eq, Generic)
+
+instance FromJSON PasswordIdentifier
+
+data LoginRequest = LoginRequest
+  { identifier :: PasswordIdentifier
+  , password :: Text
+  , type' :: Text
+  }
+  deriving (Show, Eq, Generic)
+
+instance FromJSON LoginRequest where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = normaliseVariant }
+
+----------------------------------------------------------------------------------------------------
+data LoginResponse = LoginResponse
+  { user_id :: UserId
+  , access_token :: Text
+  , home_server :: Text
+  , device_id :: Text
+  }
+  deriving (Show, Eq, Generic)
+
+instance ToJSON LoginResponse
+
+----------------------------------------------------------------------------------------------------
+newtype LoginFlowsResponse = LoginFlowsResponse
+  { flows :: [LoginFlow] -- TODO: Enum?
+  }
+  deriving (Show, Eq, Generic)
+
+instance ToJSON LoginFlowsResponse
+
+newtype LoginFlow = LoginFlow -- TODO: Maybe type LoginFlow = ... easier?
+  { type' :: Text
+  }
+  deriving (Show, Eq, Generic)
+
+instance ToJSON LoginFlow where
+  toJSON (LoginFlow t) = object ["type" .= t]
diff --git a/src/Model/MatrixErrorResponse.hs b/src/Model/MatrixErrorResponse.hs
new file mode 100644
index 0000000..22f5ae5
--- /dev/null
+++ b/src/Model/MatrixErrorResponse.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.MatrixErrorResponse (MatrixErrorResponse (..)) where
+
+import Data.Aeson
+import GHC.Generics (Generic)
+import Data.Text (Text)
+
+----------------------------------------------------------------------------------------------------
+data MatrixErrorResponse = MatrixErrorResponse
+  { error_code :: Text -- TODO: Enum?
+  , error :: Text
+  } deriving (Eq, Show, Generic)
+
+instance ToJSON MatrixErrorResponse where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = \name ->
+      case name of
+        "error_code" -> "errcode"
+        other -> other
+    }
diff --git a/src/Model/Profile.hs b/src/Model/Profile.hs
new file mode 100644
index 0000000..1a8f201
--- /dev/null
+++ b/src/Model/Profile.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Model.Profile (ProfileResponse (..)) where
+
+import Data.Aeson
+import GHC.Generics
+import Data.Text (Text)
+
+----------------------------------------------------------------------------------------------------
+data ProfileResponse = ProfileResponse
+  { display_name :: Maybe Text
+  , avatar_url  :: Maybe Text
+  , tz :: Maybe Text
+  -- TODO: <other properties>
+  } deriving (Show, Eq, Generic)
+
+instance ToJSON ProfileResponse where
+  toJSON = genericToJSON defaultOptions
+    { fieldLabelModifier = \name ->
+        case name of
+          "display_name" -> "displayname"
+          "tz" -> "m.tz"
+          other -> other
+    , omitNothingFields = True
+    }
diff --git a/src/Model/Versions.hs b/src/Model/Versions.hs
new file mode 100644
index 0000000..478d5f3
--- /dev/null
+++ b/src/Model/Versions.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Versions (VersionsResponse (..)) where
+
+import Data.Aeson
+import GHC.Generics (Generic)
+import Data.Text (Text)
+
+----------------------------------------------------------------------------------------------------
+
+data VersionsResponse = VersionsResponse -- TODO: <unstable features>
+  { versions :: [Text]
+  } deriving (Eq, Show, Generic)
+
+instance ToJSON VersionsResponse where
diff --git a/src/Model/WellKnown.hs b/src/Model/WellKnown.hs
new file mode 100644
index 0000000..066c9e3
--- /dev/null
+++ b/src/Model/WellKnown.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.WellKnown (WellKnownClientResponse (..)
+                       , BaseUrlHolder (..)
+                       , WellKnownSupportResponse (..)
+                       , Contact (..)
+                       ) where
+
+import Data.Aeson
+import GHC.Generics (Generic)
+import Data.Text (Text)
+
+type URI = Text
+type EMail = Text
+type UserId = Text
+
+----------------------------------------------------------------------------------------------------
+data BaseUrlHolder = BaseUrlHolder
+  { base_url :: URI
+  } deriving (Eq, Show, Generic)
+
+instance ToJSON BaseUrlHolder where
+
+data WellKnownClientResponse = WellKnownClientResponse
+  { homeserver :: BaseUrlHolder
+  , identity_server :: BaseUrlHolder
+  } deriving (Eq, Show, Generic)
+
+instance ToJSON WellKnownClientResponse where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = \name ->
+      case name of
+        "homeserver" -> "m.homeserver"
+        "identity_server" -> "m.identity_server"
+        other -> other
+    }
+
+----------------------------------------------------------------------------------------------------
+data Contact = Contact
+  { email_address :: EMail
+  , matrix_id :: UserId
+  , role :: Text -- Enum? [m.role.admin, m.role.security]
+  } deriving (Eq, Show, Generic)
+
+instance ToJSON Contact where
+
+data WellKnownSupportResponse = WellKnownSupportResponse
+  { contacts :: [Contact]
+  , support_page :: URI
+  } deriving (Eq, Show, Generic)
+
+instance ToJSON WellKnownSupportResponse where
\ No newline at end of file
-- 
cgit v1.2.3