diff options
| -rw-r--r-- | Meters.hs | 19 | ||||
| -rw-r--r-- | Remote/Directory.hs | 3 | ||||
| -rw-r--r-- | Remote/Helper/Chunked.hs | 27 | ||||
| -rw-r--r-- | Remote/S3.hs | 33 | ||||
| -rw-r--r-- | Remote/WebDAV.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | doc/design/assistant/progressbars.mdwn | 2 |
7 files changed, 46 insertions, 41 deletions
@@ -12,6 +12,7 @@ import Types.Meters import Utility.Observed import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as S {- Sends the content of a file to an action, updating the meter as it's - consumed. -} @@ -21,5 +22,19 @@ withMeteredFile f meterupdate a = withBinaryFile f ReadMode $ \h -> {- Sends the content of a file to a Handle, updating the meter as it's - written. -} -sendMeteredFile :: FilePath -> MeterUpdate -> Handle -> IO () -sendMeteredFile f meterupdate h = withMeteredFile f meterupdate $ L.hPut h +streamMeteredFile :: FilePath -> MeterUpdate -> Handle -> IO () +streamMeteredFile f meterupdate h = withMeteredFile f meterupdate $ L.hPut h + +{- Writes a ByteString to a Handle, updating a meter as it's written. -} +meteredWrite :: MeterUpdate -> Handle -> L.ByteString -> IO () +meteredWrite meterupdate h = go . L.toChunks + where + go [] = return () + go (c:cs) = do + S.hPut h c + meterupdate $ toInteger $ S.length c + go cs + +meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO () +meteredWriteFile meterupdate f b = withBinaryFile f WriteMode $ \h -> + meteredWrite meterupdate h b diff --git a/Remote/Directory.hs b/Remote/Directory.hs index a61ef83c0..01dc00c8f 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -11,6 +11,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S import qualified Data.Map as M import qualified Control.Exception as E +import Data.Int import Common.Annex import Types.Remote @@ -21,8 +22,8 @@ import Remote.Helper.Special import Remote.Helper.Encryptable import Remote.Helper.Chunked import Crypto -import Data.Int import Annex.Content +import Meters remote :: RemoteType remote = RemoteType { diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index f6a4308b3..e609e6354 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -10,10 +10,10 @@ module Remote.Helper.Chunked where import Common.Annex import Utility.DataUnits import Types.Remote +import Meters import qualified Data.Map as M import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString as S import Data.Int import qualified Control.Exception as E @@ -121,25 +121,10 @@ storeChunked chunksize dests storer content = storer d chunk storechunks sz (d:useddests) ds b' -{- Write a L.ByteString to a file, updating a progress meter - - after each chunk of the L.ByteString, typically every 64 kb or so. -} -meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO () -meteredWriteFile meterupdate dest b = - meteredWriteFileChunks meterupdate dest [b] return - -{- Writes a series of major chunks to a file. The feeder is called to get - - each major chunk. Then each chunk of the L.ByteString is written, - - with the meter updated after each chunk. -} +{- Writes a series of chunks to a file. The feeder is called to get + - each chunk. -} meteredWriteFileChunks :: MeterUpdate -> FilePath -> [v] -> (v -> IO L.ByteString) -> IO () meteredWriteFileChunks meterupdate dest chunks feeder = - E.bracket (openFile dest WriteMode) hClose (feed chunks []) - where - feed [] [] _ = noop - feed (c:cs) [] h = do - bs <- L.toChunks <$> feeder c - unless (null bs) $ - feed cs bs h - feed cs (b:bs) h = do - S.hPut h b - meterupdate $ toInteger $ S.length b - feed cs bs h + withBinaryFile dest WriteMode $ \h -> + forM_ chunks $ \c -> + meteredWrite meterupdate h =<< feeder c diff --git a/Remote/S3.hs b/Remote/S3.hs index 5905f14fc..ca4161c15 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -152,26 +152,29 @@ storeHelper (conn, bucket) r k p file = do isxheader (h, _) = "x-amz-" `isPrefixOf` h retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool -retrieve r k _f d = s3Action r False $ \(conn, bucket) -> do - res <- liftIO $ getObject conn $ bucketKey r bucket k - case res of - Right o -> do - liftIO $ L.writeFile d $ obj_data o - return True - Left e -> s3Warning e +retrieve r k _f d = s3Action r False $ \(conn, bucket) -> + metered Nothing k $ \meterupdate -> do + res <- liftIO $ getObject conn $ bucketKey r bucket k + case res of + Right o -> do + liftIO $ meteredWriteFile meterupdate d $ + obj_data o + return True + Left e -> s3Warning e retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool retrieveCheap _ _ _ = return False retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool -retrieveEncrypted r (cipher, enck) _ f = s3Action r False $ \(conn, bucket) -> do - res <- liftIO $ getObject conn $ bucketKey r bucket enck - case res of - Right o -> liftIO $ decrypt cipher (feedBytes $ obj_data o) $ - readBytes $ \content -> do - L.writeFile f content - return True - Left e -> s3Warning e +retrieveEncrypted r (cipher, enck) k d = s3Action r False $ \(conn, bucket) -> + metered Nothing k $ \meterupdate -> do + res <- liftIO $ getObject conn $ bucketKey r bucket enck + case res of + Right o -> liftIO $ decrypt cipher (\h -> meteredWrite meterupdate h $ obj_data o) $ + readBytes $ \content -> do + L.writeFile d content + return True + Left e -> s3Warning e remove :: Remote -> Key -> Annex Bool remove r k = s3Action r False $ \(conn, bucket) -> do diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index e7da3af19..12f0f55a6 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -97,7 +97,7 @@ storeEncrypted r (cipher, enck) k p = metered (Just p) k $ \meterupdate -> davAction r False $ \(baseurl, user, pass) -> do let url = davLocation baseurl enck f <- inRepo $ gitAnnexLocation k - liftIO $ encrypt cipher (sendMeteredFile f meterupdate) $ + liftIO $ encrypt cipher (streamMeteredFile f meterupdate) $ readBytes $ storeHelper r url user pass storeHelper :: Remote -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool diff --git a/debian/changelog b/debian/changelog index b1547a813..048d81fed 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,6 +9,7 @@ git-annex (3.20121113) UNRELEASED; urgency=low * OSX: Fix RunAtLoad value in plist file. * Getting a file from chunked directory special remotes no longer buffers it all in memory. + * S3: Added progress display for uploading and downloading. -- Joey Hess <joeyh@debian.org> Tue, 13 Nov 2012 13:17:07 -0400 diff --git a/doc/design/assistant/progressbars.mdwn b/doc/design/assistant/progressbars.mdwn index 37dfe6f8c..5109f8ec6 100644 --- a/doc/design/assistant/progressbars.mdwn +++ b/doc/design/assistant/progressbars.mdwn @@ -23,7 +23,7 @@ the MeterUpdate callback as the upload progresses. * directory: **done** * web: Not applicable; does not upload * webdav: **done** -* S3: TODO +* S3: **done** * bup: TODO * hook: Would require the hook interface to somehow do this, which seems too complicated. So skipping. |