From 17d76b2a59d496a2ffd6d2199b1c6ad563b0bb5b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 24 Apr 2017 17:13:28 -0400
Subject: fix downloader and watcher

---
 Role/Developer.hs  | 18 +++++++++---------
 Role/Downloader.hs |  5 ++---
 Role/Watcher.hs    |  3 ++-
 3 files changed, 13 insertions(+), 13 deletions(-)

(limited to 'Role')

diff --git a/Role/Developer.hs b/Role/Developer.hs
index 64ff094..1cc5a10 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -36,7 +36,8 @@ userMessages (Developer _) = Nothing
 
 developer :: TMChan (Message Entered) -> TMChan (Message Seen) -> SessionID -> IO ()
 developer ichan ochan _ = withLogger "debug-me-developer.log" $ \logger -> do
-	devstate <- processSessionStart ochan logger
+	(devstate, startoutput) <- processSessionStart ochan logger
+	emitOutput startoutput
 	ok <- authUser ichan ochan devstate logger
 	if ok
 		then inRawMode $ void $ 
@@ -115,7 +116,7 @@ authUser ichan ochan devstate logger = do
 	waitresp pk
   where
 	waitresp pk = do
-		(o, msg) <- fromMaybe (error "No response from server to our session key")
+		(o, msg) <- fromMaybe (error "Looks like that debug-me session is over.")
 			<$> atomically (getUserMessage ochan devstate)
 		logger $ User msg
 		emitOutput o
@@ -231,7 +232,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds
 
 -- | Start by reading the initial two messages from the user side,
 -- their session key and the startup message.
-processSessionStart :: TMChan (Message Seen) -> Logger -> IO (TVar DeveloperState)
+processSessionStart :: TMChan (Message Seen) -> Logger -> IO (TVar DeveloperState, Output)
 processSessionStart ochan logger = do
 	sessionmsg <- fromMaybe (error "Did not get session initialization message")
 		<$> atomically (readTMChan ochan)
@@ -246,15 +247,13 @@ processSessionStart ochan logger = do
 	startmsg <- fromMaybe (error "Did not get session startup message")
 		<$> atomically (readTMChan ochan)
 	logger $ User startmsg
-	starthash <- case startmsg of
+	let (starthash, output) = case startmsg of
 		ActivityMessage act@(Activity (Seen (Val b)) Nothing _)
-			| verifySigned sigverifier act -> do
-				B.hPut stdout b
-				hFlush stdout	
-				return (hash act)
+			| verifySigned sigverifier act ->
+				(hash act, TtyOutput b)
 		_ -> error $ "Unexpected startup message: " ++ show startmsg
 	sk <- genMySessionKey
-	newTVarIO $ DeveloperState
+	st <- newTVarIO $ DeveloperState
 		{ lastSeen = starthash
 		, sentSince = mempty
 		, enteredSince = mempty
@@ -262,3 +261,4 @@ processSessionStart ochan logger = do
 		, developerSessionKey = sk
 		, developerSigVerifier = sigverifier
 		}
+	return (st, output)
diff --git a/Role/Downloader.hs b/Role/Downloader.hs
index 55d7b63..ede11a7 100644
--- a/Role/Downloader.hs
+++ b/Role/Downloader.hs
@@ -18,7 +18,7 @@ downloader _ichan ochan sid = do
 	putStrLn $ "Starting download to " ++ logfile
 	putStrLn "(Will keep downloading until the debug-me session is done.)"
 	withLogger logfile $ \logger -> do
-		st <- processSessionStart ochan logger
+		(st, _startoutput) <- processSessionStart ochan logger
 		go logger st
   where
 	go logger st = do
@@ -29,5 +29,4 @@ downloader _ichan ochan sid = do
 				_ <- logger $ User msg
 				case o of
 					ProtocolError e -> error ("Protocol error: " ++ e)
-					_ -> return ()
-				go logger st
+					_ -> go logger st
diff --git a/Role/Watcher.hs b/Role/Watcher.hs
index 6ed1a6b..ddffa79 100644
--- a/Role/Watcher.hs
+++ b/Role/Watcher.hs
@@ -15,7 +15,8 @@ run = run' watcher . watchUrl
 
 watcher :: TMChan (Message Entered) -> TMChan (Message Seen) -> SessionID -> IO ()
 watcher _ichan ochan _ = inRawMode $ do
-	st <- processSessionStart ochan nullLogger
+	(st, startoutput) <- processSessionStart ochan nullLogger
+	emitOutput startoutput
 	go st
   where
 	go st = do
-- 
cgit v1.2.3