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:
parent
4814b444dd
commit
3334d3831b
23 changed files with 151 additions and 152 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue