diff options
| -rw-r--r-- | Remote/Directory.hs | 2 | ||||
| -rw-r--r-- | Remote/Helper/Chunked.hs | 14 | ||||
| -rw-r--r-- | Remote/Helper/ChunkedEncryptable.hs | 10 |
3 files changed, 18 insertions, 8 deletions
diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 6b6a4b1ce..2ebf608cb 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 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' -> |