diff options
Diffstat (limited to 'Server.hs')
| -rw-r--r-- | Server.hs | 29 |
1 files changed, 18 insertions, 11 deletions
@@ -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. |