jitsi-roomsv2/backend/src/State/ConnectedClientsState.hs

module State.ConnectedClientsState
  ( MonadConnectedClientsModify (..),
    MonadConnectedClientsRead (..),
    ConnectedClients,
    ConnectedClientsState,
    HasConnectedClientState (..),
    initConnectionsState,
    addWSClientGeneric,
    updateWSClientGeneric,
    removeWSClientGeneric,
    getConnctedClientsGeneric,
  )
where

import ClassyPrelude
import Data.UUID
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,
    MonadUnliftIO m
  ) =>
  Client ->
  m ()
addWSClientGeneric client = do
  modifyState $ addClient client

addClient :: Client -> ConnectedClients -> ConnectedClients
addClient client clients = client : clients

updateWSClientGeneric ::
  ( HasConnectedClientState env,
    MonadReader env m,
    MonadUnliftIO m
  ) =>
  UUID ->
  (Client -> Client) ->
  m
    ()
updateWSClientGeneric clientId patchFunction = do
  modifyState $ updateClient clientId patchFunction

updateClient :: UUID -> (Client -> Client) -> ConnectedClients -> ConnectedClients
updateClient toUpdate f allClients = do
  client <- allClients
  if toUpdate == uuid client
    then return $ f client
    else return client

removeWSClientGeneric ::
  ( HasConnectedClientState env,
    MonadReader env m,
    MonadUnliftIO m
  ) =>
  UUID ->
  m ()
removeWSClientGeneric clientId = do
  modifyState $ removeClient clientId

removeClient :: UUID -> ConnectedClients -> ConnectedClients
removeClient toRemove = filter ((/= toRemove) . uuid)

modifyState ::
  ( HasConnectedClientState env,
    MonadReader env m,
    MonadUnliftIO m
  ) =>
  (ConnectedClients -> ConnectedClients) ->
  m ()
modifyState modifyFunc = do
  state <- getConnectedClientState <$> ask
  atomically $ modifyTVar state modifyFunc

class Monad m => MonadConnectedClientsRead m where
  getConnctedClients :: m ConnectedClients

getConnctedClientsGeneric ::
  ( HasConnectedClientState env,
    MonadReader env m,
    MonadIO m
  ) =>
  m ConnectedClients
getConnctedClientsGeneric = do
  ask >>= readTVarIO . getConnectedClientState