login works, ig. Will remake everything now

4 files changed, 363 insertions, 0 deletions

diff --git a/src/Lib.hs b/src/Lib.hs
new file mode 100644
index 0000000..ed1d92d
--- /dev/null
+++ b/src/Lib.hs
@@ -0,0 +1,323 @@
+{-# LANGUAGE DataKinds       #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators   #-}
+{-# LANGUAGE OverloadedLabels #-}
+
+module Lib
+    ( 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) -- ⚠️ This is the key import!
+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)
+
+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")
diff --git a/src/PostLoginsResponseLib.hs b/src/PostLoginsResponseLib.hs
new file mode 100644
index 0000000..51617b1
--- /dev/null
+++ b/src/PostLoginsResponseLib.hs
@@ -0,0 +1,10 @@
+module PostLoginsResponseLib (PostLoginsResponse, makePostLoginsResponse) where
+
+data PostLoginsResponse = PostLoginsResponse
+  { access_token :: String
+      , device_id :: String
+      , user_id :: String
+  } deriving (Eq, Show)
+
+makePostLoginsResponse :: String -> String -> String -> PostLoginsResponse
+makePostLoginsResponse = PostLoginsResponse
diff --git a/src/QueryUserLib.hs b/src/QueryUserLib.hs
new file mode 100644
index 0000000..5677ac5
--- /dev/null
+++ b/src/QueryUserLib.hs
@@ -0,0 +1,11 @@
+module QueryUserLib (QueryUser, makeQueryUser) where
+
+data QueryUser = QueryUser
+  { localpart :: String
+      , user_id :: String
+      , display_name :: String
+      , is_guest :: Bool
+  } deriving (Eq, Show)
+
+makeQueryUser :: String -> String -> String -> Bool -> QueryUser
+makeQueryUser = QueryUser
diff --git a/src/RenameUtils.hs b/src/RenameUtils.hs
new file mode 100644
index 0000000..cdf36d2
--- /dev/null
+++ b/src/RenameUtils.hs
@@ -0,0 +1,19 @@
+module RenameUtils where
+
+import Data.List.Utils (startswith, replace)
+
+typeFieldModifier :: String -> String
+typeFieldModifier "type__" = "type"
+typeFieldModifier "type___" = "type"
+typeFieldModifier name = name
+
+dotFieldModifier :: String -> String
+dotFieldModifier = replace "__" "."
+
+replaceUsername :: String -> String
+replaceUsername "username" = "@username:localhost:8080"
+replaceUsername name = name
+
+replaceRoomId :: String -> String
+replaceRoomId "slay" = "!slay:localhost:8080"
+replaceRoomId name = name