summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-11-18 22:20:43 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-11-18 22:20:43 -0400
commit2197d254e8b340b4a84f1d273c785d2d729b9b83 (patch)
treeeda957dafab5805e7373c18a8f37b9620e71e836
parent3d6fb239dd88ec7f105b8066b5c5476bb9c2aeec (diff)
S3: upload progress display
-rw-r--r--Messages.hs15
-rw-r--r--Remote/S3.hs32
2 files changed, 30 insertions, 17 deletions
diff --git a/Messages.hs b/Messages.hs
index 055b561dd..bb91653da 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -11,6 +11,7 @@ module Messages (
showAction,
showProgress,
metered,
+ meteredBytes,
showSideAction,
doSideAction,
doQuietSideAction,
@@ -63,9 +64,17 @@ showProgress = handle q $
{- Shows a progress meter while performing a transfer of a key.
- The action is passed a callback to use to update the meter. -}
metered :: (Maybe MeterUpdate) -> Key -> (MeterUpdate -> Annex a) -> Annex a
-metered combinemeterupdate key a = withOutputType $ go (keySize key)
+metered combinemeterupdate key a = go (keySize key)
where
- go (Just size) NormalOutput = do
+ go (Just size) = meteredBytes combinemeterupdate size a
+ go _ = a (const noop)
+
+{- Shows a progress meter while performing an action on a given number
+ - of bytes. -}
+meteredBytes :: (Maybe MeterUpdate) -> Integer -> (MeterUpdate -> Annex a) -> Annex a
+meteredBytes combinemeterupdate size a = withOutputType go
+ where
+ go NormalOutput = do
progress <- liftIO $ newProgress "" size
meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1)
showOutput
@@ -76,7 +85,7 @@ metered combinemeterupdate key a = withOutputType $ go (keySize key)
maybe noop (\m -> m n) combinemeterupdate
liftIO $ clearMeter stdout meter
return r
- go _ _ = a (const noop)
+ go _ = a (const noop)
showSideAction :: String -> Annex ()
showSideAction m = Annex.getState Annex.output >>= go
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 54136f8a0..5905f14fc 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -24,6 +24,7 @@ import Remote.Helper.Special
import Remote.Helper.Encryptable
import Crypto
import Creds
+import Meters
import Annex.Content
remote :: RemoteType
@@ -111,38 +112,41 @@ s3Setup u c = handlehost $ M.lookup "host" c
M.delete "bucket" defaults
store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store r k _f _p = s3Action r False $ \(conn, bucket) -> do
+store r k _f p = s3Action r False $ \(conn, bucket) -> do
src <- inRepo $ gitAnnexLocation k
- res <- liftIO $ storeHelper (conn, bucket) r k src
+ res <- storeHelper (conn, bucket) r k p src
s3Bool res
storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r (cipher, enck) k _p = s3Action r False $ \(conn, bucket) ->
+storeEncrypted r (cipher, enck) k p = s3Action r False $ \(conn, bucket) ->
-- To get file size of the encrypted content, have to use a temp file.
-- (An alternative would be chunking to to a constant size.)
withTmp enck $ \tmp -> do
f <- inRepo $ gitAnnexLocation k
liftIO $ encrypt cipher (feedFile f) $
readBytes $ L.writeFile tmp
- res <- liftIO $ storeHelper (conn, bucket) r enck tmp
+ res <- storeHelper (conn, bucket) r enck p tmp
s3Bool res
-storeHelper :: (AWSConnection, String) -> Remote -> Key -> FilePath -> IO (AWSResult ())
-storeHelper (conn, bucket) r k file = do
- content <- liftIO $ L.readFile file
- -- size is provided to S3 so the whole content does not need to be
- -- buffered to calculate it
+storeHelper :: (AWSConnection, String) -> Remote -> Key -> MeterUpdate -> FilePath -> Annex (AWSResult ())
+storeHelper (conn, bucket) r k p file = do
size <- maybe getsize (return . fromIntegral) $ keySize k
- let object = setStorageClass storageclass $
- S3Object bucket (bucketFile r k) ""
- (("Content-Length", show size) : xheaders) content
- sendObject conn object
+ meteredBytes (Just p) size $ \meterupdate ->
+ liftIO $ withMeteredFile file meterupdate $ \content -> do
+ -- size is provided to S3 so the whole content
+ -- does not need to be buffered to calculate it
+ let object = setStorageClass storageclass $ S3Object
+ bucket (bucketFile r k) ""
+ (("Content-Length", show size) : xheaders)
+ content
+ sendObject conn object
where
storageclass =
case fromJust $ M.lookup "storageclass" $ fromJust $ config r of
"REDUCED_REDUNDANCY" -> REDUCED_REDUNDANCY
_ -> STANDARD
- getsize = fileSize <$> (liftIO $ getFileStatus file)
+
+ getsize = liftIO $ fromIntegral . fileSize <$> getFileStatus file
xheaders = filter isxheader $ M.assocs $ fromJust $ config r
isxheader (h, _) = "x-amz-" `isPrefixOf` h