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..

2 files changed, 17 insertions, 7 deletions

diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 5fa6c55ef..3eab0947a 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 740da58b9..cfa92406e 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' ->