make runRelayService async exception safe

Use withCreateProcess so the helper process will be shut down
if the thread is killed.

Use withAsync to ensure the helper threads get shut down
too.

P2P/IO.hs

@@ -284,7 +284,7 @@ runRelay runner (RelayHandle hout) (RelayHandle hin) =
 
 runRelayService :: P2PConnection -> RunProto IO -> Service -> IO (Either ProtoFailure ())
 runRelayService conn runner service =
-	bracket setup cleanup go
+	withCreateProcess serviceproc' go
 		`catchNonAsync` (return . Left . ProtoFailureException)
   where
 	cmd = case service of
@@ -295,29 +295,28 @@ runRelayService conn runner service =
 		[ Param cmd
 		, File (fromRawFilePath (repoPath (connRepo conn)))
 		] (connRepo conn)
+	serviceproc' = serviceproc 
+		{ std_out = CreatePipe
+		, std_in = CreatePipe
+		}
 
-	setup = do
+	go (Just hin) (Just hout) _ pid = do
-		(Just hin, Just hout, _, pid) <- createProcess serviceproc
-			{ std_out = CreatePipe
-			, std_in = CreatePipe
-			}
 		v <- newEmptyMVar
-		void $ async $ relayFeeder runner v hin
+		r <- withAsync (relayFeeder runner v hin) $ \_ ->
-		void $ async $ relayReader v hout
+			withAsync (relayReader v hout) $ \_ ->
-		waiter <- async $ waitexit v pid
+				withAsync (waitexit v pid) $ \_ -> do
-		return (v, waiter, hin, hout, pid)
+					r <- runrelay v
-
+					hClose hin
-	cleanup (_, waiter, hin, hout, pid) = do
+					hClose hout
-		hClose hin
+					return r
-		hClose hout
-		cancel waiter
 		void $ waitForProcess pid
+		return r
+	go _ _ _ _ = error "internal"
 	
-	go (v, _, _, _, _) = do
+	runrelay v = relayHelper runner v >>= \case
-		r <- relayHelper runner v
+		Left e -> return $ Left e
-		case r of
+		Right exitcode -> runner $
-			Left e -> return $ Left e
+			net $ relayToPeer (RelayDone exitcode)
-			Right exitcode -> runner $ net $ relayToPeer (RelayDone exitcode)
 
 	waitexit v pid = putMVar v . RelayDone =<< waitForProcess pid