Revert "async exception safety for coprocesses"

This reverts commit 7013798df5.

Utility/CoProcess.hs

@@ -1,7 +1,7 @@
 {- Interface for running a shell command as a coprocess,
  - sending it queries and getting back results.
  -
- - Copyright 2012-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2013 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -62,46 +62,28 @@ stop ch = do
 	let p = proc (coProcessCmd $ coProcessSpec s) (coProcessParams $ coProcessSpec s)
 	forceSuccessProcess p (coProcessPid s)
 
-{- Note that concurrent queries are not safe to perform; caller should
- - serialize calls to query.
- -
- - To handle a restartable process, any IO exception thrown by the send and
+{- To handle a restartable process, any IO exception thrown by the send and
  - receive actions are assumed to mean communication with the process
- - failed, and the query is re-run with a new process.
- -
- - If an async exception is received during a query, the state of
- - communication with the process is unknown, so it is killed, and a new
- - one started so the CoProcessHandle can continue to be used by other
- - threads.
- -}
+ - failed, and the failed action is re-run with a new process. -}
 query :: CoProcessHandle -> (Handle -> IO a) -> (Handle -> IO b) -> IO b
-query ch send receive = uninterruptibleMask $ \unmask ->
-	unmask (readMVar ch >>= restartable)
-		`catchAsync` forcerestart
+query ch send receive = do
+	s <- readMVar ch
+	restartable s (send $ coProcessTo s) $ const $
+		restartable s (hFlush $ coProcessTo s) $ const $
+			restartable s (receive $ coProcessFrom s)
+				return
   where
-	go s = do
-		void $ send $ coProcessTo s
-		hFlush $ coProcessTo s
-		receive $ coProcessFrom s
-	
-	restartable s
+	restartable s a cont
 		| coProcessNumRestarts (coProcessSpec s) > 0 =
-			catchMaybeIO (go s)
-				>>= maybe (restart s increstarts restartable) return
-		| otherwise = go s
-	
-	increstarts s = s { coProcessNumRestarts = coProcessNumRestarts s - 1 }
-
-	restart s f cont = do
-		void $ tryNonAsync $ do
+			maybe restart cont =<< catchMaybeIO a
+		| otherwise = cont =<< a
+	restart = do
+		s <- takeMVar ch
+		void $ catchMaybeIO $ do
 			hClose $ coProcessTo s
 			hClose $ coProcessFrom s
 		void $ waitForProcess $ coProcessPid s
-		s' <- withMVarMasked ch $ \_ -> start' (f (coProcessSpec s))
-		cont s'
-
-	forcerestart ex = do
-		s <- readMVar ch
-		terminateProcess (coProcessPid s)
-		restart s id $ \s' -> void $ swapMVar ch s'
-		either throwM throwM ex
+		s' <- start' $ (coProcessSpec s)
+			{ coProcessNumRestarts = coProcessNumRestarts (coProcessSpec s) - 1 }
+		putMVar ch s'
+		query ch send receive

Utility/Exception.hs

@@ -1,6 +1,6 @@
 {- Simple IO exception handling (and some more)
  -
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2016 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -20,7 +20,6 @@ module Utility.Exception (
 	bracketIO,
 	catchNonAsync,
 	tryNonAsync,
-	catchAsync,
 	tryWhenExists,
 	catchIOErrorType,
 	IOErrorType(..),
@@ -88,14 +87,6 @@ catchNonAsync a onerr = a `catches`
 	, M.Handler (\ (e :: SomeException) -> onerr e)
 	]
 
-{- Catches only async exceptions. -}
-catchAsync :: MonadCatch m => m a -> (Either AsyncException SomeAsyncException -> m a) -> m a
-catchAsync a onerr = a `catches`
-	[ M.Handler (\ (e :: AsyncException) -> onerr (Left e))
-	, M.Handler (\ (e :: SomeAsyncException) -> onerr (Right e))
-	, M.Handler (\ (e :: SomeException) -> throwM e)
-	]
-
 tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)
 tryNonAsync a = go `catchNonAsync` (return . Left)
   where