diff --git a/backend/jitsi-rooms.cabal b/backend/jitsi-rooms.cabal index 416656e..d8ba2a9 100644 --- a/backend/jitsi-rooms.cabal +++ b/backend/jitsi-rooms.cabal @@ -29,12 +29,13 @@ library Lib RoomDataHandler State.ConnectedClientsState + State.GenericTVarState State.RoomDataState + State.RoomsState Types.AppTypes Types.ConnectionState Types.Participant Types.RoomData - Types.RoomsState Types.User Types.UsersData Types.WebEnv diff --git a/backend/src/BroadcastUserData.hs b/backend/src/BroadcastUserData.hs index a53f81b..3a7dd83 100644 --- a/backend/src/BroadcastUserData.hs +++ b/backend/src/BroadcastUserData.hs @@ -8,9 +8,9 @@ where import ClassyPrelude import Data.Aeson (encode) import Network.WebSockets qualified as WS -import State.ConnectedClientsState (MonadConnectedClientsRead (getConnctedClients)) +import State.ConnectedClientsState (ConnectedClients, MonadConnectedClientsRead (getConnctedClients)) import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState)) -import Types.ConnectionState (Client (..), ConnectedClients) +import Types.ConnectionState (Client (..)) import Types.User (User, clientToUser) import Types.UsersData (UsersData (..)) diff --git a/backend/src/Lib.hs b/backend/src/Lib.hs index b468739..0c93106 100644 --- a/backend/src/Lib.hs +++ b/backend/src/Lib.hs @@ -6,9 +6,9 @@ module Lib where import ClassyPrelude +import State.ConnectedClientsState (initConnectionsState) +import State.RoomsState (initRoomsState) import Types.AppTypes -import Types.ConnectionState (initConnectionsState) -import Types.RoomsState (initRoomsState) import WebServer (runWebServer) import WebSocket.Server (runWebSocketServer) diff --git a/backend/src/RoomDataHandler.hs b/backend/src/RoomDataHandler.hs index 898bc55..5face7c 100644 --- a/backend/src/RoomDataHandler.hs +++ b/backend/src/RoomDataHandler.hs @@ -20,7 +20,7 @@ import State.RoomDataState ( MonadRoomDataStateModify (setRoomDataState), MonadRoomDataStateRead, ) -import Types.RoomsState +import State.RoomsState ( roomStateDiffers, ) import Types.WebEnv diff --git a/backend/src/State/ConnectedClientsState.hs b/backend/src/State/ConnectedClientsState.hs index 550e953..1d09bb5 100644 --- a/backend/src/State/ConnectedClientsState.hs +++ b/backend/src/State/ConnectedClientsState.hs @@ -1,6 +1,10 @@ module State.ConnectedClientsState ( MonadConnectedClientsModify (..), MonadConnectedClientsRead (..), + ConnectedClients, + ConnectedClientsState, + HasConnectedClientState (..), + initConnectionsState, addWSClientGeneric, updateWSClientGeneric, removeWSClientGeneric, @@ -10,14 +14,24 @@ where import ClassyPrelude import Data.UUID -import Types.AppTypes import Types.ConnectionState +type ConnectedClientsState = TVar ConnectedClients + +initConnectionsState :: IO ConnectedClientsState +initConnectionsState = newTVarIO newConnectedClients + +newConnectedClients :: ConnectedClients +newConnectedClients = [] + class Monad m => MonadConnectedClientsModify m where addWSClient :: Client -> m () removeWSClient :: UUID -> m () updateWSClient :: UUID -> (Client -> Client) -> m () +class HasConnectedClientState a where + getConnectedClientState :: a -> ConnectedClientsState + addWSClientGeneric :: ( HasConnectedClientState env, MonadReader env m, diff --git a/backend/src/State/GenericTVarState.hs b/backend/src/State/GenericTVarState.hs new file mode 100644 index 0000000..3e40c32 --- /dev/null +++ b/backend/src/State/GenericTVarState.hs @@ -0,0 +1,11 @@ +module State.GenericTVarState (GenericTVarState, updateGenericTVarState, getGenericTVarState) where + +import ClassyPrelude + +type GenericTVarState a = TVar a + +updateGenericTVarState :: (MonadIO m) => GenericTVarState a -> a -> m () +updateGenericTVarState tv a = atomically $ writeTVar tv a + +getGenericTVarState :: (MonadIO m) => GenericTVarState a -> m a +getGenericTVarState = readTVarIO diff --git a/backend/src/Types/RoomsState.hs b/backend/src/State/RoomsState.hs similarity index 86% rename from backend/src/Types/RoomsState.hs rename to backend/src/State/RoomsState.hs index 145bbab..2f51e23 100644 --- a/backend/src/Types/RoomsState.hs +++ b/backend/src/State/RoomsState.hs @@ -1,4 +1,4 @@ -module Types.RoomsState +module State.RoomsState ( RoomsState, initRoomsState, HasRoomsState (..), @@ -9,10 +9,11 @@ module Types.RoomsState where import ClassyPrelude +import State.GenericTVarState import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState)) import Types.RoomData (RoomsData) -type RoomsState = TVar RoomsData +type RoomsState = GenericTVarState RoomsData initRoomsState :: IO RoomsState initRoomsState = newTVarIO [] @@ -30,7 +31,7 @@ updateRoomState :: updateRoomState newData = do state <- getRoomsState <$> ask liftIO $ putStrLn "Upating room state" - atomically $ writeTVar state newData + updateGenericTVarState state newData liftIO $ putStrLn "Done Upating room state" getRoomState :: @@ -41,7 +42,7 @@ getRoomState :: m RoomsData getRoomState = do state <- getRoomsState <$> ask - readTVarIO state + getGenericTVarState state roomStateDiffers :: ( MonadRoomDataStateRead m diff --git a/backend/src/Types/AppTypes.hs b/backend/src/Types/AppTypes.hs index 49338c5..29aaf00 100644 --- a/backend/src/Types/AppTypes.hs +++ b/backend/src/Types/AppTypes.hs @@ -1,10 +1,10 @@ {-# LANGUAGE DerivingVia #-} -module Types.AppTypes (Env (..), App (..), getConnectedClientState, HasConnectedClientState, AppProfile (Prod, Dev)) where +module Types.AppTypes (Env (..), App (..), getConnectedClientState, AppProfile (Prod, Dev)) where import ClassyPrelude -import Types.ConnectionState (ConnectedClientsState) -import Types.RoomsState +import State.ConnectedClientsState +import State.RoomsState ( HasRoomsState (getRoomsState), RoomsState, ) @@ -17,9 +17,6 @@ data Env = Env profile :: AppProfile } -class HasConnectedClientState a where - getConnectedClientState :: a -> ConnectedClientsState - instance HasConnectedClientState Env where getConnectedClientState = connectedClientsState diff --git a/backend/src/Types/ConnectionState.hs b/backend/src/Types/ConnectionState.hs index 6f160a4..799ca76 100644 --- a/backend/src/Types/ConnectionState.hs +++ b/backend/src/Types/ConnectionState.hs @@ -1,8 +1,6 @@ module Types.ConnectionState ( Client (..), - ConnectedClientsState, ConnectedClients, - initConnectionsState, ) where @@ -17,12 +15,4 @@ data Client = Client joinedRoom :: Bool } -type ConnectedClientsState = TVar ConnectedClients - type ConnectedClients = [Client] - -initConnectionsState :: IO ConnectedClientsState -initConnectionsState = newTVarIO newConnectedClients - -newConnectedClients :: ConnectedClients -newConnectedClients = [] diff --git a/backend/src/Types/WebEnv.hs b/backend/src/Types/WebEnv.hs index eff4d4d..2e4f07b 100644 --- a/backend/src/Types/WebEnv.hs +++ b/backend/src/Types/WebEnv.hs @@ -6,11 +6,11 @@ where import ClassyPrelude import Network.Wai (Request, Response, ResponseReceived) +import State.ConnectedClientsState (HasConnectedClientState (getConnectedClientState)) +import State.RoomsState (HasRoomsState (getRoomsState)) import Types.AppTypes ( Env (..), - HasConnectedClientState (getConnectedClientState), ) -import Types.RoomsState (HasRoomsState (getRoomsState)) class HasWebEnv a where getRequest :: a -> Request diff --git a/backend/src/Types/WebSocketMessages/WebSocketMessages.hs b/backend/src/Types/WebSocketMessages/WebSocketMessages.hs index 641bc5d..828c3b2 100644 --- a/backend/src/Types/WebSocketMessages/WebSocketMessages.hs +++ b/backend/src/Types/WebSocketMessages/WebSocketMessages.hs @@ -29,23 +29,22 @@ data WebSocketMessage = ClientInfoMessage SetClientInfo | JoinRoomMessage JoinRo instance FromJSON WebSocketMessage where parseJSON = genericParseJSON defaultOptions {sumEncoding = UntaggedValue} -data SetClientInfo = SetClientInfo - { displayName :: Text - } +data SetClientInfo where + SetClientInfo :: {displayName :: Text} -> SetClientInfo deriving (Generic, Show) instance FromJSON SetClientInfo -data JoinRoom = JoinRoom - { roomName :: Text - } +data JoinRoom where + JoinRoom :: {roomName :: Text} -> JoinRoom deriving (Generic, Show) instance FromJSON JoinRoom -data AllChatMessageIncoming = AllChatMessageIncoming - { content :: Text - } +data AllChatMessageIncoming where + AllChatMessageIncoming :: + {content :: Text} -> + AllChatMessageIncoming deriving (Generic, Show) instance FromJSON AllChatMessageIncoming diff --git a/backend/src/WebServer.hs b/backend/src/WebServer.hs index 484cb37..4e5a650 100644 --- a/backend/src/WebServer.hs +++ b/backend/src/WebServer.hs @@ -25,11 +25,11 @@ import State.RoomDataState ( MonadRoomDataStateModify (..), MonadRoomDataStateRead (getRoomDataState), ) -import Types.AppTypes (Env (..)) -import Types.RoomsState +import State.RoomsState ( getRoomState, updateRoomState, ) +import Types.AppTypes (Env (..)) import Types.WebEnv newtype ExceptTApp e a = E {unExceptTApp :: IO (Either e a)} diff --git a/backend/src/WebSocket/WSReaderTApp.hs b/backend/src/WebSocket/WSReaderTApp.hs index 3ea6ef3..d997065 100644 --- a/backend/src/WebSocket/WSReaderTApp.hs +++ b/backend/src/WebSocket/WSReaderTApp.hs @@ -17,7 +17,8 @@ import ClassyPrelude import Data.UUID import Network.WebSockets qualified as WS import State.ConnectedClientsState - ( MonadConnectedClientsModify (..), + ( HasConnectedClientState, + MonadConnectedClientsModify (..), MonadConnectedClientsRead (..), addWSClientGeneric, getConnctedClientsGeneric, @@ -25,8 +26,8 @@ import State.ConnectedClientsState updateWSClientGeneric, ) import State.RoomDataState +import State.RoomsState (HasRoomsState (..), getRoomState) import Types.AppTypes -import Types.RoomsState (HasRoomsState (..), getRoomState) data WSEnv = WSEnv { appEnv :: Env,