aboutsummaryrefslogtreecommitdiff
path: root/server/lib/Cafp/Main
diff options
context:
space:
mode:
authorJasper Van der Jeugt2020-08-04 18:52:49 +0200
committerJasper Van der Jeugt2020-08-04 18:52:49 +0200
commita2e72144746fdecc0539286798c0a46a02e47d5f (patch)
tree7f4cc9f84b346d7cc71df2213d72abc42f0feefe /server/lib/Cafp/Main
parentcb3682637a9a45ee088fd134e8ba67d8114886b7 (diff)
Delete empty rooms
Diffstat (limited to 'server/lib/Cafp/Main')
-rw-r--r--server/lib/Cafp/Main/Server.hs16
1 files changed, 12 insertions, 4 deletions
diff --git a/server/lib/Cafp/Main/Server.hs b/server/lib/Cafp/Main/Server.hs
index 9ded571..799f26e 100644
--- a/server/lib/Cafp/Main/Server.hs
+++ b/server/lib/Cafp/Main/Server.hs
@@ -97,19 +97,27 @@ getOrCreateRoom server roomId = MVar.modifyMVar (serverRooms server) $ \rooms ->
Just room -> pure (rooms, room)
Nothing -> do
gen <- newStdGen
+ warning $ "[" <> T.unpack roomId <> "] Created room"
room <- atomically $ newRoom server gen
pure (HMS.insert roomId room rooms, room)
+deleteRoom :: Server -> RoomId -> IO ()
+deleteRoom server roomId = do
+ warning $ "[" <> T.unpack roomId <> "] Deleting room"
+ MVar.modifyMVar_ (serverRooms server) $ pure . HMS.delete roomId
+
joinRoom :: Room -> Sink -> STM PlayerId
joinRoom room sink = do
pid <- STM.stateTVar (roomGame room) joinGame
STM.modifyTVar' (roomSinks room) $ HMS.insert pid sink
pure pid
-leaveRoom :: Room -> PlayerId -> STM ()
+leaveRoom :: Room -> PlayerId -> STM Bool
leaveRoom room pid = do
STM.modifyTVar' (roomGame room) $ leaveGame pid
- STM.modifyTVar' (roomSinks room) $ HMS.delete pid
+ STM.stateTVar (roomSinks room) $ \sinks ->
+ let sinks' = HMS.delete pid sinks in
+ (HMS.null sinks', sinks')
syncRoom :: Room -> IO ()
syncRoom room = do
@@ -131,8 +139,8 @@ wsApp server pc = case routePendingConnection pc of
WS.withPingThread conn 30 (pure ()) $ bracket
(atomically $ joinRoom room sink)
(\playerId -> do
- atomically $ leaveRoom room playerId
- syncRoom room)
+ roomEmpty <- atomically $ leaveRoom room playerId
+ if roomEmpty then deleteRoom server roomId else syncRoom room)
(\playerId -> do
syncRoom room
cards <- fmap (^. gameCards) . atomically . STM.readTVar $