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