From 94986fb22887c0d20182b3399f7cf6d38a750abf Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 3 Jun 2020 13:15:01 -0400
Subject: [PATCH] convert to withCreateProcess

Makes it stop the command if the consumer gets killed.

Also, it seems that the old version expected bracketOnError to return
the False from the error handler, but it does not, it would have thrown
the exception and ignored the False. That's fixed, it will now return
False when there is an exception.
---
 Utility/MagicWormhole.hs | 28 ++++++++++++----------------
 1 file changed, 12 insertions(+), 16 deletions(-)

diff --git a/Utility/MagicWormhole.hs b/Utility/MagicWormhole.hs
index 4a390df46f..4e7b49c7cc 100644
--- a/Utility/MagicWormhole.hs
+++ b/Utility/MagicWormhole.hs
@@ -30,12 +30,12 @@ import Utility.Monad
 import Utility.Misc
 import Utility.Env
 import Utility.Path
+import Utility.Exception
 
 import System.IO
 import System.Exit
 import Control.Concurrent
 import Control.Concurrent.Async
-import Control.Exception
 import Data.Char
 import Data.List
 import Control.Applicative
@@ -146,26 +146,22 @@ wormHoleProcess :: WormHoleParams -> CreateProcess
 wormHoleProcess = proc "wormhole" . toCommand
 
 runWormHoleProcess :: CreateProcess -> (Handle -> Handle -> Handle -> IO Bool) ->  IO Bool
-runWormHoleProcess p consumer = 
-	bracketOnError setup (\v -> cleanup v <&&> return False) go
+runWormHoleProcess p consumer =
+	withCreateProcess p' go `catchNonAsync` const (return False)
   where
-	setup = do
-		(Just hin, Just hout, Just herr, pid)
-			<- createProcess p
-				{ std_in = CreatePipe
-				, std_out = CreatePipe
-				, std_err = CreatePipe
-				}
-		return (hin, hout, herr, pid)
-	cleanup (hin, hout, herr, pid) = do
+	p' = p 
+		{ std_in = CreatePipe
+		, std_out = CreatePipe
+		, std_err = CreatePipe
+		}
+	go (Just hin) (Just hout) (Just herr) pid =
+		consumer hin hout herr <&&> waitbool pid
+	go _ _ _ _ = error "internal"
+	waitbool pid = do
 		r <- waitForProcess pid
-		hClose hin
-		hClose hout
-		hClose herr
 		return $ case r of
 			ExitSuccess -> True
 			ExitFailure _ -> False
-	go h@(hin, hout, herr, _) = consumer hin hout herr <&&> cleanup h
 
 isInstalled :: IO Bool
 isInstalled = inPath "wormhole"