diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs
index 64ca3fbf42..6868f53174 100644
--- a/Annex/YoutubeDl.hs
+++ b/Annex/YoutubeDl.hs
@@ -205,12 +205,14 @@ youtubeDlFileNameHtmlOnly' url uo
 			, Param "--no-warnings"
 			, Param "--no-playlist"
 			]
-		(Nothing, Just o, Just e, pid) <- liftIO $ createProcess
-			(proc "youtube-dl" (toCommand opts))
-				{ std_out = CreatePipe
-				, std_err = CreatePipe
-				}
-		output <- liftIO $ fmap fst $ 
+		let p = (proc "youtube-dl" (toCommand opts))
+			{ std_out = CreatePipe
+			, std_err = CreatePipe
+			}
+		liftIO $ withCreateProcess p waitproc
+	
+	waitproc Nothing (Just o) (Just e) pid = do
+		output <- fmap fst $ 
 			hGetContentsStrict o
 				`concurrently`
 			hGetContentsStrict e
@@ -218,6 +220,8 @@ youtubeDlFileNameHtmlOnly' url uo
 		return $ case (ok, lines output) of
 			(True, (f:_)) | not (null f) -> Right f
 			_ -> nomedia
+	waitproc _ _ _ _ = error "internal"
+
 	nomedia = Left "no media in url"
 
 youtubeDlOpts :: [CommandParam] -> Annex [CommandParam]
diff --git a/Assistant/Restart.hs b/Assistant/Restart.hs
index ef8477ead1..ec34c52181 100644
--- a/Assistant/Restart.hs
+++ b/Assistant/Restart.hs
@@ -113,7 +113,5 @@ assistantListening url = catchBoolIO $ do
 startAssistant :: FilePath -> IO ()
 startAssistant repo = void $ forkIO $ do
 	program <- programPath
-	(_, _, _, pid) <- 
-		createProcess $
-			(proc program ["assistant"]) { cwd = Just repo }
-	void $ checkSuccessProcess pid
+	let p = (proc program ["assistant"]) { cwd = Just repo }
+	withCreateProcess p $ \_ _ _ pid -> void $ checkSuccessProcess pid
diff --git a/Assistant/Threads/RemoteControl.hs b/Assistant/Threads/RemoteControl.hs
index 5a0339eef4..51f5e4b9b4 100644
--- a/Assistant/Threads/RemoteControl.hs
+++ b/Assistant/Threads/RemoteControl.hs
@@ -32,20 +32,27 @@ remoteControlThread = namedThread "RemoteControl" $ do
 	(cmd, params) <- liftIO $ toBatchCommand
 		(program, [Param "remotedaemon", Param "--foreground"])
 	let p = proc cmd (toCommand params)
-	(Just toh, Just fromh, _, pid) <- liftIO $ createProcess p
+	bracket (setup p) cleanup (go p)
+  where
+	setup p = liftIO $ createProcess $ p
 		{ std_in = CreatePipe
 		, std_out = CreatePipe
 		}
-	
-	urimap <- liftIO . newMVar =<< liftAnnex getURIMap
+	cleanup = liftIO . cleanupProcess
 
-	controller <- asIO $ remoteControllerThread toh
-	responder <- asIO $ remoteResponderThread fromh urimap
+	go p (Just toh, Just fromh, _, pid) = do
+		urimap <- liftIO . newMVar =<< liftAnnex getURIMap
 
-	-- run controller and responder until the remotedaemon dies
-	liftIO $ void $ tryNonAsync $ controller `concurrently` responder
-	debug ["remotedaemon exited"]
-	liftIO $ forceSuccessProcess p pid
+		controller <- asIO $ remoteControllerThread toh
+		responder <- asIO $ remoteResponderThread fromh urimap
+
+		-- run controller and responder until the remotedaemon dies
+		liftIO $ void $ tryNonAsync $
+			controller `concurrently` responder
+		debug ["remotedaemon exited"]
+		liftIO $ forceSuccessProcess p pid	
+	go _ _ = error "internal"
+		
 
 -- feed from the remoteControl channel into the remotedaemon
 remoteControllerThread :: Handle -> Assistant ()
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index 1769e5788a..cd4d8576e1 100644
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -180,14 +180,16 @@ querySingle o r repo reader = assertLocal repo $
 			, std_in = Inherit
 			, std_out = CreatePipe
 			}
-		pid <- createProcess p'
-		let h = stdoutHandle pid
-		output <- reader h
-		hClose h
-		ifM (checkSuccessProcess (processHandle pid))
+		withCreateProcess p' go
+  where
+	go _ (Just outh) _ pid = do
+		output <- reader outh
+		hClose outh
+		ifM (checkSuccessProcess pid)
 			( return (Just output)
 			, return Nothing
 			)
+	go _ _ _ _ = error "internal"
 
 querySize :: Ref -> Repo -> IO (Maybe FileSize)
 querySize r repo = maybe Nothing (readMaybe . takeWhile (/= '\n'))
diff --git a/Git/Command.hs b/Git/Command.hs
index 15157a08a5..27688e2ca1 100644
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -1,6 +1,6 @@
 {- running git commands
  -
- - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -70,13 +70,17 @@ pipeReadStrict = pipeReadStrict' S.hGetContents
 
 {- The reader action must be strict. -}
 pipeReadStrict' :: (Handle -> IO a) -> [CommandParam] -> Repo -> IO a
-pipeReadStrict' reader params repo = assertLocal repo $
-	withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do
-		output <- reader h
-		hClose h
-		return output
+pipeReadStrict' reader params repo = assertLocal repo $ withCreateProcess p go
   where
-	p  = gitCreateProcess params repo
+	p  = (gitCreateProcess params repo)
+		{ std_out = CreatePipe }
+
+	go _ (Just outh) _ pid = do
+		output <- reader outh
+		hClose outh
+		void $ waitForProcess pid
+		return output
+	go _ _ _ _ = error "internal"
 
 {- Runs a git command, feeding it an input, and returning its output,
  - which is expected to be fairly small, since it's all read into memory
diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index 69a9e9f81e..5206b35888 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -77,27 +77,31 @@ findBroken batchmode r = do
 		then toBatchCommand (command, params)
 		else return (command, params)
 	
-	p@(_, _, _, pid) <- createProcess $
-		(proc command' (toCommand params'))
-			{ std_out = CreatePipe
-			, std_err = CreatePipe
-			}
-	(o1, o2) <- concurrently
-		(parseFsckOutput maxobjs r (stdoutHandle p))
-		(parseFsckOutput maxobjs r (stderrHandle p))
-	fsckok <- checkSuccessProcess pid
-	case mappend o1 o2 of
-		FsckOutput badobjs truncated
-			| S.null badobjs && not fsckok -> return FsckFailed
-			| otherwise -> return $ FsckFoundMissing badobjs truncated
-		NoFsckOutput
-			| not fsckok -> return FsckFailed
-			| otherwise -> return noproblem
-		-- If all fsck output was duplicateEntries warnings,
-		-- the repository is not broken, it just has some unusual
-		-- tree objects in it. So ignore nonzero exit status.
-		AllDuplicateEntriesWarning -> return noproblem
+	let p = (proc command' (toCommand params'))
+		{ std_out = CreatePipe
+		, std_err = CreatePipe
+		}
+	withCreateProcess p go
   where
+	go _ (Just outh) (Just errh) pid = do
+		(o1, o2) <- concurrently
+			(parseFsckOutput maxobjs r outh)
+			(parseFsckOutput maxobjs r errh)
+		fsckok <- checkSuccessProcess pid
+		case mappend o1 o2 of
+			FsckOutput badobjs truncated
+				| S.null badobjs && not fsckok -> return FsckFailed
+				| otherwise -> return $ FsckFoundMissing badobjs truncated
+			NoFsckOutput
+				| not fsckok -> return FsckFailed
+				| otherwise -> return noproblem
+			-- If all fsck output was duplicateEntries warnings,
+			-- the repository is not broken, it just has some
+			-- unusual tree objects in it. So ignore nonzero
+			-- exit status.
+			AllDuplicateEntriesWarning -> return noproblem
+	go _ _ _ _ = error "internal"
+	
 	maxobjs = 10000
 	noproblem = FsckFoundMissing S.empty False
 
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index b562bff13e..5d8bbf7135 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -136,15 +136,7 @@ indexPath = toInternalGitPath . getTopFilePath
 
 {- Refreshes the index, by checking file stat information.  -}
 refreshIndex :: Repo -> ((FilePath -> IO ()) -> IO ()) -> IO Bool
-refreshIndex repo feeder = do
-	(Just h, _, _, p) <- createProcess (gitCreateProcess params repo)
-		{ std_in = CreatePipe }
-	feeder $ \f -> do
-		hPutStr h f
-		hPutStr h "\0"
-	hFlush h
-	hClose h
-	checkSuccessProcess p
+refreshIndex repo feeder = withCreateProcess p go
   where
 	params = 
 		[ Param "update-index"
@@ -153,3 +145,15 @@ refreshIndex repo feeder = do
 		, Param "-z"
 		, Param "--stdin"
 		]
+	
+	p = (gitCreateProcess params repo)
+		{ std_in = CreatePipe }
+
+	go (Just h) _ _ pid = do
+		feeder $ \f -> do
+			hPutStr h f
+			hPutStr h "\0"
+		hFlush h
+		hClose h
+		checkSuccessProcess pid
+	go _ _ _ _ = error "internal"
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index fda1527115..f51e9e6708 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -164,10 +164,16 @@ store r buprepo = byteStorer $ \k b p -> do
 retrieve :: BupRepo -> Retriever
 retrieve buprepo = byteRetriever $ \k sink -> do
 	let params = bupParams "join" buprepo [Param $ bupRef k]
-	let p = proc "bup" (toCommand params)
-	(_, Just h, _, pid) <- liftIO $ createProcess $ p { std_out = CreatePipe }
-	liftIO (hClose h >> forceSuccessProcess p pid)
-		`after` (sink =<< liftIO (L.hGetContents h))
+	let p = (proc "bup" (toCommand params))
+		{ std_out = CreatePipe }
+	bracketIO (createProcess p) cleanupProcess (go sink p)
+  where
+	go sink p (_, Just h, _, pid) = do
+		() <- sink =<< liftIO (L.hGetContents h)
+		liftIO $ do
+			hClose h
+			forceSuccessProcess p pid
+	go _ _ _ = error "internal"
 
 {- Cannot revert having stored a key in bup, but at least the data for the
  - key will be used for deltaing data of other keys stored later.
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 2cf597660e..de9fe1870a 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -157,10 +157,16 @@ ddarExtractRemoteCall cs ddarrepo k =
 retrieve :: DdarRepo -> Retriever
 retrieve ddarrepo = byteRetriever $ \k sink -> do
 	(cmd, params) <- ddarExtractRemoteCall NoConsumeStdin ddarrepo k
-	let p = (proc cmd $ toCommand params) { std_out = CreatePipe }
-	(_, Just h, _, pid) <- liftIO $ createProcess p
-	liftIO (hClose h >> forceSuccessProcess p pid)
-		`after` (sink =<< liftIO (L.hGetContents h))
+	let p = (proc cmd $ toCommand params)
+		{ std_out = CreatePipe }
+	bracketIO (createProcess p) cleanupProcess (go sink p)
+  where
+	go sink p (_, Just h, _, pid) = do
+		() <- sink =<< liftIO (L.hGetContents h)
+		liftIO $ do
+			hClose h
+			forceSuccessProcess p pid
+	go _ _ _ = error "internal"
 
 remove :: DdarRepo -> Remover
 remove ddarrepo key = do
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index dfba203b6c..a996170a3e 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -185,14 +185,15 @@ retrieve' r k sink = go =<< glacierEnv c gc u
 		]
 	go Nothing = giveup "cannot retrieve from glacier"
 	go (Just environ) = do
-		let cmd = (proc "glacier" (toCommand params))
+		let p = (proc "glacier" (toCommand params))
 			{ env = Just environ
 			, std_out = CreatePipe
 			}
-		(_, Just h, _, pid) <- liftIO $ createProcess cmd
+		bracketIO (createProcess p) cleanupProcess (go' p)
+	go' p (_, Just h, _, pid) = do
 		let cleanup = liftIO $ do
 			hClose h
-			forceSuccessProcess cmd pid
+			forceSuccessProcess p pid
 		flip finally cleanup $ do
 			-- Glacier cannot store empty files, so if
 			-- the output is empty, the content is not
@@ -200,6 +201,7 @@ retrieve' r k sink = go =<< glacierEnv c gc u
 			whenM (liftIO $ hIsEOF h) $
 				giveup "Content is not available from glacier yet. Recommend you wait up to 4 hours, and then run this command again."
 			sink =<< liftIO (L.hGetContents h)
+	go' _ _ = error "internal"
 
 remove :: Remote -> Remover
 remove r k = unlessM go $
diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs
index a371082b56..404fcf362e 100644
--- a/Utility/Gpg.hs
+++ b/Utility/Gpg.hs
@@ -171,16 +171,19 @@ pipeLazy (GpgCmd cmd) params feeder reader = do
 		, std_out = CreatePipe
 		, std_err = Inherit
 		}
-	bracket (setup p) (cleanup p) go
+	bracket (setup p) cleanup (go p)
   where
 	setup = liftIO . createProcess
-	cleanup p (_, _, _, pid) = liftIO $ forceSuccessProcess p pid
-	go p = do
-		let (to, from) = ioHandles p
+	cleanup = liftIO . cleanupProcess
+
+	go p (Just to, Just from, _, pid) = do
 		liftIO $ void $ forkIO $ do
 			feeder to
 			hClose to
-		reader from
+		r <- reader from
+		liftIO $ forceSuccessProcess p pid
+		return r
+	go _ _ = error "internal"
 
 {- Finds gpg public keys matching some string. (Could be an email address,
  - a key id, or a name; See the section 'HOW TO SPECIFY A USER ID' of
diff --git a/Utility/Lsof.hs b/Utility/Lsof.hs
index 22d4a0ebfb..5803dcd7f3 100644
--- a/Utility/Lsof.hs
+++ b/Utility/Lsof.hs
@@ -49,11 +49,16 @@ queryDir path = query ["+d", path]
  - Note: If lsof is not available, this always returns [] !
  -}
 query :: [String] -> IO [(FilePath, LsofOpenMode, ProcessInfo)]
-query opts =
-	withHandle StdoutHandle (createProcessChecked checkSuccessProcess) p $
-		parse <$$> hGetContentsStrict
+query opts = withCreateProcess p go
   where
-	p = proc "lsof" ("-F0can" : opts)
+	p = (proc "lsof" ("-F0can" : opts))
+		{ std_out = CreatePipe }
+	
+	go _ (Just outh) _ pid = do
+		r <- parse <$> hGetContentsStrict outh
+		void $ waitForProcess pid
+		return r
+	go _ _ _ _ = error "internal"
 
 type LsofParser = String -> [(FilePath, LsofOpenMode, ProcessInfo)]
 
diff --git a/Utility/Process.hs b/Utility/Process.hs
index 83229a8051..d7e84c7fd4 100644
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -20,7 +20,6 @@ module Utility.Process (
 	forceSuccessProcess,
 	forceSuccessProcess',
 	checkSuccessProcess,
-	ignoreFailureProcess,
 	createProcessSuccess,
 	createProcessChecked,
 	createBackgroundProcess,
@@ -53,7 +52,6 @@ import System.Log.Logger
 import Control.Monad.IO.Class
 import Control.Concurrent
 import qualified Control.Exception as E
-import Control.Monad
 import qualified Data.ByteString as S
 
 type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a
@@ -135,11 +133,6 @@ checkSuccessProcess pid = do
 	code <- waitForProcess pid
 	return $ code == ExitSuccess
 
-ignoreFailureProcess :: ProcessHandle -> IO Bool
-ignoreFailureProcess pid = do
-	void $ waitForProcess pid
-	return True
-
 -- | Runs createProcess, then an action on its handles, and then
 -- forceSuccessProcess.
 createProcessSuccess :: CreateProcessRunner