summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Content.hs8
-rw-r--r--Command/AddUrl.hs8
-rw-r--r--Messages/Progress.hs10
-rw-r--r--Remote/External.hs4
-rw-r--r--Remote/Git.hs9
-rw-r--r--Remote/Helper/Special.hs16
-rw-r--r--Remote/S3.hs4
-rw-r--r--Remote/Web.hs6
-rw-r--r--debian/changelog1
9 files changed, 36 insertions, 30 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 5990d194a..90486f912 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -56,6 +56,7 @@ import qualified Annex.Url as Url
import Types.Key
import Utility.DataUnits
import Utility.CopyFile
+import Utility.Metered
import Config
import Git.SharedRepository
import Annex.Perms
@@ -658,8 +659,11 @@ saveState nocommit = doSideAction $ do
Annex.Branch.commit "update"
{- Downloads content from any of a list of urls. -}
-downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool
-downloadUrl urls file = go =<< annexWebDownloadCommand <$> Annex.getGitConfig
+downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Annex Bool
+downloadUrl k p urls file =
+ concurrentMetered (Just p) k $ \p' ->
+ watchFileSize file p' $
+ go =<< annexWebDownloadCommand <$> Annex.getGitConfig
where
go Nothing = do
a <- ifM commandProgressDisabled
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 6ed4fb2e2..78313f538 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -252,9 +252,9 @@ addUrlFileQuvi relaxed quviurl videourl file = do
tmp <- fromRepo $ gitAnnexTmpObjectLocation key
showOutput
ok <- Transfer.notifyTransfer Transfer.Download (Just file) $
- Transfer.download webUUID key (Just file) Transfer.forwardRetry Transfer.noObserver $ const $ do
+ Transfer.download webUUID key (Just file) Transfer.forwardRetry Transfer.noObserver $ \p -> do
liftIO $ createDirectoryIfMissing True (parentDir tmp)
- downloadUrl [videourl] tmp
+ downloadUrl key p [videourl] tmp
if ok
then do
cleanup webUUID quviurl file key (Just tmp)
@@ -294,9 +294,9 @@ addUrlFile relaxed url urlinfo file = do
downloadWeb :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
downloadWeb url urlinfo file = do
let dummykey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing
- let downloader f _ = do
+ let downloader f p = do
showOutput
- downloadUrl [url] f
+ downloadUrl dummykey p [url] f
showAction $ "downloading " ++ url ++ " "
downloadWith downloader dummykey webUUID url file
diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index 24a68c922..c14e7e6b1 100644
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -29,8 +29,8 @@ import Data.Quantity
{- 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 -> AssociatedFile -> (MeterUpdate -> Annex a) -> Annex a
-metered combinemeterupdate key _af a = case keySize key of
+metered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
+metered combinemeterupdate key a = case keySize key of
Nothing -> nometer
Just size -> withOutputType (go $ fromInteger size)
where
@@ -66,10 +66,10 @@ metered combinemeterupdate key _af a = case keySize key of
{- Use when the progress meter is only desired for concurrent
- output; as when a command's own progress output is preferred. -}
-concurrentMetered :: Maybe MeterUpdate -> Key -> AssociatedFile -> (MeterUpdate -> Annex a) -> Annex a
-concurrentMetered combinemeterupdate key af a = withOutputType go
+concurrentMetered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
+concurrentMetered combinemeterupdate key a = withOutputType go
where
- go (ConcurrentOutput _) = metered combinemeterupdate key af a
+ go (ConcurrentOutput _) = metered combinemeterupdate key a
go _ = a (fromMaybe (const noop) combinemeterupdate)
{- Progress dots. -}
diff --git a/Remote/External.hs b/Remote/External.hs
index 68237b939..897a6a72b 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -503,9 +503,9 @@ checkurl external url =
mkmulti (u, s, f) = (u, s, mkSafeFilePath f)
retrieveUrl :: Retriever
-retrieveUrl = fileRetriever $ \f k _p -> do
+retrieveUrl = fileRetriever $ \f k p -> do
us <- getWebUrls k
- unlessM (downloadUrl us f) $
+ unlessM (downloadUrl k p us f) $
error "failed to download content"
checkKeyUrl :: Git.Repo -> CheckPresent
diff --git a/Remote/Git.hs b/Remote/Git.hs
index d410db02f..890e40b51 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -421,7 +421,7 @@ lockKey r key callback
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
-copyFromRemote r key file dest p = concurrentMetered (Just p) key file $
+copyFromRemote r key file dest p = concurrentMetered (Just p) key $
copyFromRemote' r key file dest
copyFromRemote' :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
@@ -445,7 +445,8 @@ copyFromRemote' r key file dest meterupdate
direct <- isDirect
Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p))
=<< Ssh.rsyncParamsRemote direct r Download key dest file
- | Git.repoIsHttp (repo r) = unVerified $ Annex.Content.downloadUrl (keyUrls r key) dest
+ | Git.repoIsHttp (repo r) = unVerified $
+ Annex.Content.downloadUrl key meterupdate (keyUrls r key) dest
| otherwise = error "copying from non-ssh, non-http remote not supported"
where
{- Feed local rsync's progress info back to the remote,
@@ -522,7 +523,7 @@ copyFromRemoteCheap r key af file
)
| Git.repoIsSsh (repo r) =
ifM (Annex.Content.preseedTmp key file)
- ( fst <$> concurrentMetered Nothing key af
+ ( fst <$> concurrentMetered Nothing key
(copyFromRemote' r key af file)
, return False
)
@@ -534,7 +535,7 @@ copyFromRemoteCheap _ _ _ _ = return False
{- Tries to copy a key's content to a remote's annex. -}
copyToRemote :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
copyToRemote r key file meterupdate =
- concurrentMetered (Just meterupdate) key file $
+ concurrentMetered (Just meterupdate) key $
copyToRemote' r key file
copyToRemote' :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 7faf7a8a1..d586d8c0a 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -155,8 +155,8 @@ specialRemote' :: SpecialRemoteCfg -> RemoteModifier
specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckpresent baser = encr
where
encr = baser
- { storeKey = \k f p -> cip >>= storeKeyGen k f p
- , retrieveKeyFile = \k f d p -> cip >>= unVerified . retrieveKeyFileGen k f d p
+ { storeKey = \k _f p -> cip >>= storeKeyGen k p
+ , retrieveKeyFile = \k _f d p -> cip >>= unVerified . retrieveKeyFileGen k d p
, retrieveKeyFileCheap = \k f d -> cip >>= maybe
(retrieveKeyFileCheap baser k f d)
-- retrieval of encrypted keys is never cheap
@@ -183,12 +183,12 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
safely a = catchNonAsync a (\e -> warning (show e) >> return False)
-- chunk, then encrypt, then feed to the storer
- storeKeyGen k f p enc = safely $ preparestorer k $ safely . go
+ storeKeyGen k p enc = safely $ preparestorer k $ safely . go
where
go (Just storer) = preparecheckpresent k $ safely . go' storer
go Nothing = return False
go' storer (Just checker) = sendAnnex k rollback $ \src ->
- displayprogress p k f $ \p' ->
+ displayprogress p k $ \p' ->
storeChunks (uuid baser) chunkconfig k src p'
(storechunk enc storer)
checker
@@ -204,10 +204,10 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
storer (enck k) (ByteContent encb) p
-- call retriever to get chunks; decrypt them; stream to dest file
- retrieveKeyFileGen k f dest p enc =
+ retrieveKeyFileGen k dest p enc =
safely $ prepareretriever k $ safely . go
where
- go (Just retriever) = displayprogress p k f $ \p' ->
+ go (Just retriever) = displayprogress p k $ \p' ->
retrieveChunks retriever (uuid baser) chunkconfig
enck k dest p' (sink dest enc)
go Nothing = return False
@@ -227,8 +227,8 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
chunkconfig = chunkConfig cfg
- displayprogress p k f a
- | displayProgress cfg = metered (Just p) k f a
+ displayprogress p k a
+ | displayProgress cfg = metered (Just p) k a
| otherwise = a p
{- Sink callback for retrieveChunks. Stores the file content into the
diff --git a/Remote/S3.hs b/Remote/S3.hs
index fb772825c..ba30bffeb 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -249,8 +249,8 @@ retrieve r info Nothing = case getpublicurl info of
Nothing -> \_ _ _ -> do
warnMissingCredPairFor "S3" (AWS.creds $ uuid r)
return False
- Just geturl -> fileRetriever $ \f k _p ->
- unlessM (downloadUrl [geturl k] f) $
+ Just geturl -> fileRetriever $ \f k p ->
+ unlessM (downloadUrl k p [geturl k] f) $
error "failed to download content"
retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 257eba2e1..143bdb997 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -72,7 +72,7 @@ gen r _ c gc =
}
downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
-downloadKey key _file dest _p = unVerified $ get =<< getWebUrls key
+downloadKey key _af dest p = unVerified $ get =<< getWebUrls key
where
get [] = do
warning "no known url"
@@ -84,13 +84,13 @@ downloadKey key _file dest _p = unVerified $ get =<< getWebUrls key
case downloader of
QuviDownloader -> do
#ifdef WITH_QUVI
- flip downloadUrl dest
+ flip (downloadUrl key p) dest
=<< withQuviOptions Quvi.queryLinks [Quvi.httponly, Quvi.quiet] u'
#else
warning "quvi support needed for this url"
return False
#endif
- _ -> downloadUrl [u'] dest
+ _ -> downloadUrl key p [u'] dest
downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
downloadKeyCheap _ _ _ = return False
diff --git a/debian/changelog b/debian/changelog
index 53a20717c..4231f9989 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,7 @@ git-annex (5.20151117) UNRELEASED; urgency=medium
* Build with -j1 again to get reproducible build.
* Display progress meter in -J mode when copying from a local git repo,
to a local git repo, and from a remote git repo.
+ * Display progress meter in -J mode when downloading from the web.
-- Joey Hess <id@joeyh.name> Mon, 16 Nov 2015 16:49:34 -0400
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-06 02:20:40 +0000