plumb VerifyConfig into retrieveKeyFile

This fixes the recent reversion that annex.verify is not honored,
because retrieveChunks was passed RemoteVerify baser, but baser
did not have export/import set up.

Sponsored-by: Dartmouth College's DANDI project
This commit is contained in:
Joey Hess 2021-08-17 12:41:36 -04:00
parent 4bbc6a25fa
commit f0754a61f5
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
21 changed files with 64 additions and 55 deletions

View file

@ -171,14 +171,14 @@ adjustExportImport' isexport isimport r rs = do
, lockContent = if versioned
then lockContent r
else Nothing
, retrieveKeyFile = \k af dest p ->
, retrieveKeyFile = \k af dest p vc ->
if isimport
then supportversionedretrieve k af dest p $
then supportversionedretrieve k af dest p vc $
retrieveKeyFileFromImport dbv ciddbv k af dest p
else if isexport
then supportversionedretrieve k af dest p $
then supportversionedretrieve k af dest p vc $
retrieveKeyFileFromExport dbv k af dest p
else retrieveKeyFile r k af dest p
else retrieveKeyFile r k af dest p vc
, retrieveKeyFileCheap = if versioned
then retrieveKeyFileCheap r
else Nothing
@ -369,9 +369,9 @@ adjustExportImport' isexport isimport r rs = do
-- versionedExport remotes have a key/value store, so can use
-- the usual retrieveKeyFile, rather than an import/export
-- variant. However, fall back to that if retrieveKeyFile fails.
supportversionedretrieve k af dest p a
supportversionedretrieve k af dest p vc a
| versionedExport (exportActions r) =
retrieveKeyFile r k af dest p
retrieveKeyFile r k af dest p vc
`catchNonAsync` const a
| otherwise = a

View file

@ -34,8 +34,10 @@ addHooks' r Nothing Nothing = r
addHooks' r starthook stophook = r'
where
r' = r
{ storeKey = \k f p -> wrapper $ storeKey r k f p
, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p
{ storeKey = \k f p ->
wrapper $ storeKey r k f p
, retrieveKeyFile = \k f d p vc ->
wrapper $ retrieveKeyFile r k f d p vc
, retrieveKeyFileCheap = case retrieveKeyFileCheap r of
Just a -> Just $ \k af f -> wrapper $ a k af f
Nothing -> Nothing

View file

@ -40,8 +40,8 @@ store runner k af p = do
Just False -> giveup "Transfer failed"
Nothing -> remoteUnavail
retrieve :: VerifyConfig -> (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
retrieve verifyconfig runner k af dest p = do
retrieve :: (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
retrieve runner k af dest p verifyconfig = do
iv <- startVerifyKeyContentIncrementally verifyconfig k
metered (Just p) k $ \m p' ->
runner p' (P2P.get dest k iv af m p') >>= \case

View file

@ -146,8 +146,8 @@ fileRetriever' a k m miv callback = do
-}
storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex ()
storeKeyDummy _ _ _ = error "missing storeKey implementation"
retrieveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
retrieveKeyFileDummy _ _ _ _ = error "missing retrieveKeyFile implementation"
retrieveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
retrieveKeyFileDummy _ _ _ _ _ = error "missing retrieveKeyFile implementation"
removeKeyDummy :: Key -> Annex ()
removeKeyDummy _ = error "missing removeKey implementation"
checkPresentDummy :: Key -> Annex Bool
@ -192,7 +192,7 @@ 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 >>= retrieveKeyFileGen k d p
, retrieveKeyFile = \k _f d p vc -> cip >>= retrieveKeyFileGen k d p vc
, retrieveKeyFileCheap = case retrieveKeyFileCheap baser of
Nothing -> Nothing
Just a
@ -241,11 +241,9 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
enck = maybe id snd enc
-- call retriever to get chunks; decrypt them; stream to dest file
retrieveKeyFileGen k dest p enc =
retrieveKeyFileGen k dest p vc enc =
displayprogress p k Nothing $ \p' ->
retrieveChunks retriever
(uuid baser)
(RemoteVerify baser)
retrieveChunks retriever (uuid baser) vc
chunkconfig enck k dest p' enc encr
where
enck = maybe id snd enc