move verifyKeyContent to Annex.Verify

The goal is that Database.Keys be able to use it; it can't use
Annex.Content.Presence due to an import loop.

Several other things also needed to be moved to Annex.Verify as a
conseqence.

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 3a4759a22b514f2a1585f260044f960ef2019c03..7c9562103181bac561fd89bd7a24ff0f0c37efcf 100644 (file)
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -66,6 +66,7 @@ import Annex.Common
 import Annex.Content.Presence
 import Annex.Content.LowLevel
 import Annex.Content.PointerFile
+import Annex.Verify
 import qualified Git
 import qualified Annex
 import qualified Annex.Queue
@@ -253,7 +254,7 @@ getViaTmpFromDisk rsp v key af action = checkallowed $ do
        -- RetrievalSecurityPolicy would cause verification to always fail.
        checkallowed a = case rsp of
                RetrievalAllKeysSecure -> a
-               RetrievalVerifiableKeysSecure -> ifM (Backend.isVerifiable key)
+               RetrievalVerifiableKeysSecure -> ifM (isVerifiable key)
                        ( a
                        , ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)
                                ( a

diff --git a/Annex/Content/Presence.hs b/Annex/Content/Presence.hs
index b8f4fc635af436d088f3141513b15b7f67fc7ca7..bfcdec694cc77da33b00a291c37362062d66780f 100644 (file)
--- a/Annex/Content/Presence.hs
+++ b/Annex/Content/Presence.hs
@@ -17,11 +17,6 @@ module Annex.Content.Presence (
        isUnmodified,
        isUnmodified',
        isUnmodifiedCheap,
-       verifyKeyContent,
-       VerifyConfig(..),
-       Verification(..),
-       unVerified,
-       warnUnverifiableInsecure,
        contentLockFile,
 ) where
 
@@ -29,15 +24,10 @@ import Annex.Common
 import qualified Annex
 import Annex.Verify
 import Annex.LockPool
-import Annex.WorkerPool
-import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..))
-import qualified Types.Backend
-import qualified Backend
 import qualified Database.Keys
-import Types.Key
+import Types.Remote
 import Annex.InodeSentinal
 import Utility.InodeCache
-import Types.WorkerPool
 import qualified Utility.RawFilePath as R
 
 #ifdef mingw32_HOST_OS
@@ -189,55 +179,3 @@ isUnmodifiedCheap' key fc = isUnmodifiedCheap'' fc
 
 isUnmodifiedCheap'' :: InodeCache -> [InodeCache] -> Annex Bool
 isUnmodifiedCheap'' fc ic = anyM (compareInodeCaches fc) ic
-
-{- Verifies that a file is the expected content of a key.
- -
- - Configuration can prevent verification, for either a
- - particular remote or always, unless the RetrievalSecurityPolicy
- - requires verification.
- -
- - Most keys have a known size, and if so, the file size is checked.
- -
- - When the key's backend allows verifying the content (via checksum),
- - it is checked. 
- -
- - If the RetrievalSecurityPolicy requires verification and the key's
- - backend doesn't support it, the verification will fail.
- -}
-verifyKeyContent :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> RawFilePath -> Annex Bool
-verifyKeyContent rsp v verification k f = case (rsp, verification) of
-       (_, Verified) -> return True
-       (RetrievalVerifiableKeysSecure, _) -> ifM (Backend.isVerifiable k)
-               ( verify
-               , ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)
-                       ( verify
-                       , warnUnverifiableInsecure k >> return False
-                       )
-               )
-       (_, UnVerified) -> ifM (shouldVerify v)
-               ( verify
-               , return True
-               )
-       (_, MustVerify) -> verify
-  where
-       verify = enteringStage VerifyStage $ verifysize <&&> verifycontent
-       verifysize = case fromKey keySize k of
-               Nothing -> return True
-               Just size -> do
-                       size' <- liftIO $ catchDefaultIO 0 $ getFileSize f
-                       return (size' == size)
-       verifycontent = Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
-               Nothing -> return True
-               Just b -> case Types.Backend.verifyKeyContent b of
-                       Nothing -> return True
-                       Just verifier -> verifier k f
-
-warnUnverifiableInsecure :: Key -> Annex ()
-warnUnverifiableInsecure k = warning $ unwords
-       [ "Getting " ++ kv ++ " keys with this remote is not secure;"
-       , "the content cannot be verified to be correct."
-       , "(Use annex.security.allow-unverified-downloads to bypass"
-       , "this safety check.)"
-       ]
-  where
-       kv = decodeBS (formatKeyVariety (fromKey keyVariety k))

diff --git a/Annex/CopyFile.hs b/Annex/CopyFile.hs
index 63eb1a95f16f52009d55445a320c43421bd2cd6d..07f389995ee26f665e65f03243db04fbe15a6a15 100644 (file)
--- a/Annex/CopyFile.hs
+++ b/Annex/CopyFile.hs
@@ -16,7 +16,6 @@ import Utility.CopyFile
 import Utility.FileMode
 import Utility.Touch
 import Types.Backend
-import Backend
 import Annex.Verify
 
 import Control.Concurrent

diff --git a/Annex/Verify.hs b/Annex/Verify.hs
index 6d1a6ab37fd42b0aa6eadf08ab890c1f5e458b7f..826d0e7f403315a5d13cd10f9145112bd928d2c4 100644 (file)
--- a/Annex/Verify.hs
+++ b/Annex/Verify.hs
@@ -5,11 +5,28 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module Annex.Verify where
+module Annex.Verify (
+       VerifyConfig(..),
+       shouldVerify,
+       verifyKeyContent,
+       Verification(..),
+       unVerified,
+       warnUnverifiableInsecure,
+       isVerifiable,
+       startVerifyKeyContentIncrementally,
+       IncrementalVerifier(..),
+) where
 
 import Annex.Common
 import qualified Annex
 import qualified Types.Remote
+import qualified Types.Backend
+import Types.Backend (IncrementalVerifier(..))
+import qualified Backend
+import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..))
+import Annex.WorkerPool
+import Types.WorkerPool
+import Types.Key
 
 data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify
 
@@ -23,3 +40,70 @@ shouldVerify (RemoteVerify r) =
        -- Export remotes are not key/value stores, so always verify
        -- content from them even when verification is disabled.
        <||> Types.Remote.isExportSupported r
+
+{- Verifies that a file is the expected content of a key.
+ -
+ - Configuration can prevent verification, for either a
+ - particular remote or always, unless the RetrievalSecurityPolicy
+ - requires verification.
+ -
+ - Most keys have a known size, and if so, the file size is checked.
+ -
+ - When the key's backend allows verifying the content (via checksum),
+ - it is checked. 
+ -
+ - If the RetrievalSecurityPolicy requires verification and the key's
+ - backend doesn't support it, the verification will fail.
+ -}
+verifyKeyContent :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> RawFilePath -> Annex Bool
+verifyKeyContent rsp v verification k f = case (rsp, verification) of
+       (_, Verified) -> return True
+       (RetrievalVerifiableKeysSecure, _) -> ifM (isVerifiable k)
+               ( verify
+               , ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)
+                       ( verify
+                       , warnUnverifiableInsecure k >> return False
+                       )
+               )
+       (_, UnVerified) -> ifM (shouldVerify v)
+               ( verify
+               , return True
+               )
+       (_, MustVerify) -> verify
+  where
+       verify = enteringStage VerifyStage $ verifysize <&&> verifycontent
+       verifysize = case fromKey keySize k of
+               Nothing -> return True
+               Just size -> do
+                       size' <- liftIO $ catchDefaultIO 0 $ getFileSize f
+                       return (size' == size)
+       verifycontent = Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
+               Nothing -> return True
+               Just b -> case Types.Backend.verifyKeyContent b of
+                       Nothing -> return True
+                       Just verifier -> verifier k f
+
+warnUnverifiableInsecure :: Key -> Annex ()
+warnUnverifiableInsecure k = warning $ unwords
+       [ "Getting " ++ kv ++ " keys with this remote is not secure;"
+       , "the content cannot be verified to be correct."
+       , "(Use annex.security.allow-unverified-downloads to bypass"
+       , "this safety check.)"
+       ]
+  where
+       kv = decodeBS (formatKeyVariety (fromKey keyVariety k))
+
+isVerifiable :: Key -> Annex Bool
+isVerifiable k = maybe False (isJust . Types.Backend.verifyKeyContent) 
+       <$> Backend.maybeLookupBackendVariety (fromKey keyVariety k)
+
+startVerifyKeyContentIncrementally :: VerifyConfig -> Key -> Annex (Maybe IncrementalVerifier)
+startVerifyKeyContentIncrementally verifyconfig k = 
+       ifM (shouldVerify verifyconfig)
+               ( Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
+                       Just b -> case Types.Backend.verifyKeyContentIncrementally b of
+                               Just v -> Just <$> v k
+                               Nothing -> return Nothing
+                       Nothing -> return Nothing
+               , return Nothing
+               )

diff --git a/Backend.hs b/Backend.hs
index 76ba12313ac637950aa024fcf63e43fa2aad85e6..d327fde3d3515c76da09dd0b10585de16358d1e2 100644 (file)
--- a/Backend.hs
+++ b/Backend.hs
@@ -16,14 +16,11 @@ module Backend (
        maybeLookupBackendVariety,
        isStableKey,
        isCryptographicallySecure,
-       isVerifiable,
-       startVerifyKeyContentIncrementally,
 ) where
 
 import Annex.Common
 import qualified Annex
 import Annex.CheckAttr
-import Annex.Verify
 import Types.Key
 import Types.KeySource
 import qualified Types.Backend as B
@@ -125,18 +122,3 @@ isStableKey k = maybe False (`B.isStableKey` k)
 isCryptographicallySecure :: Key -> Annex Bool
 isCryptographicallySecure k = maybe False (`B.isCryptographicallySecure` k)
        <$> maybeLookupBackendVariety (fromKey keyVariety k)
-
-isVerifiable :: Key -> Annex Bool
-isVerifiable k = maybe False (isJust . B.verifyKeyContent) 
-       <$> maybeLookupBackendVariety (fromKey keyVariety k)
-
-startVerifyKeyContentIncrementally :: VerifyConfig -> Key -> Annex (Maybe B.IncrementalVerifier)
-startVerifyKeyContentIncrementally verifyconfig k = 
-       ifM (shouldVerify verifyconfig)
-               ( maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
-                       Just b -> case B.verifyKeyContentIncrementally b of
-                               Just v -> Just <$> v k
-                               Nothing -> return Nothing
-                       Nothing -> return Nothing
-               , return Nothing
-               )

diff --git a/P2P/Annex.hs b/P2P/Annex.hs
index b3b5d1f5b7e1371e09066ef0449220928d8e440b..5f0e1746662b6ff08c3dbccc27ee232de214747b 100644 (file)
--- a/P2P/Annex.hs
+++ b/P2P/Annex.hs
@@ -23,8 +23,7 @@ import P2P.IO
 import Logs.Location
 import Types.NumCopies
 import Utility.Metered
-import Types.Backend (IncrementalVerifier(..))
-import Backend
+import Annex.Verify
 
 import Control.Monad.Free
 import Control.Concurrent.STM

diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs
index dbe6ef1ffeb8b01688db8cca34f7bcacbecd4b98..77351b3077b7709ea05497c837d9f595e148f173 100644 (file)
--- a/Remote/Helper/ExportImport.hs
+++ b/Remote/Helper/ExportImport.hs
@@ -13,7 +13,7 @@ import Annex.Common
 import Types.Remote
 import Types.Key
 import Types.ProposedAccepted
-import Backend
+import Annex.Verify
 import Remote.Helper.Encryptable (encryptionIsEnabled)
 import qualified Database.Export as Export
 import qualified Database.ContentIdentifier as ContentIdentifier

diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs
index 4d048c8bc95add55431a6e9b2c6d0f2c85062d1f..9e00101c875e3d986b4b4aea0c78be4552e646d8 100644 (file)
--- a/Remote/Helper/P2P.hs
+++ b/Remote/Helper/P2P.hs
@@ -17,7 +17,7 @@ import Annex.Content
 import Messages.Progress
 import Utility.Metered
 import Types.NumCopies
-import Backend
+import Annex.Verify
 
 import Control.Concurrent