add filename to progress bar, and display ok/failed at end

This needed plumbing an AssociatedFile through retrieveKeyFileCheap.

Remote/BitTorrent.hs

@@ -93,8 +93,8 @@ downloadKey key _file dest p =
 				, return False
 				)
 
-downloadKeyCheap :: Key -> FilePath -> Annex Bool
-downloadKeyCheap _ _ = return False
+downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+downloadKeyCheap _ _ _ = return False
 
 uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 uploadKey _ _ _ = do

Remote/Bup.hs

@@ -148,8 +148,8 @@ retrieve buprepo = byteRetriever $ \k sink -> do
 	liftIO (hClose h >> forceSuccessProcess p pid)
 		`after` (sink =<< liftIO (L.hGetContents h))
 
-retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
+retrieveCheap :: BupRepo -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ _ = return False
 
 {- Cannot revert having stored a key in bup, but at least the data for the
  - key will be used for deltaing data of other keys stored later.

Remote/Ddar.hs

@@ -142,8 +142,8 @@ retrieve ddarrepo = byteRetriever $ \k sink -> do
 	liftIO (hClose h >> forceSuccessProcess p pid)
 		`after` (sink =<< liftIO (L.hGetContents h))
 
-retrieveCheap :: Key -> FilePath -> Annex Bool
-retrieveCheap _ _ = return False
+retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
 
 remove :: DdarRepo -> Remover
 remove ddarrepo key = do

Remote/Directory.hs

@@ -156,17 +156,17 @@ retrieve d (LegacyChunks _) = Legacy.retrieve locations d
 retrieve d _ = simplyPrepare $ byteRetriever $ \k sink ->
 	sink =<< liftIO (L.readFile =<< getLocation d k)
 
-retrieveCheap :: FilePath -> ChunkConfig -> Key -> FilePath -> Annex Bool
+retrieveCheap :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> Annex Bool
 -- no cheap retrieval possible for chunks
-retrieveCheap _ (UnpaddedChunks _) _ _ = return False
-retrieveCheap _ (LegacyChunks _) _ _ = return False
+retrieveCheap _ (UnpaddedChunks _) _ _ _ = return False
+retrieveCheap _ (LegacyChunks _) _ _ _ = return False
 #ifndef mingw32_HOST_OS
-retrieveCheap d NoChunks k f = liftIO $ catchBoolIO $ do
+retrieveCheap d NoChunks k _af f = liftIO $ catchBoolIO $ do
 	file <- getLocation d k
 	createSymbolicLink file f
 	return True
 #else
-retrieveCheap _ _ _ _ = return False
+retrieveCheap _ _ _ _ _ = return False
 #endif
 
 remove :: FilePath -> Remover

Remote/External.hs

@@ -56,7 +56,7 @@ gen r u c gc = do
 			, name = Git.repoDescribe r
 			, storeKey = storeKeyDummy
 			, retrieveKeyFile = retreiveKeyFileDummy
-			, retrieveKeyFileCheap = \_ _ -> return False
+			, retrieveKeyFileCheap = \_ _ _ -> return False
 			, removeKey = removeKeyDummy
 			, checkPresent = checkPresentDummy
 			, checkPresentCheap = False

Remote/GCrypt.hs

@@ -108,7 +108,7 @@ gen' r u c gc = do
 		, name = Git.repoDescribe r
 		, storeKey = storeKeyDummy
 		, retrieveKeyFile = retreiveKeyFileDummy
-		, retrieveKeyFileCheap = \_ _ -> return False
+		, retrieveKeyFileCheap = \_ _ _ -> return False
 		, removeKey = removeKeyDummy
 		, checkPresent = checkPresentDummy
 		, checkPresentCheap = repoCheap r

Remote/Git.hs

@@ -355,7 +355,7 @@ dropKey r key
 
 {- Tries to copy a key's content from a remote's annex to a file. -}
 copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
-copyFromRemote r key file dest p = parallelMetered (Just p) key $
+copyFromRemote r key file dest p = parallelMetered (Just p) key file $
 	copyFromRemote' r key file dest
 
 copyFromRemote' :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
@@ -447,26 +447,27 @@ copyFromRemote' r key file dest meterupdate
 					=<< tryTakeMVar pidv
 		bracketIO noop (const cleanup) (const $ a feeder)
 
-copyFromRemoteCheap :: Remote -> Key -> FilePath -> Annex Bool
+copyFromRemoteCheap :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
 #ifndef mingw32_HOST_OS
-copyFromRemoteCheap r key file
+copyFromRemoteCheap r key af file
 	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (return False) $ do
 		loc <- liftIO $ gitAnnexLocation key (repo r) $
 			fromJust $ remoteGitConfig $ gitconfig r
 		liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
 	| Git.repoIsSsh (repo r) =
 		ifM (Annex.Content.preseedTmp key file)
-			( parallelMetered Nothing key $ copyFromRemote' r key Nothing file
+			( parallelMetered Nothing key af $
+				copyFromRemote' r key af file
 			, return False
 			)
 	| otherwise = return False
 #else
-copyFromRemoteCheap _ _ _ = return False
+copyFromRemoteCheap _ _ _ _ = return False
 #endif
 
 {- Tries to copy a key's content to a remote's annex. -}
 copyToRemote :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-copyToRemote r key file p = parallelMetered (Just p) key $ copyToRemote' r key file
+copyToRemote r key file p = parallelMetered (Just p) key file $ copyToRemote' r key file
 
 copyToRemote' :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 copyToRemote' r key file p

Remote/Glacier.hs

@@ -162,8 +162,8 @@ retrieve r k sink = go =<< glacierEnv c u
 			showLongNote "Recommend you wait up to 4 hours, and then run this command again."
 		return ok
 
-retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
+retrieveCheap :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ _ = return False
 
 remove :: Remote -> Remover
 remove r k = glacierAction r

Remote/Helper/Hooks.hs

@@ -36,7 +36,7 @@ addHooks' r starthook stophook = r'
 	r' = r
 		{ storeKey = \k f p -> wrapper $ storeKey r k f p
 		, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p
-		, retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f
+		, retrieveKeyFileCheap = \k af f -> wrapper $ retrieveKeyFileCheap r k af f
 		, removeKey = wrapper . removeKey r
 		, checkPresent = wrapper . checkPresent r
 		}

Remote/Helper/Special.hs

@@ -157,10 +157,10 @@ specialRemote' :: SpecialRemoteCfg -> RemoteModifier
 specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckpresent baser = encr
   where
 	encr = baser
-		{ storeKey = \k _f p -> cip >>= storeKeyGen k p
-		, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
-		, retrieveKeyFileCheap = \k d -> cip >>= maybe
-			(retrieveKeyFileCheap baser k d)
+		{ storeKey = \k f p -> cip >>= storeKeyGen k f p
+		, retrieveKeyFile = \k f d p -> cip >>= retrieveKeyFileGen k f d p
+		, retrieveKeyFileCheap = \k f d -> cip >>= maybe
+			(retrieveKeyFileCheap baser k f d)
 			-- retrieval of encrypted keys is never cheap
 			(\_ -> return False)
 		, removeKey = \k -> cip >>= removeKeyGen k
@@ -182,10 +182,10 @@ 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 p enc = safely $ preparestorer k $ safely . go
+	storeKeyGen k f p enc = safely $ preparestorer k $ safely . go
 	  where
 		go (Just storer) = sendAnnex k rollback $ \src ->
-			displayprogress p k $ \p' ->
+			displayprogress p k f $ \p' ->
 				storeChunks (uuid baser) chunkconfig k src p'
 					(storechunk enc storer)
 					(checkPresent baser)
@@ -200,10 +200,10 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 					storer (enck k) (ByteContent encb) p
 
 	-- call retrieve-r to get chunks; decrypt them; stream to dest file
-	retrieveKeyFileGen k dest p enc =
+	retrieveKeyFileGen k f dest p enc =
 		safely $ prepareretriever k $ safely . go
 	  where
-		go (Just retriever) = displayprogress p k $ \p' ->
+		go (Just retriever) = displayprogress p k f $ \p' ->
 			retrieveChunks retriever (uuid baser) chunkconfig
 				enck k dest p' (sink dest enc)
 		go Nothing = return False
@@ -223,8 +223,8 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 
 	chunkconfig = chunkConfig cfg
 
-	displayprogress p k a
-		| displayProgress cfg = metered (Just p) k a
+	displayprogress p k f a
+		| displayProgress cfg = metered (Just p) k f a
 		| otherwise = a p
 
 {- Sink callback for retrieveChunks. Stores the file content into the

Remote/Hook.hs

@@ -130,8 +130,8 @@ retrieve h = fileRetriever $ \d k _p ->
 	unlessM (runHook h "retrieve" k (Just d) $ return True) $
 		error "failed to retrieve content"
 
-retrieveCheap :: HookName -> Key -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
+retrieveCheap :: HookName -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ _ = return False
 
 remove :: HookName -> Remover
 remove h k = runHook h "remove" k Nothing $ return True

Remote/Rsync.hs

@@ -191,8 +191,8 @@ retrieve o f k p =
 	unlessM (rsyncRetrieve o k f (Just p)) $
 		error "rsync failed"
 
-retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool
-retrieveCheap o k f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False )
+retrieveCheap :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap o k _af f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False )
 
 remove :: RsyncOpts -> Remover
 remove o k = do

Remote/S3.hs

@@ -241,8 +241,8 @@ retrieve h = fileRetriever $ \f k p -> liftIO $ runResourceT $ do
 					S.hPut fh bs
 				sinkprogressfile fh meterupdate sofar'
 
-retrieveCheap :: Key -> FilePath -> Annex Bool
-retrieveCheap _ _ = return False
+retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
 
 {- Internet Archive doesn't easily allow removing content.
  - While it may remove the file, there are generally other files

Remote/Tahoe.hs

@@ -70,7 +70,7 @@ gen r u c gc = do
 		, name = Git.repoDescribe r
 		, storeKey = store u hdl
 		, retrieveKeyFile = retrieve u hdl
-		, retrieveKeyFileCheap = \_ _ -> return False
+		, retrieveKeyFileCheap = \_ _ _ -> return False
 		, removeKey = remove
 		, checkPresent = checkKey u hdl
 		, checkPresentCheap = False

Remote/Web.hs

@@ -90,8 +90,8 @@ downloadKey key _file dest _p = get =<< getWebUrls key
 #endif
 				_ -> downloadUrl [u'] dest
 
-downloadKeyCheap :: Key -> FilePath -> Annex Bool
-downloadKeyCheap _ _ = return False
+downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+downloadKeyCheap _ _ _ = return False
 
 uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 uploadKey _ _ _ = do

Remote/WebDAV.hs

@@ -116,8 +116,8 @@ finalizeStore baseurl tmp dest = do
 	maybe noop (void . mkColRecursive) (locationParent dest)
 	moveDAV baseurl tmp dest
 
-retrieveCheap :: Key -> FilePath -> Annex Bool
-retrieveCheap _ _ = return False
+retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
 
 retrieve :: ChunkConfig -> Maybe DavHandle -> Retriever
 retrieve _ Nothing = error "unable to connect"