diff --git a/backend/jitsi-rooms.cabal b/backend/jitsi-rooms.cabal index 13ee870..e789efa 100644 --- a/backend/jitsi-rooms.cabal +++ b/backend/jitsi-rooms.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0. +-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack @@ -35,12 +35,10 @@ library Types.Participant Types.RoomData Types.RoomsState - Types.User Types.UsersData Types.WebEnv Types.WebSocketMessages.WebSocketMessages WebServer - WebSocket.AllChat WebSocket.Messages WebSocket.MonadWebSocketSession WebSocket.Server @@ -92,3 +90,4 @@ executable jitsi-rooms-exe , warp , websockets default-language: Haskell2010 + diff --git a/backend/package.yaml b/backend/package.yaml index d35a14c..2444dbe 100644 --- a/backend/package.yaml +++ b/backend/package.yaml @@ -58,4 +58,14 @@ executables: dependencies: - jitsi-rooms +tests: + jitsi-rooms-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - jitsi-rooms default-extensions: NoImplicitPrelude,OverloadedStrings,ImportQualifiedPost diff --git a/backend/src/BroadcastUserData.hs b/backend/src/BroadcastUserData.hs index bc00f48..b1a0a54 100644 --- a/backend/src/BroadcastUserData.hs +++ b/backend/src/BroadcastUserData.hs @@ -5,14 +5,15 @@ module BroadcastUserData ) where -import ClassyPrelude -import Data.Aeson (encode) -import Network.WebSockets qualified as WS -import State.ConnectedClientsState (MonadConnectedClientsRead (getConnctedClients)) -import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState)) -import Types.ConnectionState (Client (..), ConnectedClients) -import Types.User (User, clientToUser) -import Types.UsersData (UsersData (..)) +import ClassyPrelude +import Data.Aeson (encode) +import qualified Network.WebSockets as WS +import State.ConnectedClientsState (MonadConnectedClientsRead (getConnctedClients)) +import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState)) +import Types.AppTypes (HasConnectedClientState (..)) +import Types.ConnectionState (Client (..), ConnectedClients) +import Types.RoomsState (HasRoomsState (..)) +import Types.UsersData (UsersData (..)) class (Monad m, MonadConnectedClientsRead m) => MonadBroadcast m where broadCastToClients :: Text -> m () @@ -31,8 +32,8 @@ broadcastUserData = do getUsersWithoutRoom :: ( MonadConnectedClientsRead m ) => - m [User] -getUsersWithoutRoom = map clientToUser . filter (not . joinedRoom) <$> getConnctedClients + m [Text] +getUsersWithoutRoom = map name . filter (not . joinedRoom) <$> getConnctedClients broadCastToClientsGeneric :: ( MonadIO m, diff --git a/backend/src/Types/User.hs b/backend/src/Types/User.hs deleted file mode 100644 index f773587..0000000 --- a/backend/src/Types/User.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Types.User (User, clientToUser) where - -import ClassyPrelude -import Data.Aeson (FromJSON, ToJSON) -import Data.UUID (UUID) -import Types.ConnectionState qualified as C - -data User = User - { uuid :: UUID, - name :: Text - } - deriving (Generic, Show, Eq) - -clientToUser :: C.Client -> User -clientToUser C.Client {C.uuid = userUuid, C.name = userName, C.joinedRoom = _, C.conn = _} = User userUuid userName - -instance ToJSON User - -instance FromJSON User diff --git a/backend/src/Types/UsersData.hs b/backend/src/Types/UsersData.hs index fa8ad52..04ffe1a 100644 --- a/backend/src/Types/UsersData.hs +++ b/backend/src/Types/UsersData.hs @@ -5,17 +5,16 @@ module Types.UsersData ) where -import ClassyPrelude -import Data.Aeson (ToJSON) -import Types.RoomData (RoomsData) -import Types.User (User) +import ClassyPrelude +import Data.Aeson (ToJSON) +import Types.RoomData (RoomsData) data UsersData = UsersData - { roomsData :: RoomsData, + { roomsData :: RoomsData, usersWithOutRoom :: UsersWithoutRoom } deriving (Generic, Show) instance ToJSON UsersData -type UsersWithoutRoom = [User] +type UsersWithoutRoom = [Text] diff --git a/backend/src/Types/WebSocketMessages/WebSocketMessages.hs b/backend/src/Types/WebSocketMessages/WebSocketMessages.hs index 30049ba..9269cb2 100644 --- a/backend/src/Types/WebSocketMessages/WebSocketMessages.hs +++ b/backend/src/Types/WebSocketMessages/WebSocketMessages.hs @@ -1,12 +1,9 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DuplicateRecordFields #-} module Types.WebSocketMessages.WebSocketMessages ( WebSocketMessage (..), SetClientInfo (..), JoinRoom (..), - AllChatMessageIncoming (..), - AllChatMessageOutgoing (..), ) where @@ -15,13 +12,14 @@ import Data.Aeson ( FromJSON (parseJSON), Options (sumEncoding), SumEncoding (..), - ToJSON, + decode, defaultOptions, genericParseJSON, + withObject, + (.:), ) -import Types.User (User) -data WebSocketMessage = ClientInfoMessage SetClientInfo | JoinRoomMessage JoinRoom | AllChatMessageIncomingMessage AllChatMessageIncoming +data WebSocketMessage = ClientInfoMessage SetClientInfo | JoinRoomMessage JoinRoom deriving (Generic) instance FromJSON WebSocketMessage where @@ -40,18 +38,3 @@ data JoinRoom = JoinRoom deriving (Generic, Show) instance FromJSON JoinRoom - -data AllChatMessageIncoming = AllChatMessageIncoming - { content :: Text - } - deriving (Generic, Show) - -instance FromJSON AllChatMessageIncoming - -data AllChatMessageOutgoing = AllChatMessageOutgoing - { content :: Text, - sender :: User - } - deriving (Generic, Show) - -instance ToJSON AllChatMessageOutgoing diff --git a/backend/src/WebSocket/AllChat.hs b/backend/src/WebSocket/AllChat.hs deleted file mode 100644 index fce86ef..0000000 --- a/backend/src/WebSocket/AllChat.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - -module WebSocket.AllChat (broadCastAllChatMessage) where - -import BroadcastUserData (MonadBroadcast (..)) -import ClassyPrelude -import Data.Aeson (encode) -import Types.User (clientToUser) -import Types.WebSocketMessages.WebSocketMessages (AllChatMessageIncoming (..), AllChatMessageOutgoing (AllChatMessageOutgoing)) -import WebSocket.MonadWebSocketSession (MonadWebSocketSession (getClient)) - -broadCastAllChatMessage :: (MonadBroadcast m, MonadWebSocketSession m) => AllChatMessageIncoming -> m () -broadCastAllChatMessage AllChatMessageIncoming {content = message} = do - getClient >>= \case - Nothing -> return () - Just client -> do - let broadCastValue = AllChatMessageOutgoing message (clientToUser client) - broadCastToClients $ (decodeUtf8 . toStrict . encode) broadCastValue diff --git a/backend/src/WebSocket/MonadWebSocketSession.hs b/backend/src/WebSocket/MonadWebSocketSession.hs index 8ef1698..7893af5 100644 --- a/backend/src/WebSocket/MonadWebSocketSession.hs +++ b/backend/src/WebSocket/MonadWebSocketSession.hs @@ -15,7 +15,6 @@ import Data.Aeson import Data.UUID (UUID) import State.ConnectedClientsState ( MonadConnectedClientsModify, - MonadConnectedClientsRead (getConnctedClients), removeWSClient, ) import State.RoomDataState (MonadRoomDataStateRead) @@ -24,10 +23,9 @@ import Types.WebSocketMessages.WebSocketMessages (SetClientInfo (..)) import WebSocket.Messages import WebSocket.WSReaderTApp -class MonadConnectedClientsRead m => MonadWebSocketSession m where +class Monad m => MonadWebSocketSession m where getTypedWSMessage :: FromJSON a => m a getSesssionId :: m UUID - getClient :: m (Maybe Client) instance MonadWebSocketSession (WSApp WSEnv) where getTypedWSMessage = do @@ -38,9 +36,6 @@ instance MonadWebSocketSession (WSApp WSEnv) where sendMessage $ "Bad message: " <> pack err getTypedWSMessage getSesssionId = getClientId <$> ask - getClient = do - id' <- getSesssionId - find ((== id') . uuid) <$> getConnctedClients class (Monad m) => MonadWebSocketSessionInit m where newClient :: SetClientInfo -> m Client diff --git a/backend/src/WebSocket/WSApp.hs b/backend/src/WebSocket/WSApp.hs index aea7ad3..d2eb9f7 100644 --- a/backend/src/WebSocket/WSApp.hs +++ b/backend/src/WebSocket/WSApp.hs @@ -13,7 +13,6 @@ import Types.WebSocketMessages.WebSocketMessages ( SetClientInfo (displayName), WebSocketMessage (..), ) -import WebSocket.AllChat (broadCastAllChatMessage) import WebSocket.MonadWebSocketSession import WebSocket.WSReaderTApp @@ -36,8 +35,7 @@ wsApp = do handleWSAction :: ( MonadWebSocketSession m, - MonadConnectedClientsModify m, - MonadBroadcast m + MonadConnectedClientsModify m ) => m () handleWSAction = do @@ -47,8 +45,6 @@ handleWSAction = do joinRoom ClientInfoMessage clientInfo -> do updateClientName clientInfo - AllChatMessageIncomingMessage incomingMessage -> do - broadCastAllChatMessage incomingMessage joinRoom :: ( MonadConnectedClientsModify m, diff --git a/backend/test/Spec.hs b/backend/test/Spec.hs index e69de29..cd4753f 100644 --- a/backend/test/Spec.hs +++ b/backend/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/frontend/dev-with-remote-backend.sh b/frontend/dev-with-remote-backend.sh old mode 100755 new mode 100644 diff --git a/frontend/package.json b/frontend/package.json index 5b9bf01..19a0215 100644 --- a/frontend/package.json +++ b/frontend/package.json @@ -10,7 +10,6 @@ }, "dependencies": { "@jitsi/react-sdk": "^1.3.0", - "jotai": "^2.0.3", "just-curry-it": "^5.3.0", "react": "^18.2.0", "react-dom": "^18.2.0" diff --git a/frontend/src/App.tsx b/frontend/src/App.tsx index 92bf62a..5901c6c 100644 --- a/frontend/src/App.tsx +++ b/frontend/src/App.tsx @@ -1,4 +1,3 @@ -import { Provider } from "jotai"; import { useState } from "react"; import "./App.css"; import Meeting from "./components/meeting/Meeting"; @@ -10,6 +9,7 @@ import { useRoomName } from "./hooks/useRoomName"; function App() { const { userInfo, setUserInfo } = useLocalUser(); + const { roomName, updateRoomName, updateAndSubmitRoomName, submitRoomName } = useRoomName(); const { roomData, sendMessage } = useBackendData(userInfo); const { conferenceData, setConferenceData } = useConferenceData( sendMessage, @@ -23,12 +23,20 @@ function App() { return (