51 lines
1.5 KiB
Haskell
51 lines
1.5 KiB
Haskell
module BroadcastUserData
|
|
( broadcastUserData,
|
|
broadCastToClientsGeneric,
|
|
MonadBroadcast (..),
|
|
)
|
|
where
|
|
|
|
import ClassyPrelude
|
|
import Data.Aeson (encode)
|
|
import Network.WebSockets qualified as WS
|
|
import State.ConnectedClientsState (ConnectedClients, MonadConnectedClientsRead (getConnctedClients))
|
|
import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState))
|
|
import Types.ConnectionState (Client (..))
|
|
import Types.User (User, clientToUser)
|
|
import Types.UsersData (UsersData (..))
|
|
|
|
class (Monad m, MonadConnectedClientsRead m) => MonadBroadcast m where
|
|
broadCastToClients :: Text -> m ()
|
|
|
|
broadcastUserData ::
|
|
( MonadRoomDataStateRead m,
|
|
MonadBroadcast m
|
|
) =>
|
|
m ()
|
|
broadcastUserData = do
|
|
userWithOutRoom <- getUsersWithoutRoom
|
|
roomsData <- getRoomDataState
|
|
let usersData = UsersData {usersWithOutRoom = userWithOutRoom, roomsData = roomsData}
|
|
broadCastToClients $ (decodeUtf8 . toStrict . encode) usersData
|
|
|
|
getUsersWithoutRoom ::
|
|
( MonadConnectedClientsRead m
|
|
) =>
|
|
m [User]
|
|
getUsersWithoutRoom = map clientToUser . filter (not . joinedRoom) <$> getConnctedClients
|
|
|
|
broadCastToClientsGeneric ::
|
|
( MonadIO m,
|
|
MonadConnectedClientsRead m
|
|
) =>
|
|
Text ->
|
|
m ()
|
|
broadCastToClientsGeneric message = do
|
|
connectedClients <- getConnctedClients
|
|
liftIO (broadcast message connectedClients)
|
|
|
|
broadcast :: Text -> ConnectedClients -> IO ()
|
|
broadcast message clients = do
|
|
putStrLn $ "Broadcasting: " ++ message
|
|
forM_ clients $ \client -> WS.sendTextData (conn client) message
|