diff options
| -rw-r--r-- | Annex/Content.hs | 1 | ||||
| -rw-r--r-- | Remote/Helper/Chunked.hs | 25 | ||||
| -rw-r--r-- | Remote/Helper/ChunkedEncryptable.hs | 37 | ||||
| -rw-r--r-- | Types/StoreRetrieve.hs | 27 |
4 files changed, 53 insertions, 37 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 6975f322f..eb84f2fe9 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -16,6 +16,7 @@ module Annex.Content ( getViaTmpChecked, getViaTmpUnchecked, prepGetViaTmpChecked, + prepTmp, withTmp, checkDiskSpace, moveAnnex, diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index 102ced8f4..ae949abc3 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -249,26 +249,28 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink let p = maybe basep (offsetMeterUpdate basep . toBytesProcessed) offset - v <- tryNonAsyncAnnex $ retriever (encryptor k) p - case v of - Left e - | null ls -> giveup e - | otherwise -> firstavail currsize ls - Right content -> do + v <- tryNonAsyncAnnex $ + retriever (encryptor k) p $ \content -> bracketIO (maybe opennew openresume offset) hClose $ \h -> do tosink h p content let sz = toBytesProcessed $ fromMaybe 0 $ keyChunkSize k getrest p h sz sz ks + `catchNonAsyncAnnex` giveup + case v of + Left e + | null ls -> giveup e + | otherwise -> firstavail currsize ls + Right r -> return r getrest _ _ _ _ [] = return True getrest p h sz bytesprocessed (k:ks) = do let p' = offsetMeterUpdate p bytesprocessed - tosink h p' =<< retriever (encryptor k) p' + retriever (encryptor k) p' $ tosink h p' getrest p h sz (addBytesProcessed bytesprocessed sz) ks getunchunked = bracketIO opennew hClose $ \h -> do - tosink h basep =<< retriever (encryptor basek) basep + retriever (encryptor basek) basep $ tosink h basep return True opennew = openBinaryFile dest WriteMode @@ -288,10 +290,13 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink - it is not responsible for updating progress (often it cannot). - Instead, the sink is passed a meter to update as it consumes - the ByteString. -} - tosink h p (ByteContent b) = liftIO $ + tosink h p (ByteContent b) = liftIO $ do sink h (Just p) b - tosink h _ (FileContent f) = liftIO $ + return True + tosink h _ (FileContent f) = liftIO $ do sink h Nothing =<< L.readFile f + nukeFile h + return True {- Can resume when the chunk's offset is at or before the end of - the dest file. -} diff --git a/Remote/Helper/ChunkedEncryptable.hs b/Remote/Helper/ChunkedEncryptable.hs index 024a53309..550a6934b 100644 --- a/Remote/Helper/ChunkedEncryptable.hs +++ b/Remote/Helper/ChunkedEncryptable.hs @@ -6,8 +6,6 @@ -} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ImpredicativeTypes #-} -{-# LANGUAGE FlexibleContexts #-} module Remote.Helper.ChunkedEncryptable ( Preparer, @@ -39,17 +37,48 @@ import Annex.Exception import qualified Data.ByteString.Lazy as L +-- Use when nothing needs to be done to prepare a helper. simplyPrepare :: helper -> Preparer helper simplyPrepare helper _ a = a $ Just helper +-- Use to run a check when preparing a helper. checkPrepare :: (Key -> Annex Bool) -> helper -> Preparer helper checkPrepare checker helper k a = ifM (checker k) ( a (Just helper) , a Nothing ) -{- Modifies a base Remote to support both chunking and encryption. - -} +-- A Storer that expects to be provided with a file containing +-- the content of the key to store. +fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex Bool) -> Storer +fileStorer a k (FileContent f) m = a k f m +fileStorer a k (ByteContent b) m = withTmp k $ \f -> do + liftIO $ L.writeFile f b + a k f m + +-- A Storer that expects to be provided with a L.ByteString of +-- the content to store. +byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex Bool) -> Storer +byteStorer a k c m = withBytes c $ \b -> a k b m + +-- A Retriever that writes the content of a Key to a provided file. +-- It is responsible for updating the progress meter as it retrieves data. +fileRetriever :: (FilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever +fileRetriever a k m callback = bracketAnnex (prepTmp k) (liftIO . nukeFile) go + where + go f = do + a f k m + callback (FileContent f) + +-- A Retriever that generates a L.ByteString containing the Key's content. +byteRetriever :: (Key -> Annex L.ByteString) -> Retriever +byteRetriever a k _m callback = callback =<< (ByteContent <$> a k) + +withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a +withBytes (ByteContent b) a = a b +withBytes (FileContent f) a = a =<< liftIO (L.readFile f) + +-- Modifies a base Remote to support both chunking and encryption. chunkedEncryptableRemote :: RemoteConfig -> Preparer Storer diff --git a/Types/StoreRetrieve.hs b/Types/StoreRetrieve.hs index dfee20758..0ee2fd501 100644 --- a/Types/StoreRetrieve.hs +++ b/Types/StoreRetrieve.hs @@ -1,4 +1,4 @@ -{- Types for Storer and Retriever +{- Types for Storer and Retriever actions for remotes. - - Copyright 2014 Joey Hess <joey@kitenet.net> - @@ -10,7 +10,6 @@ module Types.StoreRetrieve where import Common.Annex -import Annex.Content import Utility.Metered import qualified Data.ByteString.Lazy as L @@ -28,25 +27,7 @@ data ContentSource -- Can throw exceptions. type Storer = Key -> ContentSource -> MeterUpdate -> Annex Bool --- Action that retrieves a Key's content from a remote. +-- Action that retrieves a Key's content from a remote, passing it to a +-- callback. -- Throws exception if key is not present, or remote is not accessible. -type Retriever = Key -> MeterUpdate -> Annex ContentSource - -fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex Bool) -> Storer -fileStorer a k (FileContent f) m = a k f m -fileStorer a k (ByteContent b) m = withTmp k $ \tmp -> do - liftIO $ L.writeFile tmp b - a k tmp m - -byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex Bool) -> Storer -byteStorer a k c m = withBytes c $ \b -> a k b m - -fileRetriever :: (Key -> MeterUpdate -> Annex FilePath) -> Retriever -fileRetriever a k m = FileContent <$> a k m - -byteRetriever :: (Key -> Annex L.ByteString) -> Retriever -byteRetriever a k _m = ByteContent <$> a k - -withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a -withBytes (ByteContent b) a = a b -withBytes (FileContent f) a = a =<< liftIO (L.readFile f) +type Retriever = Key -> MeterUpdate -> (ContentSource -> Annex Bool) -> Annex Bool |