jitsi-roomsv2/backend/src/WebSocket/WSApp.hs

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})