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 
-	setup = do
-		(Just hin, Just hout, _, pid) <- createProcess serviceproc
 		{ std_out = CreatePipe
 		, std_in = CreatePipe
 		}
-		v <- newEmptyMVar
-		void $ async $ relayFeeder runner v hin
-		void $ async $ relayReader v hout
-		waiter <- async $ waitexit v pid
-		return (v, waiter, hin, hout, pid)
 
-	cleanup (_, waiter, hin, hout, pid) = do
+	go (Just hin) (Just hout) _ pid = do
+		v <- newEmptyMVar
+		r <- withAsync (relayFeeder runner v hin) $ \_ ->
+			withAsync (relayReader v hout) $ \_ ->
+				withAsync (waitexit v pid) $ \_ -> do
+					r <- runrelay v
 					hClose hin
 					hClose hout
-		cancel waiter
+					return r
 		void $ waitForProcess pid
+		return r
+	go _ _ _ _ = error "internal"
 	
-	go (v, _, _, _, _) = do
+	runrelay v = relayHelper runner v >>= \case
-		r <- relayHelper runner v
-		case r of
 		Left e -> return $ Left e
-			Right exitcode -> runner $ net $ relayToPeer (RelayDone exitcode)
+		Right exitcode -> runner $
+			net $ relayToPeer (RelayDone exitcode)
 
 	waitexit v pid = putMVar v . RelayDone =<< waitForProcess pid