make retrieveKeyFile and retrieveKeyFileCheap throw exceptions

Converted retrieveKeyFileCheap to a Maybe, to avoid needing to throw a
exception when a remote doesn't support it.

CHANGELOG

@@ -26,7 +26,7 @@ git-annex (8.20200502) UNRELEASED; urgency=medium
     the current directory.
   * Display a warning message when asked to operate on a file inside a
     directory that's a symbolic link to elsewhere.
-  * When storing content on remote fails, always display a reason why.
+  * When accessing a remote fails, always display a reason why.
 
  -- Joey Hess <id@joeyh.name>  Mon, 04 May 2020 12:46:11 -0400
 

Command/AddUrl.hs

@@ -189,15 +189,19 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd file $ do
 			-- so that the remote knows what url it
 			-- should use to download it.
 			setTempUrl urlkey loguri
-			let downloader = \dest p -> fst 
+			let downloader = \dest p ->
-				<$> Remote.retrieveKeyFile r urlkey
+				tryNonAsync (Remote.retrieveKeyFile r urlkey af dest p) >>= \case
-					(AssociatedFile (Just (toRawFilePath file))) dest p
+					Right _ -> return True
+					Left e -> do
+						warning (show e)
+						return False
 			ret <- downloadWith addunlockedmatcher downloader urlkey (Remote.uuid r) loguri file
 			removeTempUrl urlkey
 			return ret
 		)
   where
 	loguri = setDownloader uri OtherDownloader
+	af = AssociatedFile (Just (toRawFilePath file))
 
 startWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> CommandStart
 startWeb addunlockedmatcher o urlstring = go $ fromMaybe bad $ parseURI urlstring

Command/Fsck.hs

@@ -41,6 +41,7 @@ import Data.Time.Clock.POSIX
 import System.Posix.Types (EpochTime)
 import qualified Data.Set as S
 import qualified Data.Map as M
+import Data.Either
 
 cmd :: Command
 cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $
@@ -174,17 +175,20 @@ performRemote key afile backend numcopies remote =
 		cleanup
 		cleanup `after` a tmp
 	getfile tmp = ifM (checkDiskSpace (Just (takeDirectory tmp)) key 0 True)
-		( ifM (Remote.retrieveKeyFileCheap remote key afile tmp)
+		( ifM (getcheap tmp)
 			( return (Just True)
 			, ifM (Annex.getState Annex.fast)
 				( return Nothing
-				, Just . fst <$>
+				, Just . isRight <$> tryNonAsync (getfile' tmp)
-					Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
 				)
 			)
 		, return (Just False)
 		)
+	getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
 	dummymeter _ = noop
+	getcheap tmp = case Remote.retrieveKeyFileCheap remote of
+		Just a -> isRight <$> tryNonAsync (a key afile tmp)
+		Nothing -> return False
 
 startKey :: Maybe Remote -> Incremental -> (Key, ActionItem) -> NumCopies -> CommandStart
 startKey from inc (key, ai) numcopies =

Command/Get.hs

@@ -112,5 +112,9 @@ getKey' key afile = dispatch
 		download (Remote.uuid r) key afile stdRetry
 			(\p -> do
 				showAction $ "from " ++ Remote.name r
-				Remote.retrieveKeyFile r key afile dest p
+				tryNonAsync (Remote.retrieveKeyFile r key afile dest p) >>= \case
+					Right v -> return (True, v)
+					Left e -> do
+						warning (show e)
+						return (False, UnVerified)
 			) witness

Command/Move.hs

@@ -207,7 +207,11 @@ fromPerform src removewhen key afile = do
 	go = notifyTransfer Download afile $ 
 		download (Remote.uuid src) key afile stdRetry $ \p ->
 			getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t ->
-				Remote.retrieveKeyFile src key afile t p
+				tryNonAsync (Remote.retrieveKeyFile src key afile t p) >>= \case
+					Right v -> return (True, v)
+					Left e -> do
+						warning (show e)
+						return (False, UnVerified)
 	dispatch _ _ False = stop -- failed
 	dispatch RemoveNever _ True = next $ return True -- copy complete
 	dispatch RemoveSafe deststartedwithcopy True = lockContentShared key $ \_lck -> do

Command/TestRemote.hs

@@ -274,8 +274,9 @@ test runannex mkr mkk =
 			Nothing -> return True
 			Just verifier -> verifier k (serializeKey k)
 	get r k = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
-		Remote.retrieveKeyFile r k (AssociatedFile Nothing)
+		tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate) >>= \case
-			dest nullMeterUpdate
+			Right v -> return (True, v)
+			Left _ -> return (False, UnVerified)
 	store r k = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
 	remove r k = Remote.removeKey r k
 
@@ -348,10 +349,14 @@ testUnavailable runannex mkr mkk =
 		Remote.checkPresent r k
 	, check (== Right False) "retrieveKeyFile" $ \r k ->
 		getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
-			Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate
+			tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate) >>= \case
-	, check (== Right False) "retrieveKeyFileCheap" $ \r k ->
+				Right v -> return (True, v)
-		getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> unVerified $
+				Left _ -> return (False, UnVerified)
-			Remote.retrieveKeyFileCheap r k (AssociatedFile Nothing) dest
+	, check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of
+		Nothing -> return False
+		Just a -> getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> 
+			unVerified $ isRight
+				<$> tryNonAsync (a k (AssociatedFile Nothing) dest)
 	]
   where
 	check checkval desc a = testCase desc $ 

Command/TransferKey.hs

@@ -53,18 +53,22 @@ toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
 toPerform key file remote = go Upload file $
 	upload (uuid remote) key file stdRetry $ \p -> do
 		tryNonAsync (Remote.storeKey remote key file p) >>= \case
-			Left e -> do
-				warning (show e)
-				return False
 			Right () -> do
 				Remote.logStatus remote key InfoPresent
 				return True
+			Left e -> do
+				warning (show e)
+				return False
 
 fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
 fromPerform key file remote = go Upload file $
 	download (uuid remote) key file stdRetry $ \p ->
-		getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $ 
+		getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t ->
-			\t -> Remote.retrieveKeyFile remote key file t p
+			tryNonAsync (Remote.retrieveKeyFile remote key file t p) >>= \case
+				Right v -> return (True, v)	
+				Left e -> do
+					warning (show e)
+					return (False, UnVerified)
 
 go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform
 go direction file a = notifyTransfer direction file a >>= liftIO . exitBool

Command/TransferKeys.hs

@@ -48,7 +48,11 @@ start = do
 		| otherwise = notifyTransfer direction file $
 			download (Remote.uuid remote) key file stdRetry $ \p ->
 				getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t -> do
-					r <- Remote.retrieveKeyFile remote key file t p
+					r <- tryNonAsync (Remote.retrieveKeyFile remote key file t p) >>= \case
+						Left e -> do
+							warning (show e)
+							return (False, UnVerified)
+						Right v -> return (True, v)
 					-- Make sure we get the current
 					-- associated files data for the key,
 					-- not old cached data.

Remote/Adb.hs

@@ -64,8 +64,8 @@ gen r u rc gc rs = do
 		, cost = semiExpensiveRemoteCost
 		, name = Git.repoDescribe r
 		, storeKey = storeKeyDummy
-		, retrieveKeyFile = retreiveKeyFileDummy
+		, retrieveKeyFile = retrieveKeyFileDummy
-		, retrieveKeyFileCheap = \_ _ _ -> return False
+		, retrieveKeyFileCheap = Nothing
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = removeKeyDummy
 		, lockContent = Nothing

Remote/BitTorrent.hs

@@ -64,7 +64,7 @@ gen r _ rc gc rs = do
 		, name = Git.repoDescribe r
 		, storeKey = uploadKey
 		, retrieveKeyFile = downloadKey
-		, retrieveKeyFileCheap = downloadKeyCheap
+		, retrieveKeyFileCheap = Nothing
 		-- Bittorrent does its own hash checks.
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = dropKey
@@ -91,25 +91,23 @@ gen r _ rc gc rs = do
 		, remoteStateHandle = rs
 		}
 
-downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-downloadKey key _file dest p = unVerified $
+downloadKey key _file dest p = do
 	get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key
+	return UnVerified
   where
-	get [] = do
+	get [] = giveup "could not download torrent"
-		warning "could not download torrent"
-		return False
 	get urls = do
 		showOutput -- make way for download progress bar
-		untilTrue urls $ \(u, filenum) -> do
+		ok <- untilTrue urls $ \(u, filenum) -> do
 			registerTorrentCleanup u
 			checkDependencies
 			ifM (downloadTorrentFile u)
 				( downloadTorrentContent key u dest filenum p
 				, return False
 				)
-
+		unless ok $
-downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+			get []
-downloadKeyCheap _ _ _ = return False
 
 uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex ()
 uploadKey _ _ _ = giveup "upload to bittorrent not supported"

Remote/Bup.hs

@@ -70,8 +70,8 @@ gen r u rc gc rs = do
 		, cost = cst
 		, name = Git.repoDescribe r
 		, storeKey = storeKeyDummy
-		, retrieveKeyFile = retreiveKeyFileDummy
+		, retrieveKeyFile = retrieveKeyFileDummy
-		, retrieveKeyFileCheap = retrieveCheap buprepo
+		, retrieveKeyFileCheap = Nothing
 		-- Bup uses git, which cryptographically verifies content
 		-- (with SHA1, but sufficiently for this).
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
@@ -169,9 +169,6 @@ retrieve buprepo = byteRetriever $ \k sink -> do
 	liftIO (hClose h >> forceSuccessProcess p pid)
 		`after` (sink =<< liftIO (L.hGetContents h))
 
-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

@@ -71,8 +71,8 @@ gen r u rc gc rs = do
 		, cost = cst
 		, name = Git.repoDescribe r
 		, storeKey = storeKeyDummy
-		, retrieveKeyFile = retreiveKeyFileDummy
+		, retrieveKeyFile = retrieveKeyFileDummy
-		, retrieveKeyFileCheap = retrieveCheap
+		, retrieveKeyFileCheap = Nothing
 		-- ddar communicates over ssh, not subject to http redirect
 		-- type attacks
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
@@ -162,9 +162,6 @@ retrieve ddarrepo = byteRetriever $ \k sink -> do
 	liftIO (hClose h >> forceSuccessProcess p pid)
 		`after` (sink =<< liftIO (L.hGetContents h))
 
-retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
-
 remove :: DdarRepo -> Remover
 remove ddarrepo key = do
 	(cmd, params) <- ddarRemoteCall NoConsumeStdin ddarrepo 'd'

Remote/Directory.hs

@@ -69,7 +69,7 @@ gen r u rc gc rs = do
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = storeKeyDummy
-			, retrieveKeyFile = retreiveKeyFileDummy
+			, retrieveKeyFile = retrieveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveKeyFileCheapM dir chunkconfig
 			, retrievalSecurityPolicy = RetrievalAllKeysSecure
 			, removeKey = removeKeyDummy
@@ -205,21 +205,19 @@ retrieveKeyFileM d (LegacyChunks _) = Legacy.retrieve locations d
 retrieveKeyFileM d _ = byteRetriever $ \k sink ->
 	sink =<< liftIO (L.readFile =<< getLocation d k)
 
-retrieveKeyFileCheapM :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveKeyFileCheapM :: FilePath -> ChunkConfig -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())
 -- no cheap retrieval possible for chunks
-retrieveKeyFileCheapM _ (UnpaddedChunks _) _ _ _ = return False
+retrieveKeyFileCheapM _ (UnpaddedChunks _) = Nothing
-retrieveKeyFileCheapM _ (LegacyChunks _) _ _ _ = return False
+retrieveKeyFileCheapM _ (LegacyChunks _) = Nothing
 #ifndef mingw32_HOST_OS
-retrieveKeyFileCheapM d NoChunks k _af f = liftIO $ catchBoolIO $ do
+retrieveKeyFileCheapM d NoChunks = Just $ \k _af f -> liftIO $ do
 	file <- absPath =<< getLocation d k
 	ifM (doesFileExist file)
-		( do
+		( createSymbolicLink file f
-			createSymbolicLink file f
+		, giveup "content file not present in remote"
-			return True
-		, return False
 		)
 #else
-retrieveKeyFileCheapM _ _ _ _ _ = return False
+retrieveKeyFileCheapM _ _ = Nothing
 #endif
 
 removeKeyM :: FilePath -> Remover

Remote/External.hs

@@ -121,8 +121,8 @@ gen r u rc gc rs
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = storeKeyDummy
-			, retrieveKeyFile = retreiveKeyFileDummy
+			, retrieveKeyFile = retrieveKeyFileDummy
-			, retrieveKeyFileCheap = \_ _ _ -> return False
+			, retrieveKeyFileCheap = Nothing
 			-- External special remotes use many http libraries
 			-- and have no protection against redirects to
 			-- local private web servers, or in some cases

Remote/GCrypt.hs

@@ -132,8 +132,8 @@ gen' r u c gc rs = do
 		, cost = cst
 		, name = Git.repoDescribe r
 		, storeKey = storeKeyDummy
-		, retrieveKeyFile = retreiveKeyFileDummy
+		, retrieveKeyFile = retrieveKeyFileDummy
-		, retrieveKeyFileCheap = \_ _ _ -> return False
+		, retrieveKeyFileCheap = Nothing
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = removeKeyDummy
 		, lockContent = Nothing
@@ -393,7 +393,7 @@ retrieve r rsyncopts k p sink = do
 retrieve' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> Retriever
 retrieve' repo r rsyncopts
 	| not $ Git.repoIsUrl repo = byteRetriever $ \k sink ->
-		guardUsable repo (return False) $
+		guardUsable repo (giveup "cannot access remote") $
 			sink =<< liftIO (L.readFile $ gCryptLocation repo k)
 	| Git.repoIsSsh repo = if accessShell r
 		then fileRetriever $ \f k p -> do

Remote/Git.hs

@@ -183,7 +183,7 @@ gen r u rc gc rs
 			, name = Git.repoDescribe r
 			, storeKey = copyToRemote new st
 			, retrieveKeyFile = copyFromRemote new st
-			, retrieveKeyFileCheap = copyFromRemoteCheap new st
+			, retrieveKeyFileCheap = copyFromRemoteCheap new st r
 			, retrievalSecurityPolicy = RetrievalAllKeysSecure
 			, removeKey = dropKey new st
 			, lockContent = Just (lockKey new st)
@@ -515,50 +515,55 @@ lockKey' repo r st@(State connpool duc _ _ _) key callback
 	failedlock = giveup "can't lock content"
 
 {- Tries to copy a key's content from a remote's annex to a file. -}
-copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
 copyFromRemote = copyFromRemote' False
 
-copyFromRemote' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+copyFromRemote' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
 copyFromRemote' forcersync r st key file dest meterupdate = do
 	repo <- getRepo r
 	copyFromRemote'' repo forcersync r st key file dest meterupdate
 
-copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
 copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest meterupdate
-	| Git.repoIsHttp repo = unVerified $ do
+	| Git.repoIsHttp repo = do
 		gc <- Annex.getGitConfig
-		Url.withUrlOptionsPromptingCreds $
+		ok <- Url.withUrlOptionsPromptingCreds $
 			Annex.Content.downloadUrl key meterupdate (keyUrls gc repo r key) dest
-	| not $ Git.repoIsUrl repo = guardUsable repo (unVerified (return False)) $ do
+		unless ok $
+			giveup "failed to download content"
+		return UnVerified
+	| not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ do
 		params <- Ssh.rsyncParams r Download
 		u <- getUUID
 		hardlink <- wantHardLink
 		-- run copy from perspective of remote
-		onLocalFast st $ do
+		onLocalFast st $ Annex.Content.prepSendAnnex key >>= \case
-			v <- Annex.Content.prepSendAnnex key
+			Just (object, checksuccess) -> do
-			case v of
+				copier <- mkCopier hardlink st params
-				Nothing -> do
+				(ok, v) <- runTransfer (Transfer Download u (fromKey id key))
-					warning "content is not present in remote"
+					file stdRetry $ \p ->
-					return (False, UnVerified)
+						metered (Just (combineMeterUpdate p meterupdate)) key $ \_ p' -> 
-				Just (object, checksuccess) -> do
+							copier object dest p' checksuccess
-					copier <- mkCopier hardlink st params
+				if ok
-					runTransfer (Transfer Download u (fromKey id key))
+					then return v
-						file stdRetry $ \p ->
+					else giveup "failed to retrieve content from remote"
-							metered (Just (combineMeterUpdate p meterupdate)) key $ \_ p' -> 
+			Nothing -> giveup "content is not present in remote"
-								copier object dest p' checksuccess
 	| Git.repoIsSsh repo = if forcersync
-		then fallback meterupdate
+		then do
+			(ok, v) <- fallback meterupdate
+			if ok
+				then return v
+				else giveup "failed to retrieve content from remote"
 		else P2PHelper.retrieve
 			(\p -> Ssh.runProto r connpool (return (False, UnVerified)) (fallback p))
 			key file dest meterupdate
-	| otherwise = do
+	| otherwise = giveup "copying from non-ssh, non-http remote not supported"
-		warning "copying from non-ssh, non-http remote not supported"
-		unVerified (return False)
   where
 	fallback p = unVerified $ feedprogressback $ \p' -> do
 		oh <- mkOutputHandlerQuiet
 		Ssh.rsyncHelper oh (Just (combineMeterUpdate p' p))
 			=<< Ssh.rsyncParamsRemote False r Download key dest file
+
 	{- Feed local rsync's progress info back to the remote,
 	 - by forking a feeder thread that runs
 	 - git-annex-shell transferinfo at the same time
@@ -619,33 +624,26 @@ copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest met
 					=<< tryTakeMVar pidv
 		bracketIO noop (const cleanup) (const $ a feeder)
 
-copyFromRemoteCheap :: Remote -> State -> Key -> AssociatedFile -> FilePath -> Annex Bool
+copyFromRemoteCheap :: Remote -> State -> Git.Repo -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())
-copyFromRemoteCheap r st key af file = do
+copyFromRemoteCheap r st repo
-	repo <- getRepo r
-	copyFromRemoteCheap' repo r st key af file
-
-copyFromRemoteCheap' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> FilePath -> Annex Bool
 #ifndef mingw32_HOST_OS
-copyFromRemoteCheap' repo r st key af file
+	| not $ Git.repoIsUrl repo = Just $ \key _af file -> guardUsable repo (giveup "cannot access remote") $ do
-	| not $ Git.repoIsUrl repo = guardUsable repo (return False) $ do
 		gc <- getGitConfigFromState st
 		loc <- liftIO $ gitAnnexLocation key repo gc
 		liftIO $ ifM (R.doesPathExist loc)
 			( do
 				absloc <- absPath (fromRawFilePath loc)
-				catchBoolIO $ do
+				createSymbolicLink absloc file
-					createSymbolicLink absloc file
+			, giveup "remote does not contain key"
-					return True
-			, return False
 			)
-	| Git.repoIsSsh repo =
+	| Git.repoIsSsh repo = Just $ \key af file ->
 		ifM (Annex.Content.preseedTmp key file)
-			( fst <$> copyFromRemote' True r st key af file nullMeterUpdate
+			( void $ copyFromRemote' True r st key af file nullMeterUpdate
-			, return False
+			, giveup "cannot preseed rsync with existing content"
 			)
-	| otherwise = return False
+	| otherwise = Nothing
 #else
-copyFromRemoteCheap' _ _ _ _ _ _ = return False
+copyFromRemoteCheap' _ _ _ = Nothing
 #endif
 
 {- Tries to copy a key's content to a remote's annex. -}

Remote/GitLFS.hs

@@ -102,8 +102,8 @@ gen r u rc gc rs = do
 		, cost = cst
 		, name = Git.repoDescribe r
 		, storeKey = storeKeyDummy
-		, retrieveKeyFile = retreiveKeyFileDummy
+		, retrieveKeyFile = retrieveKeyFileDummy
-		, retrieveKeyFileCheap = retrieveCheap
+		, retrieveKeyFileCheap = Nothing
 		-- content stored on git-lfs is hashed with SHA256
 		-- no matter what git-annex key it's for, and the hash
 		-- is checked on download
@@ -525,9 +525,6 @@ checkKey rs h key = getLFSEndpoint LFS.RequestDownload h >>= \case
 					giveup "git-lfs server replied with other object than the one we requested"
 				| otherwise -> return True
 
-retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
-
 remove :: TVar LFSHandle -> Remover
 remove _h _key = do
 	warning "git-lfs does not support removing content"

Remote/Glacier.hs

@@ -76,8 +76,8 @@ gen r u rc gc rs = new
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = storeKeyDummy
-			, retrieveKeyFile = retreiveKeyFileDummy
+			, retrieveKeyFile = retrieveKeyFileDummy
-			, retrieveKeyFileCheap = retrieveCheap this
+			, retrieveKeyFileCheap = Nothing
 			-- glacier-cli does not follow redirects and does
 			-- not support file://, as far as we know, but
 			-- there's no guarantee that will continue to be
@@ -169,7 +169,7 @@ store' r k b p = go =<< glacierEnv c gc u
 retrieve :: Remote -> Retriever
 retrieve = byteRetriever . retrieve'
 
-retrieve' :: Remote -> Key -> (L.ByteString -> Annex Bool) -> Annex Bool
+retrieve' :: Remote -> Key -> (L.ByteString -> Annex ()) -> Annex ()
 retrieve' r k sink = go =<< glacierEnv c gc u
   where
 	c = config r
@@ -183,26 +183,22 @@ retrieve' r k sink = go =<< glacierEnv c gc u
 		, Param $ archive r k
 		]
 	go Nothing = giveup "cannot retrieve from glacier"
-	go (Just e) = do
+	go (Just environ) = do
 		let cmd = (proc "glacier" (toCommand params))
-			{ env = Just e
+			{ env = Just environ
 			, std_out = CreatePipe
 			}
 		(_, Just h, _, pid) <- liftIO $ createProcess cmd
-		-- Glacier cannot store empty files, so if the output is
+		let cleanup = liftIO $ do
-		-- empty, the content is not available yet.
+			hClose h
-		ok <- ifM (liftIO $ hIsEOF h)
+			forceSuccessProcess cmd pid
-			( return False
+		flip finally cleanup $ do
-			, sink =<< liftIO (L.hGetContents h)
+			-- Glacier cannot store empty files, so if
-			)
+			-- the output is empty, the content is not
-		liftIO $ hClose h
+			-- available yet.
-		liftIO $ forceSuccessProcess cmd pid
+			whenM (liftIO $ hIsEOF h) $
-		unless ok $ do
+				giveup "Content is not available from glacier yet. Recommend you wait up to 4 hours, and then run this command again."
-			showLongNote "Recommend you wait up to 4 hours, and then run this command again."
+			sink =<< liftIO (L.hGetContents h)
-		return ok
-
-retrieveCheap :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieveCheap _ _ _ _ = return False
 
 remove :: Remote -> Remover
 remove r k = glacierAction r

Remote/Helper/Chunked.hs

@@ -221,8 +221,8 @@ removeChunks remover u chunkconfig encryptor k = do
  - other chunks in the list is fed to the sink.
  -
  - If retrival of one of the subsequent chunks throws an exception,
- - gives up and returns False. Note that partial data may have been
+ - gives up. Note that partial data may have been written to the sink
- - written to the sink in this case.
+ - in this case.
  -
  - Resuming is supported when using chunks. When the destination file
  - already exists, it skips to the next chunked key that would be needed
@@ -236,8 +236,8 @@ retrieveChunks
 	-> Key
 	-> FilePath
 	-> MeterUpdate
-	-> (Maybe Handle -> Maybe MeterUpdate -> ContentSource -> Annex Bool)
+	-> (Maybe Handle -> Maybe MeterUpdate -> ContentSource -> Annex ())
-	-> Annex Bool
+	-> Annex ()
 retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 	| noChunks chunkconfig =
 		-- Optimisation: Try the unchunked key first, to avoid
@@ -251,14 +251,10 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 		currsize <- liftIO $ catchMaybeIO $ getFileSize dest
 		let ls' = maybe ls (setupResume ls) currsize
 		if any null ls'
-			then return True -- dest is already complete
+			then noop -- dest is already complete
-			else firstavail currsize ls' `catchNonAsync` unable
+			else firstavail currsize ls'
 
-	unable e = do
+	firstavail _ [] = giveup "chunk retrieval failed"
-		warning (show e)
-		return False
-
-	firstavail _ [] = return False
 	firstavail currsize ([]:ls) = firstavail currsize ls
 	firstavail currsize ((k:ks):ls)
 		| k == basek = getunchunked
@@ -271,25 +267,22 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 			v <- tryNonAsync $
 				retriever (encryptor k) p $ \content ->
 					bracketIO (maybe opennew openresume offset) hClose $ \h -> do
-						void $ tosink (Just h) p content
+						tosink (Just h) p content
 						let sz = toBytesProcessed $
 							fromMaybe 0 $ fromKey keyChunkSize k
 						getrest p h sz sz ks
-							`catchNonAsync` unable
 			case v of
 				Left e
-					| null ls -> unable e
+					| null ls -> throwM e
 					| otherwise -> firstavail currsize ls
 				Right r -> return r
 
-	getrest _ _ _ _ [] = return True
+	getrest _ _ _ _ [] = noop
 	getrest p h sz bytesprocessed (k:ks) = do
 		let p' = offsetMeterUpdate p bytesprocessed
 		liftIO $ p' zeroBytesProcessed
-		ifM (retriever (encryptor k) p' $ tosink (Just h) p')
+		retriever (encryptor k) p' $ tosink (Just h) p'
-			( getrest p h sz (addBytesProcessed bytesprocessed sz) ks
+		getrest p h sz (addBytesProcessed bytesprocessed sz) ks
-			, unable "chunk retrieval failed"
-			)
 
 	getunchunked = retriever (encryptor basek) basep $ tosink Nothing basep
 

Remote/Helper/ExportImport.hs

@@ -202,15 +202,12 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
 		, retrieveKeyFile = \k af dest p ->
 			let retrieveexport = retrieveKeyFileFromExport dbv k af dest p
 			in if appendonly r
-				then do
+				then retrieveKeyFile r k af dest p
-					ret@(ok, _v) <- retrieveKeyFile r k af dest p
+					`catchNonAsync` const retrieveexport
-					if ok
-						then return ret
-						else retrieveexport
 				else retrieveexport
 		, retrieveKeyFileCheap = if appendonly r
 			then retrieveKeyFileCheap r
-			else \_ _ _ -> return False
+			else Nothing
 		-- Removing a key from an export would need to
 		-- change the tree in the export log to not include
 		-- the file. Otherwise, conflicts when removing
@@ -318,18 +315,16 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
 		db <- getexportdb dbv
 		liftIO $ Export.getExportTree db k
 
-	retrieveKeyFileFromExport dbv k _af dest p = unVerified $
+	retrieveKeyFileFromExport dbv k _af dest p
-		if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (fromKey keyVariety k))
+		| maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (fromKey keyVariety k)) = do
-			then do
+			locs <- getexportlocs dbv k
-				locs <- getexportlocs dbv k
+			case locs of
-				case locs of
+				[] -> ifM (liftIO $ atomically $ readTVar $ getexportinconflict dbv)
-					[] -> do
+					( giveup "unknown export location, likely due to the export conflict"
-						ifM (liftIO $ atomically $ readTVar $ getexportinconflict dbv)
+					, giveup "unknown export location"
-							( warning "unknown export location, likely due to the export conflict"
+					)
-							, warning "unknown export location"
+				(l:_) -> do
-							)
+					unlessM (retrieveExport (exportActions r) k l dest p) $
-						return False
+						giveup "retrieving from export failed"
-					(l:_) -> retrieveExport (exportActions r) k l dest p
+					return UnVerified
-			else do
+		| otherwise = giveup $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ " backend"
-				warning $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ " backend"
-				return False

Remote/Helper/Hooks.hs

@@ -34,7 +34,9 @@ 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 af f -> wrapper $ retrieveKeyFileCheap r k af f
+		, retrieveKeyFileCheap = case retrieveKeyFileCheap r of
+			Just a -> Just $ \k af f -> wrapper $ a k af f
+			Nothing -> Nothing
 		, removeKey = wrapper . removeKey r
 		, checkPresent = wrapper . checkPresent r
 		}

Remote/Helper/P2P.hs

@@ -39,11 +39,13 @@ store runner k af p = do
 			Just False -> giveup "transfer failed"
 			Nothing -> giveup "can't connect to remote"
 
-retrieve :: (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+retrieve :: (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
 retrieve runner k af dest p =
 	metered (Just p) k $ \m p' -> 
-		fromMaybe (False, UnVerified)
+		runner p' (P2P.get dest k af m p') >>= \case
-			<$> runner p' (P2P.get dest k af m p')
+			Just (True, v) -> return v
+			Just (False, _) -> giveup "transfer failed"
+			Nothing -> giveup "can't connec to remote"
 
 remove :: ProtoRunner Bool -> Key -> Annex Bool
 remove runner k = fromMaybe False <$> runner (P2P.remove k)

Remote/Helper/Special.hs

@@ -21,7 +21,7 @@ module Remote.Helper.Special (
 	fileRetriever,
 	byteRetriever,
 	storeKeyDummy,
-	retreiveKeyFileDummy,
+	retrieveKeyFileDummy,
 	removeKeyDummy,
 	checkPresentDummy,
 	SpecialRemoteCfg(..),
@@ -112,7 +112,7 @@ fileRetriever a k m callback = do
 -- A Retriever that generates a lazy ByteString containing the Key's
 -- content, and passes it to a callback action which will fully consume it
 -- before returning.
-byteRetriever :: (Key -> (L.ByteString -> Annex Bool) -> Annex Bool) -> Retriever
+byteRetriever :: (Key -> (L.ByteString -> Annex ()) -> Annex ()) -> Retriever
 byteRetriever a k _m callback = a k (callback . ByteContent)
 
 {- The base Remote that is provided to specialRemote needs to have
@@ -122,8 +122,8 @@ byteRetriever a k _m callback = a k (callback . ByteContent)
  -}
 storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex ()
 storeKeyDummy _ _ _ = error "missing storeKey implementation"
-retreiveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+retrieveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-retreiveKeyFileDummy _ _ _ _ = unVerified (return False)
+retrieveKeyFileDummy _ _ _ _ = error "missing retrieveKeyFile implementation"
 removeKeyDummy :: Key -> Annex Bool
 removeKeyDummy _ = return False
 checkPresentDummy :: Key -> Annex Bool
@@ -168,11 +168,13 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
   where
 	encr = baser
 		{ storeKey = \k _f p -> cip >>= storeKeyGen k p
-		, retrieveKeyFile = \k _f d p -> cip >>= unVerified . retrieveKeyFileGen k d p
+		, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
-		, retrieveKeyFileCheap = \k f d -> cip >>= maybe
+		, retrieveKeyFileCheap = case retrieveKeyFileCheap baser of
-			(retrieveKeyFileCheap baser k f d)
+			Nothing -> Nothing
-			-- retrieval of encrypted keys is never cheap
+			Just a
-			(\_ -> return False)
+				-- retrieval of encrypted keys is never cheap
+				| isencrypted -> Nothing
+				| otherwise -> Just $ \k f d -> a k f d
 		-- When encryption is used, the remote could provide
 		-- some other content encrypted by the user, and trick
 		-- git-annex into decrypting it, leaking the decryption
@@ -226,10 +228,11 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 					storer (enck k) (ByteContent encb) p
 
 	-- call retriever to get chunks; decrypt them; stream to dest file
-	retrieveKeyFileGen k dest p enc = safely $
+	retrieveKeyFileGen k dest p enc = do
 		displayprogress p k Nothing $ \p' ->
 			retrieveChunks retriever (uuid baser) chunkconfig
 				enck k dest p' (sink dest enc encr)
+		return UnVerified
 	  where
 		enck = maybe id snd enc
 
@@ -268,27 +271,25 @@ sink
 	-> Maybe Handle
 	-> Maybe MeterUpdate
 	-> ContentSource
-	-> Annex Bool
+	-> Annex ()
-sink dest enc c mh mp content = do
+sink dest enc c mh mp content = case (enc, mh, content) of
-	case (enc, mh, content) of
+	(Nothing, Nothing, FileContent f)
-		(Nothing, Nothing, FileContent f)
+		| f == dest -> noop
-			| f == dest -> noop
+		| otherwise -> liftIO $ moveFile f dest
-			| otherwise -> liftIO $ moveFile f dest
+	(Just (cipher, _), _, ByteContent b) -> do
-		(Just (cipher, _), _, ByteContent b) -> do
+		cmd <- gpgCmd <$> Annex.getGitConfig
-			cmd <- gpgCmd <$> Annex.getGitConfig
+		decrypt cmd c cipher (feedBytes b) $
+			readBytes write
+	(Just (cipher, _), _, FileContent f) -> do
+		cmd <- gpgCmd <$> Annex.getGitConfig
+		withBytes content $ \b ->
 			decrypt cmd c cipher (feedBytes b) $
 				readBytes write
-		(Just (cipher, _), _, FileContent f) -> do
+		liftIO $ nukeFile f
-			cmd <- gpgCmd <$> Annex.getGitConfig
+	(Nothing, _, FileContent f) -> do
-			withBytes content $ \b ->
+		withBytes content write
-				decrypt cmd c cipher (feedBytes b) $
+		liftIO $ nukeFile f
-					readBytes write
+	(Nothing, _, ByteContent b) -> write b
-			liftIO $ nukeFile f
-		(Nothing, _, FileContent f) -> do
-			withBytes content write
-			liftIO $ nukeFile f
-		(Nothing, _, ByteContent b) -> write b
-	return True
   where
 	write b = case mh of
 		Just h -> liftIO $ b `streamto` h

Remote/Hook.hs

@@ -59,8 +59,8 @@ gen r u rc gc rs = do
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = storeKeyDummy
-			, retrieveKeyFile = retreiveKeyFileDummy
+			, retrieveKeyFile = retrieveKeyFileDummy
-			, retrieveKeyFileCheap = retrieveCheap hooktype
+			, retrieveKeyFileCheap = Nothing
 			-- A hook could use http and be vulnerable to
 			-- redirect to file:// attacks, etc.
 			, retrievalSecurityPolicy = mkRetrievalVerifiableKeysSecure gc
@@ -162,9 +162,6 @@ retrieve h = fileRetriever $ \d k _p ->
 	unlessM (runHook' h "retrieve" k (Just d) $ return True) $
 		giveup "failed to retrieve content"
 
-retrieveCheap :: HookName -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieveCheap _ _ _ _ = return False
-
 remove :: HookName -> Remover
 remove h k = runHook' h "remove" k Nothing $ return True
 

Remote/P2P.hs

@@ -56,7 +56,7 @@ chainGen addr r u rc gc rs = do
 		, name = Git.repoDescribe r
 		, storeKey = store (const protorunner)
 		, retrieveKeyFile = retrieve (const protorunner)
-		, retrieveKeyFileCheap = \_ _ _ -> return False
+		, retrieveKeyFileCheap = Nothing
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = remove protorunner
 		, lockContent = Just $ lock withconn runProtoConn u 

Remote/Rsync.hs

@@ -89,8 +89,8 @@ gen r u rc gc rs = do
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = storeKeyDummy
-			, retrieveKeyFile = retreiveKeyFileDummy
+			, retrieveKeyFile = retrieveKeyFileDummy
-			, retrieveKeyFileCheap = retrieveCheap o
+			, retrieveKeyFileCheap = Just (retrieveCheap o)
 			, retrievalSecurityPolicy = RetrievalAllKeysSecure
 			, removeKey = removeKeyDummy
 			, lockContent = Nothing
@@ -237,12 +237,13 @@ storeGeneric' o meterupdate basedest populatedest = withRsyncScratchDir $ \tmp -
 		else return False
 
 retrieve :: RsyncOpts -> FilePath -> Key -> MeterUpdate -> Annex ()
-retrieve o f k p = 
+retrieve o f k p = rsyncRetrieveKey o k f (Just p)
-	unlessM (rsyncRetrieveKey o k f (Just p)) $
-		giveup "rsync failed"
 
-retrieveCheap :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex ()
-retrieveCheap o k _af f = ifM (preseedTmp k f) ( rsyncRetrieveKey o k f Nothing , return False )
+retrieveCheap o k _af f = ifM (preseedTmp k f)
+	( rsyncRetrieveKey o k f Nothing
+	, giveup "cannot preseed rsync with existing content"
+	)
 
 remove :: RsyncOpts -> Remover
 remove o k = removeGeneric o includes
@@ -358,8 +359,10 @@ rsyncRetrieve o rsyncurls dest meterupdate =
 		, File dest
 		]
 
-rsyncRetrieveKey :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex Bool
+rsyncRetrieveKey :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex ()
-rsyncRetrieveKey o k dest meterupdate = rsyncRetrieve o (rsyncUrls o k) dest meterupdate
+rsyncRetrieveKey o k dest meterupdate =
+	unlessM (rsyncRetrieve o (rsyncUrls o k) dest meterupdate) $
+		giveup "rsync failed"
 
 showResumable :: Annex Bool -> Annex Bool
 showResumable a = ifM a

Remote/S3.hs

@@ -193,8 +193,8 @@ gen r u rc gc rs = do
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = storeKeyDummy
-			, retrieveKeyFile = retreiveKeyFileDummy
+			, retrieveKeyFile = retrieveKeyFileDummy
-			, retrieveKeyFileCheap = retrieveCheap
+			, retrieveKeyFileCheap = Nothing
 			-- HttpManagerRestricted is used here, so this is
 			-- secure.
 			, retrievalSecurityPolicy = RetrievalAllKeysSecure
@@ -418,9 +418,6 @@ retrieveHelper' h f p req = liftIO $ runResourceT $ do
 	S3.GetObjectResponse { S3.gorResponse = rsp } <- sendS3Handle h req
 	Url.sinkResponseFile p zeroBytesProcessed f WriteMode rsp
 
-retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
-
 remove :: S3HandleVar -> Remote -> S3Info -> Remover
 remove hv r info k = withS3HandleOrFail (uuid r) hv $ \h -> liftIO $ runResourceT $ do
 	res <- tryNonAsync $ sendS3Handle h $

Remote/Tahoe.hs

@@ -87,7 +87,7 @@ gen r u rc gc rs = do
 		, name = Git.repoDescribe r
 		, storeKey = store rs hdl
 		, retrieveKeyFile = retrieve rs hdl
-		, retrieveKeyFileCheap = \_ _ _ -> return False
+		, retrieveKeyFileCheap = Nothing
 		-- Tahoe cryptographically verifies content.
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = remove
@@ -141,11 +141,14 @@ store rs hdl k _f _p = sendAnnex k noop $ \src ->
 		(giveup "tahoe failed to store content")
 		(\cap -> storeCapability rs k cap)
 
-retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-retrieve rs hdl k _f d _p = unVerified $ go =<< getCapability rs k
+retrieve rs hdl k _f d _p = do
+	go =<< getCapability rs k
+	return UnVerified
   where
-	go Nothing = return False
+	go Nothing = giveup "tahoe capability is not known"
-	go (Just cap) = liftIO $ requestTahoe hdl "get" [Param cap, File d]
+	go (Just cap) = unlessM (liftIO $ requestTahoe hdl "get" [Param cap, File d]) $
+		giveup "tahoe failed to reteieve content"
 
 remove :: Key -> Annex Bool
 remove _k = do

Remote/Web.hs

@@ -52,7 +52,7 @@ gen r _ rc gc rs = do
 		, name = Git.repoDescribe r
 		, storeKey = uploadKey
 		, retrieveKeyFile = downloadKey
-		, retrieveKeyFileCheap = downloadKeyCheap
+		, retrieveKeyFileCheap = Nothing
 		-- HttpManagerRestricted is used here, so this is
 		-- secure.
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
@@ -80,22 +80,22 @@ gen r _ rc gc rs = do
 		, remoteStateHandle = rs
 		}
 
-downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-downloadKey key _af dest p = unVerified $ get =<< getWebUrls key
+downloadKey key _af dest p = do
+	get =<< getWebUrls key
+	return UnVerified
   where
-	get [] = do
+	get [] = giveup "no known url"
-		warning "no known url"
+	get urls = do
-		return False
+		r <- untilTrue urls $ \u -> do
-	get urls = untilTrue urls $ \u -> do
+			let (u', downloader) = getDownloader u
-		let (u', downloader) = getDownloader u
+			case downloader of
-		case downloader of
+				YoutubeDownloader -> do
-			YoutubeDownloader -> do
+					showOutput
-				showOutput
+					youtubeDlTo key u' dest
-				youtubeDlTo key u' dest
+				_ -> Url.withUrlOptions $ downloadUrl key p [u'] dest
-			_ -> Url.withUrlOptions $ downloadUrl key p [u'] dest
+		unless r $
-
+			giveup "download failed"
-downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
-downloadKeyCheap _ _ _ = return False
 
 uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex ()
 uploadKey _ _ _ = giveup "upload to web not supported"

Remote/WebDAV.hs

@@ -84,8 +84,8 @@ gen r u rc gc rs = do
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = storeKeyDummy
-			, retrieveKeyFile = retreiveKeyFileDummy
+			, retrieveKeyFile = retrieveKeyFileDummy
-			, retrieveKeyFileCheap = retrieveCheap
+			, retrieveKeyFileCheap = Nothing
 			-- HttpManagerRestricted is used here, so this is
 			-- secure.
 			, retrievalSecurityPolicy = RetrievalAllKeysSecure
@@ -162,9 +162,6 @@ finalizeStore dav tmp dest = do
 	maybe noop (void . mkColRecursive) (locationParent dest)
 	moveDAV (baseURL dav) tmp dest
 
-retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
-
 retrieve :: DavHandleVar -> ChunkConfig -> Retriever
 retrieve hv cc = fileRetriever $ \d k p ->
 	withDavHandle hv $ \dav -> case cc of

Types/Remote.hs

@@ -89,10 +89,12 @@ data RemoteA a = Remote
 	-- Retrieves a key's contents to a file.
 	-- (The MeterUpdate does not need to be used if it writes
 	-- sequentially to the file.)
-	, retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a (Bool, Verification)
+	-- Throws exception on failure.
+	, retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a Verification
 	-- Retrieves a key's contents to a tmp file, if it can be done cheaply.
 	-- It's ok to create a symlink or hardlink.
-	, retrieveKeyFileCheap :: Key -> AssociatedFile -> FilePath -> a Bool
+	-- Throws exception on failure.
+	, retrieveKeyFileCheap :: Maybe (Key -> AssociatedFile -> FilePath -> a ())
 	-- Security policy for reteiving keys from this remote.
 	, retrievalSecurityPolicy :: RetrievalSecurityPolicy
 	-- Removes a key's contents (succeeds if the contents are not present)
@@ -186,7 +188,7 @@ data Verification
 	-- ^ Content likely to have been altered during transfer,
 	-- verify even if verification is normally disabled
 
-unVerified :: Monad m => m Bool -> m (Bool, Verification)
+unVerified :: Monad m => m a -> m (a, Verification)
 unVerified a = do
 	ok <- a
 	return (ok, UnVerified)

Types/StoreRetrieve.hs

@@ -28,7 +28,7 @@ type Storer = Key -> ContentSource -> MeterUpdate -> Annex ()
 -- Action that retrieves a Key's content from a remote, passing it to a
 -- callback, which will fully consume the content before returning.
 -- Throws exception if key is not present, or remote is not accessible.
-type Retriever = Key -> MeterUpdate -> (ContentSource -> Annex Bool) -> Annex Bool
+type Retriever = Key -> MeterUpdate -> (ContentSource -> Annex ()) -> Annex ()
 
 -- Action that removes a Key's content from a remote.
 -- Succeeds if key is already not present; never throws exceptions.