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

@ -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
Nothing -> return Nothing
Just (key, _) -> do
addWorkTree addunlockedmatcher u url file key (Just tmp)
return (Just key)
key <- fst <$> genKey source nullMeterUpdate backend
addWorkTree addunlockedmatcher u url file key (Just tmp)
return key
{- Adds the url size to the Key. -}
addSizeUrlKey :: Url.UrlInfo -> Key -> Key

View file

@ -20,11 +20,11 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
(batchable run (pure ()))
run :: () -> String -> Annex Bool
run _ file = genKey ks nullMeterUpdate Nothing >>= \case
Just (k, _) -> do
run _ file = tryNonAsync (genKey ks nullMeterUpdate Nothing) >>= \case
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

View file

@ -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
case v' of
Just (k, _) -> a (ld, k)
Nothing -> giveup "failed to generate a key"
k <- fst <$> genKey (keySource ld) nullMeterUpdate backend
a (ld, k)
Nothing -> stop
checkdup k dupa notdupa = ifM (isKnownKey k)
( dupa

View file

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

View file

@ -55,15 +55,13 @@ 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
case mkb of
Nothing -> error "Failed to generate key"
Just (key, _) -> ifM (isKnownKey key)
( perform src key
, do
warning "Not known content; skipping"
next $ return True
)
(key, _) <- genKey ks nullMeterUpdate Nothing
ifM (isKnownKey key)
( perform src key
, do
warning "Not known content; skipping"
next $ return True
)
where
ks = KeySource src' src' Nothing
src' = toRawFilePath src

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