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

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 4f05d61f67ac3aac6447867a03bf9fc0a35fca75..eba9c266dd469cdb4863f5239fe4c2bf2313b2ab 100644 (file)
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -53,7 +53,8 @@ module Annex.Content (
        isUnmodifiedCheap,
        verifyKeyContentPostRetrieval,
        verifyKeyContent,
-       VerifyConfig(..),
+       VerifyConfig,
+       VerifyConfigA(..),
        Verification(..),
        unVerified,
        withTmpWorkDir,
@@ -83,7 +84,7 @@ import Annex.InodeSentinal
 import Annex.ReplaceFile
 import Annex.AdjustedBranch (adjustedBranchRefresh)
 import Messages.Progress
-import Types.Remote (RetrievalSecurityPolicy(..))
+import Types.Remote (RetrievalSecurityPolicy(..), VerifyConfigA(..))
 import Types.NumCopies
 import Types.Key
 import Types.Transfer

diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs
index e6a6e4c8064418095cc8ae0fc2f0613241316503..c57dbaf3ecf81f099b35e467daf001cac50f6e2f 100644 (file)
--- a/Annex/Transfer.hs
+++ b/Annex/Transfer.hs
@@ -78,10 +78,11 @@ download r key f d witness = logStatusAfter key $ stallDetection r >>= \case
        Just StallDetectionDisabled -> go Nothing
        Just sd -> runTransferrer sd r key f d Download witness
   where
-       go sd = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) key f $ \dest ->
+       go sd = getViaTmp (Remote.retrievalSecurityPolicy r) vc key f $ \dest ->
                download' (Remote.uuid r) key f sd d (go' dest) witness
        go' dest p = verifiedAction $
-               Remote.retrieveKeyFile r key f (fromRawFilePath dest) p
+               Remote.retrieveKeyFile r key f (fromRawFilePath dest) p vc
+       vc = Remote.RemoteVerify r
 
 -- Download, not supporting canceling detected stalls.
 download' :: Observable v => UUID -> Key -> AssociatedFile -> Maybe StallDetection -> RetryDecider -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v

diff --git a/Annex/Verify.hs b/Annex/Verify.hs
index 4b5d81caee7064092b3ade66c8512d1ed2b03576..c41a793f622c1802ee61f2441f35bc0e742aba9e 100644 (file)
--- a/Annex/Verify.hs
+++ b/Annex/Verify.hs
@@ -8,7 +8,6 @@
 {-# LANGUAGE CPP #-}
 
 module Annex.Verify (
-       VerifyConfig(..),
        shouldVerify,
        verifyKeyContentPostRetrieval,
        verifyKeyContent,
@@ -24,6 +23,7 @@ module Annex.Verify (
 import Annex.Common
 import qualified Annex
 import qualified Types.Remote
+import Types.Remote (VerifyConfigA(..))
 import qualified Types.Backend
 import Types.Backend (IncrementalVerifier(..))
 import qualified Backend
@@ -39,8 +39,6 @@ import qualified Data.ByteString as S
 import qualified System.FilePath.ByteString as P
 #endif
 
-data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify
-
 shouldVerify :: VerifyConfig -> Annex Bool
 shouldVerify AlwaysVerify = return True
 shouldVerify NoVerify = return False

diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 916cbdaa521624194dd8dafd12a668579c6c2e3f..e12d44e2b5504fa0fee2cb29f2e97ab51ce526ef 100644 (file)
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -201,7 +201,8 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \ca
                        -- should use to download it.
                        setTempUrl urlkey loguri
                        let downloader = \dest p ->
-                               fst <$> Remote.verifiedAction (Remote.retrieveKeyFile r urlkey af dest p)
+                               fst <$> Remote.verifiedAction
+                                       (Remote.retrieveKeyFile r urlkey af dest p (RemoteVerify r))
                        ret <- downloadWith canadd addunlockedmatcher downloader urlkey (Remote.uuid r) loguri file
                        removeTempUrl urlkey
                        return ret

diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 5ab724362fd96bd1c4c13fbf3c20f4022b2e2959..2408c439d6e10b030b117dc312b6d8c753946270 100644 (file)
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -199,7 +199,7 @@ performRemote key afile backend numcopies remote =
                        )
                , return Nothing
                )
-       getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) (fromRawFilePath tmp) dummymeter
+       getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) (fromRawFilePath tmp) dummymeter (RemoteVerify remote)
        dummymeter _ = noop
        getcheap tmp = case Remote.retrieveKeyFileCheap remote of
                Just a -> isRight <$> tryNonAsync (a key afile (fromRawFilePath tmp))

diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index bc12e4580b2187666ecbab5e1e59f5eac135f6b4..9d7daa8297bd01a5174d464eb7806b8abf4b01e6 100644 (file)
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -297,7 +297,7 @@ test runannex mkr mkk =
                        Nothing -> return True
                        Just verifier -> verifier k (serializeKey' k)
        get r k = logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest ->
-               tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case
+               tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case
                        Right v -> return (True, v)
                        Left _ -> return (False, UnVerified)
        store r k = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
@@ -371,7 +371,7 @@ testUnavailable runannex mkr mkk =
                Remote.checkPresent r k
        , check (== Right False) "retrieveKeyFile" $ \r k ->
                logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest ->
-                       tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case
+                       tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case
                                Right v -> return (True, v)
                                Left _ -> return (False, UnVerified)
        , check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of

diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs
index 8eac1c6892fb0c71d09e8eaad2c432debec74ae6..6b38a0bc53aaccf903e4e3252e1b820eb9ef9f8d 100644 (file)
--- a/Command/TransferKey.hs
+++ b/Command/TransferKey.hs
@@ -63,12 +63,14 @@ toPerform key file remote = go Upload file $
 fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
 fromPerform key file remote = go Upload file $
        download' (uuid remote) key file Nothing stdRetry $ \p ->
-               logStatusAfter key $ getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t ->
-                       tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case
+               logStatusAfter key $ getViaTmp (retrievalSecurityPolicy remote) vc key file $ \t ->
+                       tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p vc) >>= \case
                                Right v -> return (True, v)     
                                Left e -> do
                                        warning (show e)
                                        return (False, UnVerified)
+  where
+       vc = RemoteVerify remote
 
 go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform
 go direction file a = notifyTransfer direction file a >>= liftIO . exitBool

diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs
index 5c55d23e84e490b565bb5bc7c5b63e8cf7710de8..699febbfaaddd4bf0dcd4fe436b2c3cc96d7edcd 100644 (file)
--- a/Command/TransferKeys.hs
+++ b/Command/TransferKeys.hs
@@ -51,7 +51,7 @@ start = do
                | otherwise = notifyTransfer direction file $
                        download' (Remote.uuid remote) key file Nothing stdRetry $ \p ->
                                logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do
-                                       r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case
+                                       r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
                                                Left e -> do
                                                        warning (show e)
                                                        return (False, UnVerified)

diff --git a/Command/Transferrer.hs b/Command/Transferrer.hs
index 77cd4d9ae510e0c0c462d7a1dee268ee1d776943..d3cf624a34deb9d4c1a7a5619c20a0dfb4929b5e 100644 (file)
--- a/Command/Transferrer.hs
+++ b/Command/Transferrer.hs
@@ -56,7 +56,7 @@ start = do
                -- and for retrying, and updating location log,
                -- and stall canceling.
                let go p = getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do
-                       Remote.verifiedAction (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p)
+                       Remote.verifiedAction (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote))
                in download' (Remote.uuid remote) key file Nothing noRetry go 
                        noNotification
        runner (AssistantUploadRequest _ key (TransferAssociatedFile file)) remote =
@@ -73,7 +73,7 @@ start = do
                notifyTransfer Download file $
                        download' (Remote.uuid remote) key file Nothing stdRetry $ \p ->
                                logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do
-                                       r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case
+                                       r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
                                                Left e -> do
                                                        warning (show e)
                                                        return (False, UnVerified)

diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index 723c0896c5caf892b9d348c3c913361a756823a0..818676eb6de4c189fbc7f6f1cc534afac180c92b 100644 (file)
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -96,8 +96,8 @@ gen r _ rc gc rs = do
                , remoteStateHandle = rs
                }
 
-downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-downloadKey key _file dest p = do
+downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+downloadKey key _file dest p _ = do
        get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key
        -- While bittorrent verifies the hash in the torrent file,
        -- the torrent file itself is downloaded without verification,

diff --git a/Remote/Git.hs b/Remote/Git.hs
index 4a2a3e0179e2b7c2893650d486eff1688ddb9ef7..352b920069db9e708be1f9eb4fed0655a85f5aa4 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -529,16 +529,16 @@ lockKey' repo r st@(State connpool duc _ _ _) key callback
        failedlock = giveup "can't lock content"
 
 {- Tries to copy a key's content from a remote's annex to a file. -}
-copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
+copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
 copyFromRemote = copyFromRemote' False
 
-copyFromRemote' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-copyFromRemote' forcersync r st key file dest meterupdate = do
+copyFromRemote' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+copyFromRemote' forcersync r st key file dest meterupdate vc = do
        repo <- getRepo r
-       copyFromRemote'' repo forcersync r st key file dest meterupdate
+       copyFromRemote'' repo forcersync r st key file dest meterupdate vc
 
-copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest meterupdate
+copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest meterupdate vc
        | Git.repoIsHttp repo = do
                gc <- Annex.getGitConfig
                ok <- Url.withUrlOptionsPromptingCreds $
@@ -555,12 +555,11 @@ copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest met
                                let checksuccess = check >>= \case
                                        Just err -> giveup err
                                        Nothing -> return True
-                               let verify = Annex.Content.RemoteVerify r
                                copier <- mkFileCopier hardlink st
                                (ok, v) <- runTransfer (Transfer Download u (fromKey id key))
                                        file Nothing stdRetry $ \p ->
                                                metered (Just (combineMeterUpdate p meterupdate)) key $ \_ p' -> 
-                                                       copier object dest key p' checksuccess verify
+                                                       copier object dest key p' checksuccess vc
                                if ok
                                        then return v
                                        else giveup "failed to retrieve content from remote"
@@ -572,9 +571,8 @@ copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest met
                                then return v
                                else giveup "failed to retrieve content from remote"
                else P2PHelper.retrieve
-                       (Annex.Content.RemoteVerify r)
                        (\p -> Ssh.runProto r connpool (return (False, UnVerified)) (fallback p))
-                       key file dest meterupdate
+                       key file dest meterupdate vc
        | otherwise = giveup "copying from non-ssh, non-http remote not supported"
   where
        fallback p = unVerified $ feedprogressback $ \p' -> do
@@ -699,7 +697,7 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
                res <- onLocalFast st $ ifM (Annex.Content.inAnnex key)
                        ( return True
                        , runTransfer (Transfer Download u (fromKey id key)) file Nothing stdRetry $ \p -> do
-                               let verify = Annex.Content.RemoteVerify r
+                               let verify = RemoteVerify r
                                copier <- mkFileCopier hardlink st
                                let rsp = RetrievalAllKeysSecure
                                let checksuccess = liftIO checkio >>= \case

diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs
index 77351b3077b7709ea05497c837d9f595e148f173..7e607ad89273e4d37cfdb8ace680954654cd4cc2 100644 (file)
--- a/Remote/Helper/ExportImport.hs
+++ b/Remote/Helper/ExportImport.hs
@@ -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
 

diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index c3f487516d1d13bcce1abcae267e7c2b41c0c2c8..3df75dd059335ea352ab4178dd4f618cd2d93ab0 100644 (file)
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -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

diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs
index 9e00101c875e3d986b4b4aea0c78be4552e646d8..647bc6b016d1b59d2ab0457fbb0c070f1efa0a08 100644 (file)
--- a/Remote/Helper/P2P.hs
+++ b/Remote/Helper/P2P.hs
@@ -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

diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 5528470da18420c986e5bdab7e01864b51ea84df..86ba114d8c7673980963302646822c793579ac5b 100644 (file)
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -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

diff --git a/Remote/HttpAlso.hs b/Remote/HttpAlso.hs
index 796ee19718c60fa1f63fcb830defc237f690cd81..522100dfc9afd2b8cfb641a49c59ca43d99a0cce 100644 (file)
--- a/Remote/HttpAlso.hs
+++ b/Remote/HttpAlso.hs
@@ -113,8 +113,8 @@ httpAlsoSetup _ (Just u) _ c gc = do
        gitConfigSpecialRemote u c' [("httpalso", "true")]
        return (c', u)
 
-downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-downloadKey baseurl ll key _af dest p = do
+downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+downloadKey baseurl ll key _af dest p _vc = do
        downloadAction dest p key (keyUrlAction baseurl ll key)
        return UnVerified
 

diff --git a/Remote/P2P.hs b/Remote/P2P.hs
index cc39ea9e0c50b7fa7c29591bd33a45c0ff8073fc..21cf5b42e10a198086809d0fac5c587d14f69448 100644 (file)
--- a/Remote/P2P.hs
+++ b/Remote/P2P.hs
@@ -13,7 +13,6 @@ module Remote.P2P (
 import Annex.Common
 import qualified Annex
 import qualified P2P.Protocol as P2P
-import qualified Annex.Content
 import P2P.Address
 import P2P.Annex
 import P2P.IO
@@ -57,7 +56,7 @@ chainGen addr r u rc gc rs = do
                , cost = cst
                , name = Git.repoDescribe r
                , storeKey = store (const protorunner)
-               , retrieveKeyFile = retrieve (Annex.Content.RemoteVerify this) (const protorunner)
+               , retrieveKeyFile = retrieve (const protorunner)
                , retrieveKeyFileCheap = Nothing
                , retrievalSecurityPolicy = RetrievalAllKeysSecure
                , removeKey = remove protorunner

diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index 22616c53c15e81573deee55b2703cc516f2ba0ca..22edac48101da28938e5793e45cde173edfd5b71 100644 (file)
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -144,8 +144,8 @@ store rs hdl k _f _p = sendAnnex k noop $ \src ->
                (giveup "tahoe failed to store content")
                (\cap -> storeCapability rs k cap)
 
-retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-retrieve rs hdl k _f d _p = do
+retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+retrieve rs hdl k _f d _p _ = do
        go =<< getCapability rs k
        -- Tahoe verifies the content it retrieves using cryptographically
        -- secure methods.

diff --git a/Remote/Web.hs b/Remote/Web.hs
index 6b18a2fb31cf438c09cb93858890f822edae2e62..049ed61120e7e9b3a864127a439f80fb588a43f5 100644 (file)
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -81,8 +81,8 @@ gen r _ rc gc rs = do
                , remoteStateHandle = rs
                }
 
-downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-downloadKey key _af dest p = do
+downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+downloadKey key _af dest p _ = do
        get =<< getWebUrls key
        return UnVerified
   where

diff --git a/Types.hs b/Types.hs
index 9f7a40b243a8a7dede9f2741b1e573bd51aca402..43c945e12ae102719ee60fb0bfe43f76a36d794f 100644 (file)
--- a/Types.hs
+++ b/Types.hs
@@ -15,6 +15,7 @@ module Types (
        RemoteGitConfig(..),
        Remote,
        RemoteType,
+       VerifyConfig,
 ) where
 
 import Annex
@@ -27,3 +28,4 @@ import Types.Remote
 type Backend = BackendA Annex
 type Remote = RemoteA Annex
 type RemoteType = RemoteTypeA Annex
+type VerifyConfig = VerifyConfigA Annex

diff --git a/Types/Remote.hs b/Types/Remote.hs
index ff1919bc4e5a3edc3f63de173c835cb0bf24da27..709d16da2fcc1adb49b71ae8cbc840b6f52fbe93 100644 (file)
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -16,6 +16,7 @@ module Types.Remote
        , RemoteStateHandle
        , SetupStage(..)
        , Availability(..)
+       , VerifyConfigA(..)
        , Verification(..)
        , unVerified
        , RetrievalSecurityPolicy(..)
@@ -95,7 +96,7 @@ data RemoteA a = Remote
        -- (The MeterUpdate does not need to be used if it writes
        -- sequentially to the file.)
        -- Throws exception on failure.
-       , retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a Verification
+       , retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfigA a -> a Verification
        -- Retrieves a key's contents to a tmp file, if it can be done cheaply.
        -- It's ok to create a symlink or hardlink.
        -- Throws exception on failure.
@@ -192,6 +193,12 @@ instance Ord (RemoteA a) where
 instance ToUUID (RemoteA a) where
        toUUID = uuid
 
+data VerifyConfigA a
+       = AlwaysVerify
+       | NoVerify
+       | RemoteVerify (RemoteA a)
+       | DefaultVerify
+
 data Verification
        = UnVerified 
        -- ^ Content was not verified during transfer, but is probably