summaryrefslogtreecommitdiffhomepage
path: root/Server.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2017-04-24 16:57:54 -0400
committerJoey Hess <joeyh@joeyh.name>2017-04-24 16:57:54 -0400
commit337091314588b67620e61c2c80cbb6180f07d440 (patch)
tree66167e8e7cb288baf3f8f49fc9dd75226877e7c0 /Server.hs
parent9a8d3bc531647d8b96e66e6daabf2176a1df4afb (diff)
downloaddebug-me-337091314588b67620e61c2c80cbb6180f07d440.tar.gz
fix connection closing
Now when the user quits, the developer also exits.
Diffstat (limited to 'Server.hs')
-rw-r--r--Server.hs29
1 files changed, 18 insertions, 11 deletions
diff --git a/Server.hs b/Server.hs
index 527ac02..5de184d 100644
--- a/Server.hs
+++ b/Server.hs
@@ -142,13 +142,15 @@ user o ssv conn = withSessionID (serverDirectory o) $ \(loghv, sid) -> do
writeSession session l
-- Relay Developer messages from the channel to the user's websocket.
- relaytouser userchan = relayToSocket conn $ do
+ relaytouser userchan = do
v <- atomically $ readTMChan userchan
- return $ case v of
+ case v of
Just l -> case loggedMessage l of
- Developer m -> Just (Developer m)
- User _ -> Nothing
- Nothing -> Nothing
+ Developer m -> do
+ sendBinaryData conn (LogMessage (Developer m))
+ relaytouser userchan
+ User _ -> relaytouser userchan
+ Nothing -> return ()
developer :: ServerOpts -> TVar ServerState -> SessionID -> WS.Connection -> IO ()
developer o ssv sid conn = bracket setup cleanup go
@@ -179,17 +181,22 @@ developer o ssv sid conn = bracket setup cleanup go
writeSession session l
User _ -> return () -- developer cannot send User messages
- -- Relay user messages from the channel to the developer's websocket.
- relaytodeveloper devchan = relayToSocket conn $ do
+ -- Relay user messages from the developer's clone of the
+ -- broadcast channel to the developer's websocket.
+ relaytodeveloper devchan = do
v <- atomically $ readTMChan devchan
- return $ case v of
+ case v of
Just l -> case loggedMessage l of
- User m -> Just (User m)
+ User m -> do
+ sendBinaryData conn (LogMessage (User m))
+ relaytodeveloper devchan
-- TODO: Relay messages from other
-- developers, without looping back
-- the developer's own messages.
- Developer _ -> Nothing
- Nothing -> Nothing
+ Developer _ -> relaytodeveloper devchan
+ Nothing -> do
+ sendBinaryData conn Done
+ return ()
-- | Replay the log of what's happened in the session so far,
-- and return a channel that will get new session activity.