Display progress meter in -J mode when downloading from the web.

Including in addurl, and get --from web, but also in S3 and External
special remotes when a web url is known for content in those remotes.

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 :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Annex Bool
-downloadUrl urls file = go =<< annexWebDownloadCommand <$> Annex.getGitConfig
+downloadUrl k p urls file = 
+	concurrentMetered (Just p) k $ \p' ->
+		watchFileSize file p' $
+			go =<< annexWebDownloadCommand <$> Annex.getGitConfig
   where
 	go Nothing = do
 		a <- ifM commandProgressDisabled

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
 

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 :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
-metered combinemeterupdate key _af a = case keySize key of
+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 :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
-concurrentMetered combinemeterupdate key af a = withOutputType go
+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. -}

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

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

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
+		{ storeKey = \k _f p -> cip >>= storeKeyGen k p
-		, retrieveKeyFile = \k f d p -> cip >>= unVerified . retrieveKeyFileGen k f d 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 p k a
-		| displayProgress cfg = metered (Just p) k f a
+		| displayProgress cfg = metered (Just p) k a
 		| otherwise = a p
 
 {- Sink callback for retrieveChunks. Stores the file content into the

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 ->
+	Just geturl -> fileRetriever $ \f k p ->
-		unlessM (downloadUrl [geturl k] f) $
+		unlessM (downloadUrl k p [geturl k] f) $
 			error "failed to download content"
 
 retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool

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

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