diff options
Diffstat (limited to 'src/Lib_old.hs')
| -rw-r--r-- | src/Lib_old.hs | 325 |
1 files changed, 0 insertions, 325 deletions
diff --git a/src/Lib_old.hs b/src/Lib_old.hs deleted file mode 100644 index 7dd1d1c..0000000 --- a/src/Lib_old.hs +++ /dev/null @@ -1,325 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# OPTIONS_GHC -Wno-all #-} - -module Lib_old - ( startApp - , app - , type (:>) -- Syntax for importing type operator - , type (:<|>) - ) where - -import Data.Aeson -import Data.Aeson.TH -import Network.Wai -import Network.Wai.Handler.Warp -import Network.Wai.Middleware.RequestLogger (logStdoutDev) -import Servant -import RenameUtils (typeFieldModifier, dotFieldModifier, replaceUsername, replaceRoomId) -import QueryUserLib -import PostLoginsResponseLib - -type JURI = String - -data EmptyObj = EmptyObj {} deriving (Eq, Show) - -$(deriveJSON defaultOptions ''EmptyObj) - -data UserInfo = UserInfo - { displayname :: String - , avatar_url :: String - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''UserInfo) - -data OAuth2InfoHolder = OAuth2InfoHolder - { issuer :: String - , account :: String - } deriving (Eq, Show) - -data BaseURLHolder = BaseURLHolder - { base_url :: JURI - } deriving (Eq, Show) - -data WellKnown = WellKnown - { m__homeserver :: BaseURLHolder - , m__identity_server :: BaseURLHolder - , org__matrix__msc2965__authentication :: OAuth2InfoHolder - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''BaseURLHolder) -$(deriveJSON defaultOptions ''OAuth2InfoHolder) -$(deriveJSON defaultOptions { fieldLabelModifier = dotFieldModifier } ''WellKnown) - -data Versions = Versions - { versions :: [String] - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''Versions) - -data LoginFlow = LoginFlow - { type__ :: String - } deriving (Eq, Show) - -data GetLoginsResponse = GetLoginsResponse - { flows :: [LoginFlow] - } deriving (Eq, Show) - -$(deriveJSON defaultOptions {fieldLabelModifier = typeFieldModifier} ''LoginFlow) -$(deriveJSON defaultOptions ''GetLoginsResponse) - -$(deriveJSON defaultOptions ''PostLoginsResponse) - -type UserId = String - -data RegisterResponse = RegisterResponse - { user_id :: UserId - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''RegisterResponse) - -data MASAviableable = MASAviableable - { available :: Bool - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''MASAviableable) - -data Synced = Synced - { synced :: Bool - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''Synced) - -$(deriveJSON defaultOptions ''QueryUser) - -data Rooms = Rooms - { join :: JoinedRooms - } deriving (Eq, Show) - -data JoinedRooms = JoinedRooms - {slay :: JoinedRoom - } deriving (Eq, Show) - -data JoinedRoom = JoinedRoom - { timeline :: Timeline - } deriving (Eq, Show) - -data Timeline = Timeline - { events :: [Message] - } deriving (Eq, Show) - -data Message = Message - { content :: TextMessageContent - , event_id :: String - , origin_server_ts :: String - , sender :: String - , type___ :: String - , state_key :: String - } deriving (Eq, Show) - -data TextMessageContent = TextMessageContent - { body :: String - -- , msgtype :: String - , creator :: String - , membership :: String - , join_rule :: String - } deriving (Eq, Show) - -data Sync = Sync - { next_batch :: String - , rooms :: Rooms - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''TextMessageContent) -$(deriveJSON defaultOptions { fieldLabelModifier = typeFieldModifier} ''Message) -$(deriveJSON defaultOptions ''Timeline) -$(deriveJSON defaultOptions ''JoinedRoom) -$(deriveJSON defaultOptions { fieldLabelModifier = replaceRoomId } ''JoinedRooms) -$(deriveJSON defaultOptions ''Rooms) -$(deriveJSON defaultOptions ''Sync) - -data Keys = Keys - { one_time_key_counts :: EmptyObj - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''Keys) --- ⚠️ This is the key import! -data KeysHolder = KeysHolder - { username :: [String] - } deriving (Eq, Show) - -data KeysQuery = KeysQuery - { device_keys :: KeysHolder - , master_keys :: EmptyObj - , self_signing_keys :: EmptyObj - , user_signing_keys :: EmptyObj - } deriving (Eq, Show) - -$(deriveJSON defaultOptions { fieldLabelModifier = replaceUsername } ''KeysHolder) -$(deriveJSON defaultOptions ''KeysQuery) - -data RoomId = RoomId - {room_id :: String - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''RoomId) - -data GetRooms = GetRooms - { chunk :: [Message] - , end :: String - , start :: String - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''GetRooms) - -type API = ".well-known" :> "matrix" :> "client" :> Get '[JSON] WellKnown - :<|> "_matrix" :> "client" :> "versions" :> Get '[JSON] Versions - :<|> "_matrix" :> "client" :> "v3" :> "login" :> Get '[JSON] GetLoginsResponse - :<|> "_matrix" :> "client" :> "r0" :> "login" :> Get '[JSON] GetLoginsResponse - :<|> "_matrix" :> "client" :> "v3" :> "login" :> Post '[JSON] PostLoginsResponse - :<|> "_matrix" :> "client" :> "r0" :> "login" :> Post '[JSON] PostLoginsResponse - :<|> "_matrix" :> "client" :> "v3" :> "register" :> Post '[JSON] RegisterResponse - :<|> "_synapse" :> "mas" :> "is_localpart_available" :> Get '[JSON] MASAviableable - :<|> "_synapse" :> "mas" :> "provision_user" :> Post '[JSON] RegisterResponse - :<|> "_synapse" :> "mas" :> "sync_devices" :> Post '[JSON] Synced - :<|> "_synapse" :> "mas" :> "query_user" :> Get '[JSON] QueryUser - :<|> "_matrix" :> "client" :> "v3" :> "profile" :> "@username:localhost:8080" :> Get '[JSON] UserInfo - :<|> "_matrix" :> "client" :> "r0" :> "profile" :> "@username:localhost:8080" :> Get '[JSON] UserInfo - :<|> "_matrix" :> "client" :> "v3" :> "sync" :> Get '[JSON] Sync - :<|> "_matrix" :> "client" :> "r0" :> "sync" :> Get '[JSON] Sync - :<|> "_matrix" :> "client" :> "v3" :> "keys" :> "query" :> Post '[JSON] Keys - :<|> "_matrix" :> "client" :> "r0" :> "keys" :> "query" :> Post '[JSON] Keys - :<|> "_matrix" :> "client" :> "v3" :> "keys" :> "upload" :> Post '[JSON] KeysQuery - :<|> "_matrix" :> "client" :> "r0" :> "keys" :> "upload" :> Post '[JSON] KeysQuery - :<|> "_matrix" :> "client" :> "v3" :> "createRoom" :> Post '[JSON] RoomId - :<|> "_matrix" :> "client" :> "r0" :> "createRoom" :> Post '[JSON] RoomId - :<|> "_matrix" :> "client" :> "v3" :> "rooms" :> "!slay:localhost:8080" :> "messages" :> Get '[JSON] GetRooms - :<|> "_matrix" :> "client" :> "r0" :> "rooms" :> "!slay:localhost:8080" :> "messages" :> Get '[JSON] GetRooms - :<|> "_matrix" :> "client" :> "v3" :> "rooms" :> "!slay:localhost:8080" :> "members" :> Get '[JSON] GetRooms - :<|> "_matrix" :> "client" :> "r0" :> "rooms" :> "!slay:localhost:8080" :> "members" :> Get '[JSON] GetRooms - -startApp :: IO () -startApp = run 8080 (logStdoutDev app) - -app :: Application -app = serve api server - -api :: Proxy API -api = Proxy - -server :: Server API -server = wellKnownSuccess - :<|> versionsSuccess - :<|> getLoginSuccess - :<|> getLoginSuccess - :<|> postLoginSuccess - :<|> postLoginSuccess - :<|> registerResponse - :<|> masLocalpartAviableable - :<|> masProvision - :<|> masSynced - :<|> masQueryUser - :<|> getProfile - :<|> getProfile - :<|> sync - :<|> sync - :<|> keys - :<|> keys - :<|> keysQuery - :<|> keysQuery - :<|> createRoom - :<|> createRoom - :<|> getRoomContent - :<|> getRoomContent - :<|> getRoomMembers - :<|> getRoomMembers - -wellKnownSuccess :: Handler WellKnown -wellKnownSuccess = return (WellKnown - (BaseURLHolder "http://localhost:8080") - (BaseURLHolder "https://vector.im") - (OAuth2InfoHolder "http://localhost:8000/" "http://localhost:8000/account/") - ) - -versionsSuccess :: Handler Versions -versionsSuccess = return (Versions ["1.10"]) - -getLoginSuccess :: Handler GetLoginsResponse -getLoginSuccess = return (GetLoginsResponse [LoginFlow "m.login.sso"]) - -postLoginSuccess :: Handler PostLoginsResponse -postLoginSuccess = return (makePostLoginsResponse "token" "tammy" "@username:localhost:8080") - -registerResponse :: Handler RegisterResponse -registerResponse = return (RegisterResponse "@username:localhost:8080") - -masLocalpartAviableable :: Handler MASAviableable -masLocalpartAviableable = return (MASAviableable True) - -masProvision :: Handler RegisterResponse -masProvision = return (RegisterResponse "@username:localhost:8080") - -masSynced :: Handler Synced -masSynced = return (Synced True) - -masQueryUser :: Handler QueryUser -masQueryUser = return (makeQueryUser "username" "@username:localhost:8080" "username" False) - -getProfile :: Handler UserInfo -getProfile = return (UserInfo "username" "mxc://matrix.org/SDGdghriugerRg") - -getMessageContentTempl :: String -> String -> String -> String -> Message -getMessageContentTempl msgtype eventId time state_key = (Message - ( - TextMessageContent - "Hiii" - -- "m.text" - "@username:localhost:8000" - "join" - "public" - ) - eventId - time - "@username:localhost:8000" - msgtype - state_key - ) - -messages :: [Message] -messages = [ - getMessageContentTempl "m.room.create" "$make" "1757771812" "", - -- getMessageContentTempl "m.room.join_rules", - getMessageContentTempl "m.room.member" "$join" "1757771814" "@username:localhost:8000" - -- getMessageContentTempl "m.room.message" "$msg" "1757771816" "" - ] - -sync :: Handler Sync -sync = return (Sync - "a" - (Rooms ( - JoinedRooms ( - JoinedRoom ( - Timeline messages - ) - ) - )) - ) - - -keys :: Handler Keys -keys = return (Keys EmptyObj) - -keysQuery :: Handler KeysQuery -keysQuery = return (KeysQuery (KeysHolder []) EmptyObj EmptyObj EmptyObj) - -createRoom :: Handler RoomId -createRoom = return (RoomId "!slay:localhost:8080") - -getRoomContent :: Handler GetRooms -getRoomContent = return (GetRooms messages "a" "a") - -getRoomMembers :: Handler GetRooms -getRoomMembers = return (GetRooms [getMessageContentTempl "m.room.member" "$join" "1757771814" "@username:localhost:8080"] "a" "a") |