fix server to not relay developer messages back to self

This fixes chat message echoing consistency too.

1 files changed, 21 insertions, 11 deletions

diff --git a/ControlWindow.hs b/ControlWindow.hs
index 3bd0e58..74514be 100644
--- a/ControlWindow.hs
+++ b/ControlWindow.hs
@@ -84,13 +84,19 @@ collectOutput ochan promptchan responsechan = do
 	myusername <- fromString <$> getLoginName
 	withLines stdin $ mapM_ $ processline myusername
   where
-	processline myusername l = atomically $ do
-		-- Is any particular input being prompted for now?
-		mp <- tryReadTChan promptchan
-		case mp of
-			Just _ -> writeTChan responsechan $ L.toStrict l
-			Nothing -> writeTMChan ochan $ ControlOutputAction $
-				ChatMessage (Val myusername) (Val $ L.toStrict l)
+	processline myusername l = do
+		mc <- atomically $ do
+			-- Is any particular input being prompted for now?
+			mp <- tryReadTChan promptchan
+			case mp of
+				Just _ -> do
+					writeTChan responsechan $ L.toStrict l
+					return Nothing
+				Nothing -> do
+					let c = ChatMessage (Val myusername) (Val $ L.toStrict l)
+					writeTMChan ochan $ ControlOutputAction c
+					return (Just c)
+		maybe (return ()) displayChatMessage mc
 
 displayInput :: TMChan ControlOutput -> TMChan ControlInput -> PromptChan -> ResponseChan -> IO ()
 displayInput ochan ichan promptchan responsechan = loop
@@ -103,13 +109,17 @@ displayInput ochan ichan promptchan responsechan = loop
 	go (Just (ControlInputAction (SessionKey k))) = do
 		askToAllow ochan promptchan responsechan k
 		loop
-	go (Just (ControlInputAction (ChatMessage username msg))) = do
-		B.putStr $ "<" <> val username <> "> " <> val msg
-		putStr "\n"
-		hFlush stdout
+	go (Just (ControlInputAction m@(ChatMessage {}))) = do
+		displayChatMessage m
 		loop
 	go _ = loop
 
+displayChatMessage :: ControlAction -> IO ()
+displayChatMessage (ChatMessage username msg) = do
+	B.putStr $ "<" <> val username <> "> " <> val msg <> "\n"
+	hFlush stdout
+displayChatMessage _ = return ()
+
 askToAllow :: TMChan ControlOutput -> PromptChan -> ResponseChan -> PerhapsSigned PublicKey -> IO ()
 askToAllow ochan _ _ (UnSigned pk) = atomically $ writeTMChan ochan $
 	ControlOutputAction $ SessionKeyRejected pk