connect existing meters to the transfer log for downloads

Most remotes have meters in their implementations of retrieveKeyFile
already. Simply hooking these up to the transfer log makes that information
available. Easy peasy.

This is particularly valuable information for encrypted remotes, which
otherwise bypass the assistant's polling of temp files, and so don't have
good progress bars yet.

Still some work to do here (see progressbars.mdwn changes), but this
is entirely an improvement from the lack of progress bars for encrypted
downloads.

Command/AddUrl.hs

@@ -114,7 +114,7 @@ download url file = do
 			)
 		return $ Backend.URL.fromUrl url size
   	runtransfer dummykey tmp = 
-		Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ do
+		Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ const $ do
 			liftIO $ createDirectoryIfMissing True (parentDir tmp)
 			downloadUrl [url] tmp
 		

Command/Fsck.hs

@@ -150,9 +150,10 @@ performRemote key file backend numcopies remote =
 			( return True
 			, ifM (Annex.getState Annex.fast)
 				( return False
-				, Remote.retrieveKeyFile remote key Nothing tmp
+				, Remote.retrieveKeyFile remote key Nothing tmp dummymeter
 				)
 			)
+	dummymeter _ = noop
 
 {- To fsck a bare repository, fsck each key in the location log. -}
 withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek

Command/Get.hs

@@ -69,7 +69,7 @@ getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key
 			either (const False) id <$> Remote.hasKey r key
 		| otherwise = return True
 	docopy r continue = do
-		ok <- download (Remote.uuid r) key (Just file) noRetry $ do
+		ok <- download (Remote.uuid r) key (Just file) noRetry $ \p -> do
 			showAction $ "from " ++ Remote.name r
-			Remote.retrieveKeyFile r key (Just file) dest
+			Remote.retrieveKeyFile r key (Just file) dest p
 		if ok then return ok else continue

Command/Move.hs

@@ -144,9 +144,9 @@ fromPerform src move key file = moveLock move key $
 		, handle move =<< go
 		)
   where
-	go = download (Remote.uuid src) key (Just file) noRetry $ do
+	go = download (Remote.uuid src) key (Just file) noRetry $ \p -> do
 		showAction $ "from " ++ Remote.name src
-		getViaTmp key $ Remote.retrieveKeyFile src key (Just file)
+		getViaTmp key $ \t -> Remote.retrieveKeyFile src key (Just file) t p
 	handle _ False = stop -- failed
 	handle False True = next $ return True -- copy complete
 	handle True True = do -- finish moving

Command/TransferKey.hs

@@ -52,8 +52,8 @@ toPerform remote key file = go $
 
 fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
 fromPerform remote key file = go $
-	download (uuid remote) key file forwardRetry $
-		getViaTmp key $ Remote.retrieveKeyFile remote key file
+	download (uuid remote) key file forwardRetry $ \p ->
+		getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
 
 go :: Annex Bool -> CommandPerform
 go a = ifM a ( liftIO exitSuccess,  liftIO exitFailure)

Command/TransferKeys.hs

@@ -59,8 +59,8 @@ start readh writeh = do
 				when ok $
 					Remote.logStatus remote key InfoPresent
 				return ok
-		| otherwise = download (Remote.uuid remote) key file forwardRetry $
-			getViaTmp key $ Remote.retrieveKeyFile remote key file
+		| otherwise = download (Remote.uuid remote) key file forwardRetry $ \p ->
+			getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
 
 runRequests
 	:: Handle

Logs/Transfer.hs

@@ -97,8 +97,8 @@ forwardRetry old new = bytesComplete old < bytesComplete new
 upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
 upload u key = runTransfer (Transfer Upload u key)
 
-download :: UUID -> Key -> AssociatedFile -> RetryDecider -> Annex Bool -> Annex Bool
-download u key file shouldretry a = runTransfer (Transfer Download u key) file shouldretry (const a)
+download :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
+download u key = runTransfer (Transfer Download u key)
 
 {- Runs a transfer action. Creates and locks the lock file while the
  - action is running, and stores info in the transfer information

Remote/Bup.hs

@@ -136,8 +136,8 @@ storeEncrypted r buprepo (cipher, enck) k _p =
 			encrypt (getGpgOpts r) cipher (feedFile src) $ \h ->
 				pipeBup params (Just h) Nothing
 
-retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve buprepo k _f d = do
+retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve buprepo k _f d _p = do
 	let params = bupParams "join" buprepo [Param $ bupRef k]
 	liftIO $ catchBoolIO $ do
 		tofile <- openFile d WriteMode
@@ -146,8 +146,8 @@ retrieve buprepo k _f d = do
 retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
-retrieveEncrypted :: BupRepo -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted buprepo (cipher, enck) _ f = liftIO $ catchBoolIO $
+retrieveEncrypted :: BupRepo -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted buprepo (cipher, enck) _ f _p = liftIO $ catchBoolIO $
 	withHandle StdoutHandle createProcessSuccess p $ \h -> do
 		decrypt cipher (\toh -> L.hPut toh =<< L.hGetContents h) $
 			readBytes $ L.writeFile f

Remote/Directory.hs

@@ -197,15 +197,15 @@ storeHelper d chunksize key storer = check <&&> go
 		writeFile f s
 		void $ tryIO $ preventWrite f
 
-retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve d chunksize k _ f = metered Nothing k $ \meterupdate ->
+retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve d chunksize k _ f p = metered (Just p) k $ \meterupdate ->
 	liftIO $ withStoredFiles chunksize d k $ \files ->
 		catchBoolIO $ do
 			meteredWriteFileChunks meterupdate f files $ L.readFile
 			return True
 
-retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted d chunksize (cipher, enck) k f = metered Nothing k $ \meterupdate ->
+retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted d chunksize (cipher, enck) k f p = metered (Just p) k $ \meterupdate ->
 	liftIO $ withStoredFiles chunksize d enck $ \files ->
 		catchBoolIO $ do
 			decrypt cipher (feeder files) $

Remote/Git.hs

@@ -271,8 +271,10 @@ dropKey r key
 		[]
 
 {- Tries to copy a key's content from a remote's annex to a file. -}
-copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
-copyFromRemote r key file dest
+copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+copyFromRemote r key file dest _p = copyFromRemote' r key file dest
+copyFromRemote' :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
+copyFromRemote' r key file dest
 	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
 		let params = rsyncParams r
 		u <- getUUID
@@ -338,7 +340,7 @@ copyFromRemoteCheap r key file
 		liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
 	| Git.repoIsSsh (repo r) =
 		ifM (Annex.Content.preseedTmp key file)
-			( copyFromRemote r key Nothing file
+			( copyFromRemote' r key Nothing file
 			, return False
 			)
 	| otherwise = return False
@@ -367,7 +369,7 @@ copyToRemote r key file p
 			( return True
 			, do
 				ensureInitialized
-				download u key file noRetry $
+				download u key file noRetry $ const $
 					Annex.Content.saveState True `after`
 						Annex.Content.getViaTmpChecked (liftIO checksuccessio) key
 							(\d -> rsyncOrCopyFile params object d p)

Remote/Glacier.hs

@@ -83,31 +83,31 @@ glacierSetup u c = do
 		]
 
 store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store r k _f m
+store r k _f p
 	| keySize k == Just 0 = do
 		warning "Cannot store empty files in Glacier."
 		return False
 	| otherwise = sendAnnex k (void $ remove r k) $ \src ->
-		metered (Just m) k $ \meterupdate ->
+		metered (Just p) k $ \meterupdate ->
 			storeHelper r k $ streamMeteredFile src meterupdate
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r (cipher, enck) k m = sendAnnex k (void $ remove r enck) $ \src -> do
-	metered (Just m) k $ \meterupdate ->
+storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src -> do
+	metered (Just p) k $ \meterupdate ->
 		storeHelper r enck $ \h ->
 			encrypt (getGpgOpts r) cipher (feedFile src)
 				(readBytes $ meteredWrite meterupdate h)
 
-retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve r k _f d = metered Nothing k $ \meterupdate ->
+retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve r k _f d p = metered (Just p) k $ \meterupdate ->
 	retrieveHelper r k $
 		readBytes $ meteredWriteFile meterupdate d
 
 retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
-retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted r (cipher, enck) k d = metered Nothing k $ \meterupdate ->
+retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted r (cipher, enck) k d p = metered (Just p) k $ \meterupdate ->
 	retrieveHelper r enck $ readBytes $ \b ->
 		decrypt cipher (feedBytes b) $
 			readBytes $ meteredWriteFile meterupdate d

Remote/Helper/Encryptable.hs

@@ -54,7 +54,7 @@ encryptionSetup c = case (M.lookup "encryption" c, extractCipher c) of
 encryptableRemote
 	:: RemoteConfig
 	-> ((Cipher, Key) -> Key -> MeterUpdate -> Annex Bool)
-	-> ((Cipher, Key) -> Key -> FilePath -> Annex Bool)
+	-> ((Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool)
 	-> Remote
 	-> Remote
 encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = 
@@ -70,9 +70,9 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
 	store k f p = cip k >>= maybe
 		(storeKey r k f p)
 		(\enck -> storeKeyEncrypted enck k p)
-	retrieve k f d = cip k >>= maybe
-		(retrieveKeyFile r k f d)
-		(\enck -> retrieveKeyFileEncrypted enck k d)
+	retrieve k f d p = cip k >>= maybe
+		(retrieveKeyFile r k f d p)
+		(\enck -> retrieveKeyFileEncrypted enck k d p)
 	retrieveCheap k d = cip k >>= maybe
 		(retrieveKeyFileCheap r k d)
 		(\_ -> return False)

Remote/Helper/Hooks.hs

@@ -29,7 +29,7 @@ addHooks' r starthook stophook = r'
   where
 	r' = r
 		{ storeKey = \k f p -> wrapper $ storeKey r k f p
-		, retrieveKeyFile = \k f d -> wrapper $ retrieveKeyFile r k f d
+		, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p
 		, retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f
 		, removeKey = \k -> wrapper $ removeKey r k
 		, hasKey = \k -> wrapper $ hasKey r k

Remote/Hook.hs

@@ -116,14 +116,14 @@ storeEncrypted h gpgOpts (cipher, enck) k _p = withTmp enck $ \tmp ->
 			readBytes $ L.writeFile tmp
 		runHook h "store" enck (Just tmp) $ return True
 
-retrieve :: String -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve h k _f d = runHook h "retrieve" k (Just d) $ return True
+retrieve :: String -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve h k _f d _p = runHook h "retrieve" k (Just d) $ return True
 
 retrieveCheap :: String -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
-retrieveEncrypted :: String -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted h (cipher, enck) _ f = withTmp enck $ \tmp ->
+retrieveEncrypted :: String -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted h (cipher, enck) _ f _p = withTmp enck $ \tmp ->
 	runHook h "retrieve" enck (Just tmp) $ liftIO $ catchBoolIO $ do
 		decrypt cipher (feedFile tmp) $
 			readBytes $ L.writeFile f

Remote/Rsync.hs

@@ -115,20 +115,15 @@ storeEncrypted o gpgOpts (cipher, enck) k p = withTmp enck $ \tmp ->
 			readBytes $ L.writeFile tmp
 		rsyncSend o p enck True tmp
 
-retrieve :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve o k _ f = untilTrue (rsyncUrls o k) $ \u -> rsyncRemote o Nothing
-	-- use inplace when retrieving to support resuming
-	[ Param "--inplace"
-	, Param u
-	, Param f
-	]
+retrieve :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve o k _ f p = rsyncRetrieve o k f (Just p)
 
 retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool
-retrieveCheap o k f = ifM (preseedTmp k f) ( retrieve o k undefined f , return False )
+retrieveCheap o k f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False )
 
-retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted o (cipher, enck) _ f = withTmp enck $ \tmp ->
-	ifM (retrieve o enck undefined tmp)
+retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted o (cipher, enck) _ f p = withTmp enck $ \tmp ->
+	ifM (rsyncRetrieve o enck tmp (Just p))
 		( liftIO $ catchBoolIO $ do
 			decrypt cipher (feedFile tmp) $
 				readBytes $ L.writeFile f
@@ -197,6 +192,15 @@ withRsyncScratchDir a = do
 	nuke d = liftIO $ whenM (doesDirectoryExist d) $
 		removeDirectoryRecursive d
 
+rsyncRetrieve :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex Bool
+rsyncRetrieve o k dest callback =
+	untilTrue (rsyncUrls o k) $ \u -> rsyncRemote o callback
+		-- use inplace when retrieving to support resuming
+		[ Param "--inplace"
+		, Param u
+		, Param dest
+		]
+
 rsyncRemote :: RsyncOpts -> (Maybe MeterUpdate) -> [CommandParam] -> Annex Bool
 rsyncRemote o callback params = do
 	showOutput -- make way for progress bar

Remote/S3.hs

@@ -152,9 +152,9 @@ storeHelper (conn, bucket) r k p file = do
 	xheaders = filter isxheader $ M.assocs $ config r
 	isxheader (h, _) = "x-amz-" `isPrefixOf` h
 
-retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve r k _f d = s3Action r False $ \(conn, bucket) ->
-	metered Nothing k $ \meterupdate -> do
+retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve r k _f d p = s3Action r False $ \(conn, bucket) ->
+	metered (Just p) k $ \meterupdate -> do
 		res <- liftIO $ getObject conn $ bucketKey r bucket k
 		case res of
 			Right o -> do
@@ -166,9 +166,9 @@ retrieve r k _f d = s3Action r False $ \(conn, bucket) ->
 retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
-retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted r (cipher, enck) k d = s3Action r False $ \(conn, bucket) ->
-	metered Nothing k $ \meterupdate -> do
+retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted r (cipher, enck) k d p = s3Action r False $ \(conn, bucket) ->
+	metered (Just p) 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) $ 

Remote/Web.hs

@@ -59,8 +59,8 @@ gen r _ _ gc =
 		remotetype = remote
 	}
 
-downloadKey :: Key -> AssociatedFile -> FilePath -> Annex Bool
-downloadKey key _file dest = get =<< getUrls key
+downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+downloadKey key _file dest _p = get =<< getUrls key
   where
 	get [] = do
 		warning "no known url"

Remote/WebDAV.hs

@@ -118,8 +118,8 @@ storeHelper r k baseurl user pass b = catchBoolIO $ do
 retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
-retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve r k _f d = metered Nothing k $ \meterupdate ->
+retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve r k _f d p = metered (Just p) k $ \meterupdate ->
 	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
 		withStoredFiles r k baseurl user pass onerr $ \urls -> do
 			meteredWriteFileChunks meterupdate d urls $ \url -> do
@@ -131,8 +131,8 @@ retrieve r k _f d = metered Nothing k $ \meterupdate ->
   where
 	onerr _ = return False
 
-retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted r (cipher, enck) k d = metered Nothing k $ \meterupdate ->
+retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted r (cipher, enck) k d p = metered (Just p) k $ \meterupdate ->
 	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
 		withStoredFiles r enck baseurl user pass onerr $ \urls -> do
 			decrypt cipher (feeder user pass urls) $

Types/Remote.hs

@@ -50,8 +50,10 @@ data RemoteA a = Remote {
 	cost :: Cost,
 	-- Transfers a key to the remote.
 	storeKey :: Key -> AssociatedFile -> MeterUpdate -> a Bool,
-	-- retrieves a key's contents to a file
-	retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> a Bool,
+	-- Retrieves a key's contents to a file.
+	-- (The MeterUpdate does not need to be used if it retrieves
+	-- directly to the file, and not to an intermediate file.)
+	retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a Bool,
 	-- retrieves a key's contents to a tmp file, if it can be done cheaply
 	retrieveKeyFileCheap :: Key -> FilePath -> a Bool,
 	-- removes a key's contents

debian/changelog

@@ -26,6 +26,8 @@ git-annex (4.20130406) UNRELEASED; urgency=low
   * addurl: Register transfer so the webapp can see it.
   * addurl: Automatically retry downloads that fail, as long as some
     additional content was downloaded.
+  * webapp: Much improved progress bar display for downloads from encrypted
+    remotes.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 06 Apr 2013 15:24:15 -0400
 

doc/design/assistant/progressbars.mdwn

@@ -12,10 +12,33 @@ This is one of those potentially hidden but time consuming problems.
 * Watch temp file as it's coming in and use its size.
   Can either poll every .5 seconds or so to check file size, or
   could use inotify. **done**
+* When easily available, remotes call the MeterUpdate callback as uploads
+  progress. **done**
 
-* TODO: Encrypted remotes download to a different temp file, and so the 
-  progress bar actually only appears for the decryption once the download
-  is complete.
+* TODO a bad interaction can happen between the TransferPoller and the
+  TransferWatcher when downloading from an encrypted remote. If
+  a partially transferred file exists already, in the gitAnnexTmpLocation
+  of the (un-encrypted) key, the TransferPoller will trust it to have
+  the right size of the content downloaded. This will stomp, every 0.5
+  seconds, over the updates to the size that the TransferWatcher is seeing
+  in the transfer log files.
+
+  We still need the TransferPoller for the remotes that don't have
+  download meters. This includes git, web, bup, and hook.
+
+  Need to teach the TransferPoller to detect when transfer logs for downloads
+  have file size info, and use it, rather than looking at the temp file.
+  The question is, how to do this efficiently? It could just poll the
+  transfer log every time, and if size is nonzero, ignore the temp file.
+  This would work, but it would require a lot more work than the simple
+  statting of the file it does now. And this runs every 0.5 seconds.
+
+  I could try to convert all remotes I care about to having progress
+  for downloads. But converting the web special remote will be hard..
+
+  I think perhaps the best solution is to make the TransferWatcher also watch
+  the temp files. Then if one changes, it can get its new size. If a
+  transfer info file changes, it can get the size from there.
 
 ## uploads