diff --git a/backend/src/BroadcastUserData.hs b/backend/src/BroadcastUserData.hs index bc00f48..a53f81b 100644 --- a/backend/src/BroadcastUserData.hs +++ b/backend/src/BroadcastUserData.hs @@ -41,8 +41,8 @@ broadCastToClientsGeneric :: Text -> m () broadCastToClientsGeneric message = do - state <- getConnctedClients - liftIO $ broadcast message state + connectedClients <- getConnctedClients + liftIO (broadcast message connectedClients) broadcast :: Text -> ConnectedClients -> IO () broadcast message clients = do diff --git a/backend/src/State/ConnectedClientsState.hs b/backend/src/State/ConnectedClientsState.hs index e2ff726..550e953 100644 --- a/backend/src/State/ConnectedClientsState.hs +++ b/backend/src/State/ConnectedClientsState.hs @@ -72,9 +72,7 @@ modifyState :: m () modifyState modifyFunc = do state <- getConnectedClientState <$> ask - modifyMVar_ state $ \s -> - let s' = modifyFunc s - in return s' + atomically $ modifyTVar state modifyFunc class Monad m => MonadConnectedClientsRead m where getConnctedClients :: m ConnectedClients @@ -86,4 +84,4 @@ getConnctedClientsGeneric :: ) => m ConnectedClients getConnctedClientsGeneric = do - ask >>= readMVar . getConnectedClientState + ask >>= readTVarIO . getConnectedClientState diff --git a/backend/src/Types/ConnectionState.hs b/backend/src/Types/ConnectionState.hs index a787c9e..6f160a4 100644 --- a/backend/src/Types/ConnectionState.hs +++ b/backend/src/Types/ConnectionState.hs @@ -17,12 +17,12 @@ data Client = Client joinedRoom :: Bool } -type ConnectedClientsState = MVar ConnectedClients +type ConnectedClientsState = TVar ConnectedClients type ConnectedClients = [Client] initConnectionsState :: IO ConnectedClientsState -initConnectionsState = newMVar newConnectedClients +initConnectionsState = newTVarIO newConnectedClients newConnectedClients :: ConnectedClients newConnectedClients = [] diff --git a/backend/src/Types/RoomsState.hs b/backend/src/Types/RoomsState.hs index df5ae71..8448593 100644 --- a/backend/src/Types/RoomsState.hs +++ b/backend/src/Types/RoomsState.hs @@ -12,10 +12,10 @@ import ClassyPrelude import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState)) import Types.RoomData (RoomsData) -type RoomsState = MVar RoomsData +type RoomsState = TVar RoomsData initRoomsState :: IO RoomsState -initRoomsState = newMVar [] +initRoomsState = newTVarIO [] class HasRoomsState a where getRoomsState :: a -> RoomsState @@ -29,7 +29,7 @@ updateRoomState :: m () updateRoomState newData = do state <- getRoomsState <$> ask - _ <- swapMVar state newData + _ <- atomically $ swapTVar state newData return () getRoomState :: @@ -40,7 +40,7 @@ getRoomState :: m RoomsData getRoomState = do state <- getRoomsState <$> ask - readMVar state + readTVarIO state roomStateDiffers :: ( MonadRoomDataStateRead m diff --git a/backend/src/WebServer.hs b/backend/src/WebServer.hs index c32a14d..1e256b9 100644 --- a/backend/src/WebServer.hs +++ b/backend/src/WebServer.hs @@ -121,6 +121,24 @@ notFound = do "404 - Not Found" throwError response +-- notFound :: +-- ( MonadIO m, +-- HasWebEnv env, +-- MonadReader env m, +-- MonadError ResponseReceived m +-- ) => +-- m ResponseReceived +-- notFound = do +-- respond' <- getRespond <$> ask +-- response <- +-- liftIO $ +-- respond' $ +-- responseLBS +-- status200 +-- [("Content-Type", "text/plain")] +-- "200 - Success" +-- response + runWebApp :: ( MonadIO m, MonadReader Env m diff --git a/backend/stack.yaml b/backend/stack.yaml index 99c2ab2..1c01a4b 100644 --- a/backend/stack.yaml +++ b/backend/stack.yaml @@ -16,7 +16,7 @@ # this way we can use prebuild binaries for hls #resolver: nightly-2022-11-12 #resolver: ghc-9.2.4 -resolver: lts-20.16 +resolver: lts-20.26 # # The location of a snapshot can be provided as a file or url. Stack assumes # a snapshot provided as a file might change, whereas a url resource does not. diff --git a/backend/stack.yaml.lock b/backend/stack.yaml.lock index 08fa9b8..ea5a850 100644 --- a/backend/stack.yaml.lock +++ b/backend/stack.yaml.lock @@ -6,7 +6,7 @@ packages: [] snapshots: - completed: - sha256: dad15e2ec0c09280a5c2e07190fb18710fc54472f029f34f861f686540824d81 - size: 649592 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/16.yaml - original: lts-20.16 + sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2 + size: 650475 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml + original: lts-20.26