From 9a8c4bb21f99cee000b99be9e629513def6a459c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 26 Jul 2014 23:26:10 -0400
Subject: [PATCH] improve exception handling

Push it down from needing to be done in every Storer,
to being checked once inside ChunkedEncryptable.

Also, catch exceptions from PrepareStorer and PrepareRetriever,
just in case..
---
 Remote/Directory.hs                 |  2 +-
 Remote/Helper/Chunked.hs            | 14 +++++++++-----
 Remote/Helper/ChunkedEncryptable.hs | 10 ++++++++--
 3 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 6b6a4b1cec..2ebf608cb0 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -117,7 +117,7 @@ store d chunkconfig k b p = do
 	void $ tryIO $ createDirectoryIfMissing True tmpdir
 	case chunkconfig of
 		LegacyChunks chunksize -> Legacy.store chunksize finalizer k b p tmpdir destdir
-		_ -> flip catchNonAsync (\e -> warningIO (show e) >> return False) $ do
+		_ -> do
 			let tmpf = tmpdir </> keyFile k
 			meteredWriteFile p tmpf b
 			finalizer tmpdir destdir
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 5fa6c55efa..3eab0947a7 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -70,12 +70,16 @@ numChunks = pred . fromJust . keyChunkNum . fst . nextChunkKeyStream
  - the storer action, along with a corresponding chunk key and a
  - progress meter update callback.
  -
- - Note that the storer action is responsible for catching any
- - exceptions it may encounter.
- -
  - This action may be called on a chunked key. It will simply store it.
  -}
-storeChunks :: UUID -> ChunkConfig -> Key -> FilePath -> MeterUpdate -> (Key -> L.ByteString -> MeterUpdate -> IO Bool) -> Annex Bool
+storeChunks
+	:: UUID
+	-> ChunkConfig
+	-> Key
+	-> FilePath
+	-> MeterUpdate
+	-> (Key -> L.ByteString -> MeterUpdate -> IO Bool)
+	-> Annex Bool
 storeChunks u chunkconfig k f p storer = metered (Just p) k $ \meterupdate ->
 	either (\e -> warning (show e) >> return False) (go meterupdate)
 		=<< (liftIO $ tryIO $ L.readFile f)
@@ -188,7 +192,7 @@ retrieveChunks
 	-> Annex Bool
 retrieveChunks retriever u chunkconfig encryptor basek basep sink = do
 	ls <- chunkKeys u chunkconfig basek
-	liftIO $ flip catchNonAsync giveup (firstavail ls)
+	liftIO $ firstavail ls `catchNonAsync` giveup
   where
 	giveup e = do
 		warningIO (show e)
diff --git a/Remote/Helper/ChunkedEncryptable.hs b/Remote/Helper/ChunkedEncryptable.hs
index 740da58b91..cfa92406e7 100644
--- a/Remote/Helper/ChunkedEncryptable.hs
+++ b/Remote/Helper/ChunkedEncryptable.hs
@@ -29,12 +29,15 @@ import Annex.Content
 import Annex.Exception
 
 -- Prepares to store a Key, and returns a Storer action if possible.
+-- May throw exceptions.
 type PrepareStorer = Key -> Annex (Maybe Storer)
 
 -- Stores a Key, which may be encrypted and/or a chunk key.
+-- May throw exceptions.
 type Storer = Key -> L.ByteString -> MeterUpdate -> IO Bool
 
 -- Prepares to retrieve a Key, and returns a Retriever action if possible.
+-- May throw exceptions.
 type PrepareRetriever = Key -> Annex (Maybe Retriever)
 
 -- Retrieves a Key, which may be encrypted and/or a chunk key.
@@ -68,8 +71,11 @@ chunkedEncryptableRemote c preparestorer prepareretriever r = encr
 	chunkconfig = chunkConfig c
 	gpgopts = getGpgEncParams encr
 
+	safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False)
+
 	-- chunk, then encrypt, then feed to the storer
-	storeKeyGen k p enc = maybe (return False) go =<< preparestorer k
+	storeKeyGen k p enc = safely $
+		maybe (return False) go =<< preparestorer k
 	  where
 		go storer = sendAnnex k rollback $ \src ->
 			metered (Just p) k $ \p' ->
@@ -84,7 +90,7 @@ chunkedEncryptableRemote c preparestorer prepareretriever r = encr
 						storer (enck k') encb p'
 
 	-- call retriever to get chunks; decrypt them; stream to dest file
-	retrieveKeyFileGen k dest p enc =
+	retrieveKeyFileGen k dest p enc = safely $
 		maybe (return False) go =<< prepareretriever k
 	  where
 	  	go retriever = metered (Just p) k $ \p' ->