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.
This commit is contained in:
Joey Hess 2020-05-15 12:51:09 -04:00
parent 4814b444dd
commit 3334d3831b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
23 changed files with 151 additions and 152 deletions

View file

@ -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)
( verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified k tmp
, return False
)
tryNonAsync (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) >>= \case
Left _ -> 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")
<$> Backend.getKey Backend.Hash.testKeyBackend ks nullMeterUpdate
k <- case Backend.getKey Backend.Hash.testKeyBackend of
Just a -> a ks nullMeterUpdate
Nothing -> giveup "failed to generate random key (backend problem)"
_ <- moveAnnex k f
return k