working toward getting developer mode connection to server working

2 files changed, 19 insertions, 8 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index deceb6d..a53e841 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -8,6 +8,8 @@ import Log
 import Crypto
 import CmdLine
 import WebSockets
+import SessionID
+import Pty
 
 import Control.Concurrent.Async
 import Control.Concurrent.STM
@@ -19,8 +21,8 @@ import Data.List
 run :: DeveloperOpts -> IO ()
 run os = runClientApp $ clientApp (ConnectMode (T.pack (debugUrl os))) developer
 
-developer :: TChan (Message Entered) -> TChan (Message Seen) -> IO ()
-developer ichan ochan = withLogger "debug-me-developer.log" $ \logger -> do
+developer :: TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO ()
+developer ichan ochan _ = inRawMode $ withLogger "debug-me-developer.log" $ \logger -> do
 	-- Start by reading the initial two messages from the user side,
 	-- their session key and the startup message.
 	sessionmsg <- atomically $ readTChan ochan
diff --git a/Role/User.hs b/Role/User.hs
index 9412843..efbbb24 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -10,6 +10,7 @@ import Session
 import Crypto
 import CmdLine
 import WebSockets
+import SessionID
 
 import Control.Concurrent.Async
 import Control.Concurrent.STM
@@ -19,6 +20,7 @@ import qualified Data.ByteString as B
 import Data.List.NonEmpty (NonEmpty(..), toList)
 import Data.Monoid
 import Data.Time.Clock.POSIX
+import System.IO
 
 run :: UserOpts -> IO ExitCode
 run os = do
@@ -27,12 +29,19 @@ run os = do
 	sessionDone
 	return exitstatus
   where
-	go cmd cmdparams startmsg = runWithPty cmd cmdparams $ \(p, ph) -> do
-		runClientApp $ clientApp (InitMode mempty) $ \ichan ochan -> do
-			uthread <- async (user startmsg p ichan ochan)
-			exitstatus <- waitForProcess ph
-			cancel uthread
-			return exitstatus
+	go cmd cmdparams startmsg = do
+		putStr "Connecting to debug-me server..."
+		hFlush stdout
+		runClientApp $ clientApp (InitMode mempty) $ \ichan ochan sid -> do
+			let url = sessionIDUrl sid "localhost" 8081
+			putStrLn ""
+			putStrLn $ "Others can connect to this session by running: debug-me --debug " ++ url
+			hFlush stdout
+			runWithPty cmd cmdparams $ \(p, ph) -> do
+				uthread <- async (user startmsg p ichan ochan)
+				exitstatus <- waitForProcess ph
+				cancel uthread
+				return exitstatus
 
 shellCommand :: UserOpts -> IO (String, [String])
 shellCommand os = return ("dash", [])