implemented section 1-3

1 files changed, 8 insertions, 297 deletions

diff --git a/src/Lib.hs b/src/Lib.hs
index bb2c104..d430d9c 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeOperators   #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 
 module Lib
     ( startApp
@@ -10,314 +11,24 @@ module Lib
     , type (:<|>)
     ) where
 
-import Data.Aeson
-import Data.Aeson.TH
+-- Servant
 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
+-- Utils
+import Cors
 
-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
+-- Endpoints
+import Endpoints.APILib
+import Endpoints.ServerLib
 
 startApp :: IO ()
 startApp = run 8080 (logStdoutDev app)
 
 app :: Application
-app = serve api server
+app = corsMiddleware $ 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")