change retrieveExport and getKey to throw exception

retrieveExport is part of ongoing transition to make remote methods
throw exceptions, rather than silently hide them.

getKey very rarely fails, and when it does it's always for the same reason
(user configured annex.backend to url for some reason). So, this will
avoid dealing with Nothing everywhere it's used.

This commit was sponsored by Ilya Shlyakhter on Patreon.

Annex/Import.hs

@@ -349,16 +349,20 @@ downloadImport remote importtreeconfig importablecontents = do
 			return (Right job)
 	
 	download cidmap db (loc, (cid, sz)) = do
-		let rundownload tmpfile p = 
+		let downloader tmpfile p = do
-			Remote.retrieveExportWithContentIdentifier ia loc cid tmpfile (mkkey loc tmpfile) p >>= \case
+			k <- Remote.retrieveExportWithContentIdentifier ia loc cid tmpfile (mkkey loc tmpfile) p
-				Just k -> tryNonAsync (moveAnnex k tmpfile) >>= \case
+			ok <- moveAnnex k tmpfile
-					Right True -> do
+			return (k, ok)
+		let rundownload tmpfile p = tryNonAsync (downloader tmpfile p) >>= \case
+			Right (k, True) -> do
 				recordcidkey cidmap db cid k
 				logStatus k InfoPresent
 				logChange k (Remote.uuid remote) InfoPresent
 				return $ Just (loc, k)
-					_ -> return Nothing
+			Right (_, False) -> return Nothing
-				Nothing -> return Nothing
+			Left e -> do
+				warning (show e)
+				return Nothing
 		checkDiskSpaceToGet tmpkey Nothing $
 			withTmp tmpkey $ \tmpfile ->
 				metered Nothing tmpkey $
@@ -375,7 +379,7 @@ downloadImport remote importtreeconfig importablecontents = do
 			, contentLocation = toRawFilePath tmpfile
 			, inodeCache = Nothing
 			}
-		fmap fst <$> genKey ks nullMeterUpdate backend
+		fst <$> genKey ks nullMeterUpdate backend
 
 	locworktreefilename loc = asTopFilePath $ case importtreeconfig of
 		ImportTree -> fromImportLocation loc

Annex/Ingest.hs

@@ -159,8 +159,8 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
 				(chooseBackend $ fromRawFilePath $ keyFilename source)
 				(return . Just)
 				preferredbackend
-			fmap fst <$> genKey source meterupdate backend
+			fst <$> genKey source meterupdate backend
-		Just k -> return (Just k)
+		Just k -> return k
 	let src = contentLocation source
 	ms <- liftIO $ catchMaybeIO $ R.getFileStatus src
 	mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta (fromRawFilePath src)) ms
@@ -169,10 +169,9 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
 		(Just newc, Just c) | compareStrong c newc -> go k mcache ms
 		_ -> failure "changed while it was being added"
   where
-	go (Just key) mcache (Just s)
+	go key mcache (Just s)
 		| lockingFile cfg = golocked key mcache s
 		| otherwise = gounlocked key mcache s
-	go _ _ _ = failure "failed to generate a key"
 
 	golocked key mcache s =
 		tryNonAsync (moveAnnex key $ fromRawFilePath $ contentLocation source) >>= \case

Annex/Url.hs

@@ -14,6 +14,7 @@ module Annex.Url (
 	ipAddressesUnlimited,
 	checkBoth,
 	download,
+	download',
 	exists,
 	getUrlInfo,
 	U.downloadQuiet,
@@ -172,6 +173,10 @@ download meterupdate url file uo =
 		Right () -> return True
 		Left err -> warning err >> return False
 
+download' :: MeterUpdate -> U.URLString -> FilePath -> U.UrlOptions -> Annex (Either String ())
+download' meterupdate url file uo =
+	liftIO (U.download meterupdate url file uo)
+
 exists :: U.URLString -> U.UrlOptions -> Annex Bool
 exists url uo = liftIO (U.exists url uo) >>= \case
 	Right b -> return b

Backend.hs

@@ -51,12 +51,15 @@ defaultBackend = maybe cache return =<< Annex.getState Annex.backend
 	lookupname = lookupBackendVariety . parseKeyVariety . encodeBS
 
 {- Generates a key for a file. -}
-genKey :: KeySource -> MeterUpdate -> Maybe Backend -> Annex (Maybe (Key, Backend))
+genKey :: KeySource -> MeterUpdate -> Maybe Backend -> Annex (Key, Backend)
 genKey source meterupdate preferredbackend = do
 	b <- maybe defaultBackend return preferredbackend
-	B.getKey b source meterupdate >>= return . \case
+	case B.getKey b of
-		Nothing -> Nothing
+		Just a -> do
-		Just k -> Just (makesane k, b)
+			k <- a source meterupdate
+			return (makesane k, b)
+		Nothing -> giveup $ "Cannot generate a key for backend " ++
+			decodeBS (formatKeyVariety (B.backendVariety b))
   where
 	-- keyNames should not contain newline characters.
 	makesane k = alterKey k $ \d -> d

Backend/Hash.hs

@@ -63,7 +63,7 @@ backends = concatMap (\h -> [genBackendE h, genBackend h]) hashes
 genBackend :: Hash -> Backend
 genBackend hash = Backend
 	{ backendVariety = hashKeyVariety hash (HasExt False)
-	, getKey = keyValue hash
+	, getKey = Just (keyValue hash)
 	, verifyKeyContent = Just $ checkKeyChecksum hash
 	, canUpgradeKey = Just needsUpgrade
 	, fastMigrate = Just trivialMigrate
@@ -73,7 +73,7 @@ genBackend hash = Backend
 genBackendE :: Hash -> Backend
 genBackendE hash = (genBackend hash)
 	{ backendVariety = hashKeyVariety hash (HasExt True)
-	, getKey = keyValueE hash
+	, getKey = Just (keyValueE hash)
 	}
 
 hashKeyVariety :: Hash -> HasExt -> KeyVariety
@@ -88,26 +88,26 @@ hashKeyVariety (Blake2sHash size) he = Blake2sKey size he
 hashKeyVariety (Blake2spHash size) he = Blake2spKey size he
 
 {- A key is a hash of its contents. -}
-keyValue :: Hash -> KeySource -> MeterUpdate -> Annex (Maybe Key)
+keyValue :: Hash -> KeySource -> MeterUpdate -> Annex Key
 keyValue hash source meterupdate = do
 	let file = fromRawFilePath (contentLocation source)
 	filesize <- liftIO $ getFileSize file
 	s <- hashFile hash file meterupdate
-	return $ Just $ mkKey $ \k -> k
+	return $ mkKey $ \k -> k
 		{ keyName = encodeBS s
 		, keyVariety = hashKeyVariety hash (HasExt False)
 		, keySize = Just filesize
 		}
 
 {- Extension preserving keys. -}
-keyValueE :: Hash -> KeySource -> MeterUpdate -> Annex (Maybe Key)
+keyValueE :: Hash -> KeySource -> MeterUpdate -> Annex Key
 keyValueE hash source meterupdate =
-	keyValue hash source meterupdate >>= maybe (return Nothing) addE
+	keyValue hash source meterupdate >>= addE
   where
 	addE k = do
 		maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig
 		let ext = selectExtension maxlen (keyFilename source)
-		return $ Just $ alterKey k $ \d -> d
+		return $ alterKey k $ \d -> d
 			{ keyName = keyName d <> ext
 			, keyVariety = hashKeyVariety hash (HasExt True)
 			}
@@ -296,7 +296,10 @@ md5Hasher = show . md5
 testKeyBackend :: Backend
 testKeyBackend = 
 	let b = genBackendE (SHA2Hash (HashSize 256))
-	in b { getKey = \ks p -> (fmap addE) <$> getKey b ks p } 
+	    gk = case getKey b of
+		Nothing -> Nothing
+		Just f -> Just (\ks p -> addE <$> f ks p)
+	in b { getKey = gk }
   where
 	addE k = alterKey k $ \d -> d
 		{ keyName = keyName d <> longext

Backend/URL.hs

@@ -21,7 +21,7 @@ backends = [backend]
 backend :: Backend
 backend = Backend
 	{ backendVariety = URLKey
-	, getKey = \_ _ -> return Nothing
+	, getKey = Nothing
 	, verifyKeyContent = Nothing
 	, canUpgradeKey = Nothing
 	, fastMigrate = Nothing

Backend/WORM.hs

@@ -24,7 +24,7 @@ backends = [backend]
 backend :: Backend
 backend = Backend
 	{ backendVariety = WORMKey
-	, getKey = keyValue
+	, getKey = Just keyValue
 	, verifyKeyContent = Nothing
 	, canUpgradeKey = Just needsUpgrade
 	, fastMigrate = Just removeSpaces
@@ -34,14 +34,14 @@ backend = Backend
 {- The key includes the file size, modification time, and the
  - original filename relative to the top of the git repository.
  -}
-keyValue :: KeySource -> MeterUpdate -> Annex (Maybe Key)
+keyValue :: KeySource -> MeterUpdate -> Annex Key
 keyValue source _ = do
 	let f = contentLocation source
 	stat <- liftIO $ R.getFileStatus f
 	sz <- liftIO $ getFileSize' (fromRawFilePath f) stat
 	relf <- fromRawFilePath . getTopFilePath
 		<$> inRepo (toTopFilePath $ keyFilename source)
-	return $ Just $ mkKey $ \k -> k
+	return $ mkKey $ \k -> k
 		{ keyName = genKeyName relf
 		, keyVariety = WORMKey
 		, keySize = Just sz

Command/AddUrl.hs

@@ -313,7 +313,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
 	normalfinish tmp = checkCanAdd file $ do
 		showDestinationFile file
 		createWorkTreeDirectory (parentDir file)
-		finishDownloadWith addunlockedmatcher tmp webUUID url file
+		Just <$> finishDownloadWith addunlockedmatcher tmp webUUID url file
 	tryyoutubedl tmp
 		-- Ask youtube-dl what filename it will download
 		-- first, and check if that is already an annexed file,
@@ -388,7 +388,7 @@ downloadWith addunlockedmatcher downloader dummykey u url file =
   where
 	afile = AssociatedFile (Just (toRawFilePath file))
 	go Nothing = return Nothing
-	go (Just tmp) = finishDownloadWith addunlockedmatcher tmp u url file
+	go (Just tmp) = Just <$> finishDownloadWith addunlockedmatcher tmp u url file
 
 {- Like downloadWith, but leaves the dummy key content in
  - the returned location. -}
@@ -404,7 +404,7 @@ downloadWith' downloader dummykey u url afile =
 			then return (Just tmp)
 			else return Nothing
 
-finishDownloadWith :: AddUnlockedMatcher -> FilePath -> UUID -> URLString -> FilePath -> Annex (Maybe Key)
+finishDownloadWith :: AddUnlockedMatcher -> FilePath -> UUID -> URLString -> FilePath -> Annex Key
 finishDownloadWith addunlockedmatcher tmp u url file = do
 	backend <- chooseBackend file
 	let source = KeySource
@@ -412,11 +412,9 @@ finishDownloadWith addunlockedmatcher tmp u url file = do
 		, contentLocation = toRawFilePath tmp
 		, inodeCache = Nothing
 		}
-	genKey source nullMeterUpdate backend >>= \case
+	key <- fst <$> genKey source nullMeterUpdate backend
-		Nothing -> return Nothing
-		Just (key, _) -> do
 	addWorkTree addunlockedmatcher u url file key (Just tmp)
-			return (Just key)
+	return key
 
 {- Adds the url size to the Key. -}
 addSizeUrlKey :: Url.UrlInfo -> Key -> Key

Command/CalcKey.hs

@@ -20,11 +20,11 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
 		(batchable run (pure ()))
 
 run :: () -> String -> Annex Bool
-run _ file = genKey ks nullMeterUpdate Nothing >>= \case
+run _ file = tryNonAsync (genKey ks nullMeterUpdate Nothing) >>= \case
-	Just (k, _) -> do
+	Right (k, _) -> do
 		liftIO $ putStrLn $ serializeKey k
 		return True
-	Nothing -> return False
+	Left _err -> return False
   where
 	ks = KeySource file' file' Nothing
 	file' = toRawFilePath file

Command/Import.hs

@@ -227,10 +227,8 @@ startLocal addunlockedmatcher largematcher mode (srcfile, destfile) =
 		case v of
 			Just ld -> do
 				backend <- chooseBackend destfile
-				v' <- genKey (keySource ld) nullMeterUpdate backend
+				k <- fst <$> genKey (keySource ld) nullMeterUpdate backend
-				case v' of
+				a (ld, k)
-					Just (k, _) -> a (ld, k)
-					Nothing -> giveup "failed to generate a key"
 			Nothing -> stop
 	checkdup k dupa notdupa = ifM (isKnownKey k)
 		( dupa

Command/Migrate.hs

@@ -89,10 +89,8 @@ perform file oldkey oldbackend newbackend = go =<< genkey (fastMigrate oldbacken
 			, contentLocation = content
 			, inodeCache = Nothing
 			}
-		v <- genKey source nullMeterUpdate (Just newbackend)
+		newkey <- fst <$> genKey source nullMeterUpdate (Just newbackend)
-		return $ case v of
+		return $ Just (newkey, False)
-			Just (newkey, _) -> Just (newkey, False)
-			_ -> Nothing
 	genkey (Just fm) = fm oldkey newbackend afile >>= \case
 		Just newkey -> return (Just (newkey, True))
 		Nothing -> genkey Nothing

Command/Reinject.hs

@@ -55,10 +55,8 @@ startSrcDest _ = giveup "specify a src file and a dest file"
 startKnown :: FilePath -> CommandStart
 startKnown src = notAnnexed src $
 	starting "reinject" (ActionItemOther (Just src)) $ do
-		mkb <- genKey ks nullMeterUpdate Nothing
+		(key, _) <- genKey ks nullMeterUpdate Nothing
-		case mkb of
+		ifM (isKnownKey key)
-			Nothing -> error "Failed to generate key"
-			Just (key, _) -> ifM (isKnownKey key)
 			( perform src key
 			, do
 				warning "Not known content; skipping"

Command/TestRemote.hs

@@ -329,10 +329,9 @@ testExportTree runannex mkr mkk1 mkk2 =
 		Remote.storeExport ea loc k testexportlocation nullMeterUpdate
 	retrieveexport ea k = withTmpFile "exported" $ \tmp h -> do
 		liftIO $ hClose h
-		ifM (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate)
+		tryNonAsync (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) >>= \case
-			( verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified k tmp
+			Left _ -> return False
-			, return False
+			Right () -> verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified k tmp
-			)
 	checkpresentexport ea k = Remote.checkPresentExport ea k testexportlocation
 	removeexport ea k = Remote.removeExport ea k testexportlocation
 	removeexportdirectory ea = case Remote.removeExportDirectory ea of
@@ -405,7 +404,7 @@ randKey :: Int -> Annex Key
 randKey sz = withTmpFile "randkey" $ \f h -> do
 	gen <- liftIO (newGenIO :: IO SystemRandom)
 	case genBytes sz gen of
-		Left e -> error $ "failed to generate random key: " ++ show e
+		Left e -> giveup $ "failed to generate random key: " ++ show e
 		Right (rand, _) -> liftIO $ B.hPut h rand
 	liftIO $ hClose h
 	let ks = KeySource
@@ -413,8 +412,9 @@ randKey sz = withTmpFile "randkey" $ \f h -> do
 		, contentLocation = toRawFilePath f
 		, inodeCache = Nothing
 		}
-	k <- fromMaybe (error "failed to generate random key")
+	k <- case Backend.getKey Backend.Hash.testKeyBackend of
-		<$> Backend.getKey Backend.Hash.testKeyBackend ks nullMeterUpdate
+		Just a -> a ks nullMeterUpdate
+		Nothing -> giveup "failed to generate random key (backend problem)"
 	_ <- moveAnnex k f
 	return k
 

Remote/Adb.hs

@@ -186,11 +186,14 @@ store'' serial dest src canoverwrite = checkAdbInPath False $ do
 retrieve :: AndroidSerial -> AndroidPath -> Retriever
 retrieve serial adir = fileRetriever $ \dest k _p ->
 	let src = androidLocation adir k
-	in unlessM (retrieve' serial src dest) $
+	in retrieve' serial src dest
-		giveup "adb pull failed"
 
-retrieve' :: AndroidSerial -> AndroidPath -> FilePath -> Annex Bool
+retrieve' :: AndroidSerial -> AndroidPath -> FilePath -> Annex ()
-retrieve' serial src dest = checkAdbInPath False $ do
+retrieve' serial src dest =
+	unlessM go $
+		giveup "adb pull failed"
+  where
+	go = checkAdbInPath False $ do
 		showOutput -- make way for adb pull output
 		liftIO $ boolSystem "adb" $ mkAdbCommand serial
 			[ Param "pull"
@@ -241,7 +244,7 @@ storeExportM serial adir src _k loc _p =
   where
 	dest = androidExportLocation adir loc
 
-retrieveExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
+retrieveExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
 retrieveExportM serial adir _k loc dest _p = retrieve' serial src dest
   where
 	src = androidExportLocation adir loc
@@ -305,17 +308,14 @@ listImportableContentsM serial adir =
 -- connection is resonably fast, it's probably as good as
 -- git's handling of similar situations with files being modified while
 -- it's updating the working tree for a merge.
-retrieveExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex (Maybe Key) -> MeterUpdate -> Annex (Maybe Key)
+retrieveExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key
-retrieveExportWithContentIdentifierM serial adir loc cid dest mkkey _p = catchDefaultIO Nothing $
+retrieveExportWithContentIdentifierM serial adir loc cid dest mkkey _p = do
-	ifM (retrieve' serial src dest)
+	retrieve' serial src dest
-		( do
 	k <- mkkey
 	currcid <- getExportContentIdentifier serial adir loc
-			return $ if currcid == Right (Just cid)
+	if currcid == Right (Just cid)
-				then k
+		then return k
-				else Nothing
+		else giveup "the file on the android device has changed"
-		, return Nothing
-		)
   where
 	src = androidExportLocation adir loc
 

Remote/Directory.hs

@@ -273,10 +273,9 @@ storeExportM d src _k loc p = liftIO $ do
   where
 	dest = exportPath d loc
 
-retrieveExportM :: FilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
+retrieveExportM :: FilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
-retrieveExportM d _k loc dest p = liftIO $ catchBoolIO $ do
+retrieveExportM d _k loc dest p = 
-	withMeteredFile src p (L.writeFile dest)
+	liftIO $ withMeteredFile src p (L.writeFile dest)
-	return True
   where
 	src = exportPath d loc
 
@@ -346,9 +345,9 @@ mkContentIdentifier f st =
 	fmap (ContentIdentifier . encodeBS . showInodeCache)
 		<$> toInodeCache noTSDelta f st
 
-retrieveExportWithContentIdentifierM :: FilePath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex (Maybe Key) -> MeterUpdate -> Annex (Maybe Key)
+retrieveExportWithContentIdentifierM :: FilePath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key
 retrieveExportWithContentIdentifierM dir loc cid dest mkkey p = 
-	catchDefaultIO Nothing $ precheck $ docopy postcheck
+	precheck $ docopy postcheck
   where
 	f = exportPath dir loc
 
@@ -404,7 +403,7 @@ retrieveExportWithContentIdentifierM dir loc cid dest mkkey p =
 	
 	comparecid cont currcid
 		| currcid == Just cid = cont
-		| otherwise = return Nothing
+		| otherwise = giveup "file content has changed"
 
 storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
 storeExportWithContentIdentifierM dir src _k loc overwritablecids p = do

Remote/External.hs

@@ -291,20 +291,17 @@ storeExportM external f k loc p = either giveup return =<< go
 		_ -> Nothing
 	req sk = TRANSFEREXPORT Upload sk f
 
-retrieveExportM :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
+retrieveExportM :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
-retrieveExportM external k loc d p = safely $
+retrieveExportM external k loc d p = either giveup return =<< go
-	handleRequestExport external loc req k (Just p) $ \resp -> case resp of
-		TRANSFER_SUCCESS Download k'
-			| k == k' -> result True
-		TRANSFER_FAILURE Download k' errmsg
-			| k == k' -> Just $ do
-				warning $ respErrorMessage "TRANSFER" errmsg
-				return (Result False)
-		UNSUPPORTED_REQUEST -> Just $ do
-			warning "TRANSFEREXPORT not implemented by external special remote"
-			return (Result False)
-		_ -> Nothing
   where
+	go = handleRequestExport external loc req k (Just p) $ \resp -> case resp of
+		TRANSFER_SUCCESS Download k'
+			| k == k' -> result $ Right ()
+		TRANSFER_FAILURE Download k' errmsg
+			| k == k' -> result $ Left $ respErrorMessage "TRANSFER" errmsg
+		UNSUPPORTED_REQUEST ->
+			result $ Left "TRANSFEREXPORT not implemented by external special remote"
+		_ -> Nothing
 	req sk = TRANSFEREXPORT Download sk d
 
 checkPresentExportM :: External -> Key -> ExportLocation -> Annex Bool

Remote/Helper/ExportImport.hs

@@ -37,7 +37,7 @@ instance HasExportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bo
 instance HasExportUnsupported (ExportActions Annex) where
 	exportUnsupported = ExportActions
 		{ storeExport = nope
-		, retrieveExport = \_ _ _ _ -> return False
+		, retrieveExport = nope
 		, checkPresentExport = \_ _ -> return False
 		, removeExport = \_ _ -> return False
 		, removeExportDirectory = Just $ \_ -> return False
@@ -56,7 +56,7 @@ instance HasImportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bo
 instance HasImportUnsupported (ImportActions Annex) where
 	importUnsupported = ImportActions
 		{ listImportableContents = return Nothing
-		, retrieveExportWithContentIdentifier = \_ _ _ _ _ -> return Nothing
+		, retrieveExportWithContentIdentifier = nope
 		, storeExportWithContentIdentifier = nope
 		, removeExportWithContentIdentifier = \_ _ _ -> return False
 		, removeExportDirectoryWhenEmpty = Just $ \_ -> return False
@@ -319,7 +319,6 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
 					, giveup "unknown export location"
 					)
 				(l:_) -> do
-					unlessM (retrieveExport (exportActions r) k l dest p) $
+					retrieveExport (exportActions r) k l dest p
-						giveup "retrieving from export failed"
 					return UnVerified
 		| otherwise = giveup $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ " backend"

Remote/Rsync.hs

@@ -315,7 +315,7 @@ storeExportM o src _k loc meterupdate =
 	basedest = fromRawFilePath (fromExportLocation loc)
 	populatedest = liftIO . createLinkOrCopy src
 
-retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
+retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
 retrieveExportM o _k loc dest p = rsyncRetrieve o [rsyncurl] dest (Just p)
   where
 	rsyncurl = mkRsyncUrl o (fromRawFilePath (fromExportLocation loc))
@@ -367,9 +367,12 @@ withRsyncScratchDir a = do
 	t <- fromRepo gitAnnexTmpObjectDir
 	withTmpDirIn t "rsynctmp" a
 
-rsyncRetrieve :: RsyncOpts -> [RsyncUrl] -> FilePath -> Maybe MeterUpdate -> Annex Bool
+rsyncRetrieve :: RsyncOpts -> [RsyncUrl] -> FilePath -> Maybe MeterUpdate -> Annex ()
 rsyncRetrieve o rsyncurls dest meterupdate = 
-	showResumable $ untilTrue rsyncurls $ \u -> rsyncRemote Download o meterupdate
+	unlessM go $
+		giveup "rsync failed"
+  where
+	go = showResumable $ untilTrue rsyncurls $ \u -> rsyncRemote Download o meterupdate
 		-- use inplace when retrieving to support resuming
 		[ Param "--inplace"
 		, Param u
@@ -378,8 +381,7 @@ rsyncRetrieve o rsyncurls dest meterupdate =
 
 rsyncRetrieveKey :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex ()
 rsyncRetrieveKey o k dest meterupdate =
-	unlessM (rsyncRetrieve o (rsyncUrls o k) dest meterupdate) $
+	rsyncRetrieve o (rsyncUrls o k) dest meterupdate
-		giveup "rsync failed"
 
 showResumable :: Annex Bool -> Annex Bool
 showResumable a = ifM a

Remote/S3.hs

@@ -474,20 +474,16 @@ storeExportS3' hv r rs info magic f k loc p = withS3Handle hv $ \case
 		setS3VersionID info rs k mvid
 		return (metag, mvid)
 
-retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
+retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
-retrieveExportS3 hv r info _k loc f p =
+retrieveExportS3 hv r info _k loc f p = do
-	catchNonAsync go (\e -> warning (show e) >> return False)
+	withS3Handle hv $ \case
-  where
+		Just h -> retrieveHelper info h (Left (T.pack exportloc)) f p
-	go = withS3Handle hv $ \case
-		Just h -> do
-			retrieveHelper info h (Left (T.pack exportloc)) f p
-			return True
 		Nothing -> case getPublicUrlMaker info of
-			Nothing -> do
+			Just geturl -> either giveup return =<<
-				warning $ needS3Creds (uuid r)
+				Url.withUrlOptions
-				return False
+					(Url.download' p (geturl exportloc) f)
-			Just geturl -> Url.withUrlOptions $ 
+			Nothing -> giveup $ needS3Creds (uuid r)
-				Url.download p (geturl exportloc) f
+  where
 	exportloc = bucketExportLocation info loc
 
 removeExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Key -> ExportLocation -> Annex Bool
@@ -634,21 +630,18 @@ mkImportableContentsVersioned info = build . groupfiles
 		| otherwise =
 			i : removemostrecent mtime rest
 
-retrieveExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> ExportLocation -> ContentIdentifier -> FilePath -> Annex (Maybe Key) -> MeterUpdate -> Annex (Maybe Key)
+retrieveExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> ExportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key
 retrieveExportWithContentIdentifierS3 hv r rs info loc cid dest mkkey p = withS3Handle hv $ \case
-	Nothing -> do
+	Just h -> do
-		warning $ needS3Creds (uuid r)
-		return Nothing
-	Just h -> flip catchNonAsync (\e -> warning (show e) >> return Nothing) $ do
 		rewritePreconditionException $ retrieveHelper' h dest p $
 			limitGetToContentIdentifier cid $
 				S3.getObject (bucket info) o
-		mk <- mkkey
+		k <- mkkey
-		case (mk, extractContentIdentifier cid o) of
+		case extractContentIdentifier cid o of
-			(Just k, Right vid) -> 
+			Right vid -> setS3VersionID info rs k vid
-				setS3VersionID info rs k vid
+			Left _ -> noop
-			_ -> noop
+		return k
-		return mk
+	Nothing -> giveup $ needS3Creds (uuid r)
   where
 	o = T.pack $ bucketExportLocation info loc
 

Remote/WebDAV.hs

@@ -213,12 +213,11 @@ storeExportDav hdl f k loc p = case exportLocation loc of
 		storeHelper dav (keyTmpLocation k) dest reqbody
 	Left err -> giveup err
 
-retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
+retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
 retrieveExportDav hdl  _k loc d p = case exportLocation loc of
-	Right src -> withDavHandle' hdl $ \mh -> runExport' mh $ \_dav -> do
+	Right src -> withDavHandle hdl $ \h -> runExport h $ \_dav ->
 		retrieveHelper src d p
-		return True
+	Left err -> giveup err
-	Left _err -> return False
 
 checkPresentExportDav :: DavHandleVar -> Remote -> Key -> ExportLocation -> Annex Bool
 checkPresentExportDav hdl _ _k loc = case exportLocation loc of

Test/Framework.hs

@@ -582,9 +582,10 @@ backend_ :: String -> Types.Backend
 backend_ = Backend.lookupBackendVariety . Types.Key.parseKeyVariety . encodeBS
 
 getKey :: Types.Backend -> FilePath -> IO Types.Key
-getKey b f = fromJust <$> annexeval go
+getKey b f = case Types.Backend.getKey b of
+	Just a -> annexeval $ a ks Utility.Metered.nullMeterUpdate
+	Nothing -> error "internal"
   where
-	go = Types.Backend.getKey b ks Utility.Metered.nullMeterUpdate
 	ks = Types.KeySource.KeySource
 		{ Types.KeySource.keyFilename = toRawFilePath f
 		, Types.KeySource.contentLocation = toRawFilePath f

Types/Backend.hs

@@ -17,7 +17,7 @@ import Utility.FileSystemEncoding
 
 data BackendA a = Backend
 	{ backendVariety :: KeyVariety
-	, getKey :: KeySource -> MeterUpdate -> a (Maybe Key) 
+	, getKey :: Maybe (KeySource -> MeterUpdate -> a Key)
 	-- Verifies the content of a key.
 	, verifyKeyContent :: Maybe (Key -> FilePath -> a Bool)
 	-- Checks if a key can be upgraded to a better form.

Types/Remote.hs

@@ -236,7 +236,8 @@ data ExportActions a = ExportActions
 	-- Retrieves exported content to a file.
 	-- (The MeterUpdate does not need to be used if it writes
 	-- sequentially to the file.)
-	, retrieveExport :: Key -> ExportLocation -> FilePath -> MeterUpdate -> a Bool
+	-- Throws exception on failure.
+	, retrieveExport :: Key -> ExportLocation -> FilePath -> MeterUpdate -> a ()
 	-- Removes an exported file (succeeds if the contents are not present)
 	, removeExport :: Key -> ExportLocation -> a Bool
 	-- Removes an exported directory. Typically the directory will be
@@ -269,15 +270,17 @@ data ImportActions a = ImportActions
 	-- This has to be used rather than retrieveExport
 	-- when a special remote supports imports, since files on such a
 	-- special remote can be changed at any time.
+	--
+	-- Throws exception on failure.
 	, retrieveExportWithContentIdentifier 
 		:: ExportLocation
 		-> ContentIdentifier
 		-- file to write content to
 		-> FilePath
 		-- callback that generates a key from the downloaded content
-		-> a (Maybe Key)
+		-> a Key
 		-> MeterUpdate
-		-> a (Maybe Key)
+		-> a Key
 	-- Exports content to an ExportLocation, and returns the
 	-- ContentIdentifier corresponding to the content it stored.
 	--