working toward getting developer mode connection to server working

1 files changed, 15 insertions, 6 deletions

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", [])