From a0886694f73fc382d78da79ab8bfb27475757bab Mon Sep 17 00:00:00 2001 From: adambrangenberg Date: Wed, 24 Dec 2025 03:40:10 +0100 Subject: Implemented basic auth, refactor --- src/Data/ContactData.hs | 22 ---------------------- src/Data/StandardErrorResponseData.hs | 18 ------------------ src/Data/User.hs | 33 +++++++++++++++++++++++++++++++++ src/Data/VersionsData.hs | 17 ----------------- src/Data/WellKnownClientData.hs | 34 ---------------------------------- src/Data/WellKnownSupportData.hs | 21 --------------------- 6 files changed, 33 insertions(+), 112 deletions(-) delete mode 100644 src/Data/ContactData.hs delete mode 100644 src/Data/StandardErrorResponseData.hs create mode 100644 src/Data/User.hs delete mode 100644 src/Data/VersionsData.hs delete mode 100644 src/Data/WellKnownClientData.hs delete mode 100644 src/Data/WellKnownSupportData.hs (limited to 'src/Data') diff --git a/src/Data/ContactData.hs b/src/Data/ContactData.hs deleted file mode 100644 index 397c465..0000000 --- a/src/Data/ContactData.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Data.ContactData (Contact, makeContact) where - -import Data.Aeson -import Data.Aeson.TH -import GHC.Generics (Generic) - -type EMail = String -type MXID = String - -data Contact = Contact - { email_address :: EMail - , matrix_id :: MXID - , role :: String -- Enum? [m.role.admin, m.role.security] - } deriving (Eq, Show, Generic) - -instance FromJSON Contact where -instance ToJSON Contact where - -makeContact :: String -> String -> String -> Contact -makeContact = Contact diff --git a/src/Data/StandardErrorResponseData.hs b/src/Data/StandardErrorResponseData.hs deleted file mode 100644 index f6fda87..0000000 --- a/src/Data/StandardErrorResponseData.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Data.StandardErrorResponseData (StandardErrorResponse, makeStandardErrorResponse) where - -import Data.Aeson -import Data.Aeson.TH -import GHC.Generics (Generic) - -data StandardErrorResponse = StandardErrorResponse - { errcode :: String -- TODO: Enum? - , error :: String - } deriving (Eq, Show, Generic) - -instance FromJSON StandardErrorResponse where -instance ToJSON StandardErrorResponse where - -makeStandardErrorResponse :: String -> String -> StandardErrorResponse -makeStandardErrorResponse = StandardErrorResponse diff --git a/src/Data/User.hs b/src/Data/User.hs new file mode 100644 index 0000000..9064d36 --- /dev/null +++ b/src/Data/User.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} + + +module Data.User where + +import Database.Persist.TH +import Data.Text + +---------------------------------------------------------------------------------------------------- +share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| +User + ident Text + password Text + displayName Text Maybe -- Figure snake_case out + avatarUrl Text Maybe -- Figure snake_case out + UniqueName ident + deriving Show +|] diff --git a/src/Data/VersionsData.hs b/src/Data/VersionsData.hs deleted file mode 100644 index fe41763..0000000 --- a/src/Data/VersionsData.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Data.VersionsData (Versions, makeVersions) where - -import Data.Aeson -import Data.Aeson.TH -import GHC.Generics (Generic) - -data Versions = Versions -- unstable_features missing - { versions :: [String] - } deriving (Eq, Show, Generic) - -instance FromJSON Versions where -instance ToJSON Versions where - -makeVersions :: [String] -> Versions -makeVersions = Versions diff --git a/src/Data/WellKnownClientData.hs b/src/Data/WellKnownClientData.hs deleted file mode 100644 index 310002d..0000000 --- a/src/Data/WellKnownClientData.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Data.WellKnownClientData (WellKnownClient, makeWellKnownClient) where - -import Data.Aeson -import Data.Aeson.TH -import GHC.Generics (Generic) - -data BaseUrlHolder = BaseUrlHolder - { base_url :: String - } deriving (Eq, Show, Generic) - -instance FromJSON BaseUrlHolder where -instance ToJSON BaseUrlHolder where - -data WellKnownClient = WellKnownClient - { homeserver :: BaseUrlHolder - , identity_server :: BaseUrlHolder - } deriving (Eq, Show, Generic) - -fieldMapping :: String -> String -fieldMapping "homeserver" = "m.homeserver" -fieldMapping "identity_server" = "m.identity_server" -fieldMapping name = name - -instance FromJSON WellKnownClient where - parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = fieldMapping } - -instance ToJSON WellKnownClient where - toJSON = genericToJSON defaultOptions { fieldLabelModifier = fieldMapping } - -makeWellKnownClient :: String -> String -> WellKnownClient -makeWellKnownClient homeserver identity_server = - WellKnownClient (BaseUrlHolder homeserver) (BaseUrlHolder identity_server) diff --git a/src/Data/WellKnownSupportData.hs b/src/Data/WellKnownSupportData.hs deleted file mode 100644 index 94e434c..0000000 --- a/src/Data/WellKnownSupportData.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Data.WellKnownSupportData (WellKnownSupport, makeWellKnownSupport) where - -import Data.Aeson -import Data.Aeson.TH -import GHC.Generics (Generic) -import Data.ContactData - -type URI = String - -data WellKnownSupport = WellKnownSupport - { contacts :: [Contact] - , support_page :: URI - } deriving (Eq, Show, Generic) - -instance FromJSON WellKnownSupport where -instance ToJSON WellKnownSupport where - -makeWellKnownSupport :: [Contact] -> URI -> WellKnownSupport -makeWellKnownSupport = WellKnownSupport -- cgit v1.2.3