use developer control window to tell when write access is granted

2 files changed, 30 insertions, 14 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index ca3baea..efe476a 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -3,6 +3,7 @@
 module Role.Developer (
 	run,
 	run',
+	watchSessionReadOnly,
 	processSessionStart,
 	getServerMessage,
 	Output(..),
@@ -51,19 +52,45 @@ run' runner url = do
 developer :: TMVar (TVar DeveloperState) -> TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO ()
 developer dsv ichan ochan sid = withSessionLogger sid $ \logger -> do
 	sk <- genMySessionKey
+	(controlinput, controloutput) <- openControlWindow
+	displayInControlWindow controlinput
+		"Using gpg to sign the debug-me session key."
 	spk <- myPublicKey sk (GpgSign True)
+	displayInControlWindow controlinput
+		"Connecting to user ..."
 	(devstate, startoutput) <- processSessionStart sk ochan logger dsv
 	emitOutput startoutput
+	displayInControlWindow controlinput
+		"Waiting for the user to grant write access ..."
 	res <- authUser spk ichan ochan devstate logger
 	case res of
 		Authed -> inRawMode $ void $ do
-			(controlinput, controloutput) <- openControlWindow
+			displayInControlWindow controlinput
+				"Write access granted. You can now type into the user's shell."
+			displayInControlWindow controlinput
+				"(And, you can type in this window to chat with the user.)"
 			sendTtyInput ichan devstate logger
 				`race` sendTtyOutput ochan devstate controlinput logger
 				`race` sendControlOutput controloutput ichan devstate logger
-		AuthFailed -> hPutStrLn stderr "\n** User did not grant access to their terminal."
+		AuthFailed -> do
+			displayInControlWindow controlinput
+				"User did not grant access to their terminal. Watching session in read-only mode."
+			watchSessionReadOnly ochan logger devstate
 		SessionEnded -> hPutStrLn stderr "\n** This debug-me session has already ended."
 
+watchSessionReadOnly :: TMChan AnyMessage -> Logger -> TVar DeveloperState -> IO ()
+watchSessionReadOnly ochan logger st = loop
+  where
+	loop = do
+		ts <- getPOSIXTime
+		v <- atomically $ getServerMessage ochan st ts
+		case v of
+			Nothing -> return ()
+			Just (o, msg) -> do
+				_ <- logger msg
+				emitOutput o
+				loop
+
 data DeveloperState = DeveloperState
 	{ lastSeen :: Hash
 	-- ^ Last Seen value received from the user.
diff --git a/Role/Watcher.hs b/Role/Watcher.hs
index dd49621..f314b46 100644
--- a/Role/Watcher.hs
+++ b/Role/Watcher.hs
@@ -10,7 +10,6 @@ import Role.Developer
 
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TMChan
-import Data.Time.Clock.POSIX
 
 run :: WatchOpts -> IO ()
 run = run' watcher . watchUrl
@@ -20,14 +19,4 @@ watcher dsv _ichan ochan sid = withSessionLogger sid $ \logger -> inRawMode $ do
 	sk <- genMySessionKey
 	(st, startoutput) <- processSessionStart sk ochan logger dsv
 	emitOutput startoutput
-	go logger st
-  where
-	go logger st = do
-		ts <- getPOSIXTime
-		v <- atomically $ getServerMessage ochan st ts
-		case v of
-			Nothing -> return ()
-			Just (o, msg) -> do
-				_ <- logger msg
-				emitOutput o
-				go logger st
+	watchSessionReadOnly ochan logger st