S3: Added progress display for uploading and downloading.

4 files changed, 27 insertions, 38 deletions

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