/quit

This commit was sponsored by Jake Vosloo on Patreon.

2 files changed, 8 insertions, 4 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index d8d9d2c..51ada28 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -188,6 +188,7 @@ sendControlOutput controloutput ichan devstate logger = loop
 			return msg
 		logger (Developer msg)
 		loop
+	go (Just ControlWindowRequestedImmediateQuit) = return ()
 
 -- | Read activity from the TMChan and display it to the developer.
 --
diff --git a/Role/User.hs b/Role/User.hs
index a7e4843..49e9edf 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -65,8 +65,8 @@ run os = fromMaybe (ExitFailure 101) <$> connect
 			us <- startProtocol startSession ochan logger
 			atomically $ putTMVar usv us
 			workers <- mapM async
-				[ sendControlOutput controloutput ochan us logger
-				, sendPtyOutput p ochan us logger
+				[ sendPtyOutput p ochan us logger
+				, sendControlOutput controloutput ochan us logger ph
 				]
 			mainworker <- async $ sendPtyInput ichan ochan controlinput p us logger
 				`race` forwardTtyInputToPty p
@@ -350,8 +350,8 @@ isLegalEntered (Activity a (Just hp) lastentered _ _) us
 --
 -- When the control window sends a SessionKeyAccepted, add it to the
 -- sigVerifier.
-sendControlOutput :: TMChan ControlOutput -> TMChan (Message Seen) -> TVar UserState -> Logger -> IO ()
-sendControlOutput controloutput ochan us logger = loop
+sendControlOutput :: TMChan ControlOutput -> TMChan (Message Seen) -> TVar UserState -> Logger -> ProcessHandle -> IO ()
+sendControlOutput controloutput ochan us logger ph = loop
   where
 	loop = go =<< atomically (readTMChan controloutput)
 	go Nothing = return ()
@@ -369,3 +369,6 @@ sendControlOutput controloutput ochan us logger = loop
 		l <- atomically $ sendDeveloper ochan us c now
 		logger (User l)
 		loop
+	go (Just ControlWindowRequestedImmediateQuit) = do
+		terminateProcess ph
+		return ()