From 337091314588b67620e61c2c80cbb6180f07d440 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 24 Apr 2017 16:57:54 -0400
Subject: fix connection closing

Now when the user quits, the developer also exits.
---
 Server.hs | 29 ++++++++++++++++++-----------
 1 file changed, 18 insertions(+), 11 deletions(-)

(limited to 'Server.hs')

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.
-- 
cgit v1.2.3