module WebSocket.WSApp (WSEnv (..), wsApp, WSApp (..)) where import BroadcastUserData ( MonadBroadcast (..), broadcastUserData, ) import ClassyPrelude import Data.UUID.V4 () import State.ConnectedClientsState (MonadConnectedClientsModify (..)) import State.RoomDataState (MonadRoomDataStateRead (..)) import Types.ConnectionState (Client (..)) import Types.WebSocketMessages.WebSocketMessages ( SetClientInfo (displayName), WebSocketMessage (..), ) import WebSocket.AllChat (broadCastAllChatMessage) import WebSocket.MonadWebSocketSession import WebSocket.WSReaderTApp wsApp :: ( MonadWebSocketSession m, MonadWebSocketSessionInit m, MonadConnectedClientsModify m, MonadRoomDataStateRead m, MonadBroadcast m ) => m () wsApp = do clientInfo <- getTypedWSMessage client <- newClient clientInfo addWSClient client broadcastUserData withCleanUp $ forever $ do handleWSAction broadcastUserData handleWSAction :: ( MonadWebSocketSession m, MonadConnectedClientsModify m, MonadBroadcast m ) => m () handleWSAction = do msg <- getTypedWSMessage case msg of JoinRoomMessage _ -> do joinRoom ClientInfoMessage clientInfo -> do updateClientName clientInfo AllChatMessageIncomingMessage incomingMessage -> do broadCastAllChatMessage incomingMessage joinRoom :: ( MonadConnectedClientsModify m, MonadWebSocketSession m ) => m () joinRoom = do clientId <- getSesssionId updateWSClient clientId (\c -> c {joinedRoom = True}) updateClientName :: ( MonadWebSocketSession m, MonadConnectedClientsModify m ) => SetClientInfo -> m () updateClientName clientInfo = do clientId <- getSesssionId updateWSClient clientId (\c -> c {name = displayName clientInfo})