move cryptographicallySecure into Backend type

This is groundwork for external backends, but also makes sense to keep
this information with the rest of a Backend's implementation.

Also, removed isVerifiable. I noticed that the same information is
encoded by whether a Backend implements verifyKeyContent or not.

Annex/Content.hs

@@ -336,7 +336,7 @@ getViaTmpFromDisk rsp v key action = checkallowed $ do
 	checkallowed a = case rsp of
 		RetrievalAllKeysSecure -> a
 		RetrievalVerifiableKeysSecure
-			| isVerifiable (fromKey keyVariety key) -> a
+			| Backend.isVerifiable key -> a
 			| otherwise -> ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)
 				( a
 				, warnUnverifiableInsecure key >> return False
@@ -360,7 +360,7 @@ verifyKeyContent :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> K
 verifyKeyContent rsp v verification k f = case (rsp, verification) of
 	(_, Verified) -> return True
 	(RetrievalVerifiableKeysSecure, _)
-		| isVerifiable (fromKey keyVariety k) -> verify
+		| Backend.isVerifiable k -> verify
 		| otherwise -> ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)
 			( verify
 			, warnUnverifiableInsecure k >> return False
@@ -499,7 +499,7 @@ moveAnnex key src = ifM (checkSecureHashes' key)
 
 checkSecureHashes :: Key -> Annex (Maybe String)
 checkSecureHashes key
-	| cryptographicallySecure (fromKey keyVariety key) = return Nothing
+	| Backend.isCryptographicallySecure key = return Nothing
 	| otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig)
 		( return $ Just $ "annex.securehashesonly blocked adding " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"
 		, return Nothing

Annex/Transfer.hs

@@ -33,6 +33,7 @@ import qualified Types.Remote as Remote
 import Types.Concurrency
 import Types.WorkerPool
 import Annex.WorkerPool
+import Backend (isCryptographicallySecure)
 
 import Control.Concurrent
 import qualified Data.Map.Strict as M
@@ -177,7 +178,7 @@ runTransfer' ignorelock t afile retrydecider transferaction = enteringStage Tran
  -}
 checkSecureHashes :: Observable v => Transfer -> Annex v -> Annex v
 checkSecureHashes t a
-	| cryptographicallySecure variety = a
+	| isCryptographicallySecure (transferKey t) = a
 	| otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig)
 		( do
 			warning $ "annex.securehashesonly blocked transfer of " ++ decodeBS (formatKeyVariety variety) ++ " key"

Backend.hs

@@ -1,6 +1,6 @@
 {- git-annex key/value backends
  -
- - Copyright 2010-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -14,6 +14,8 @@ module Backend (
 	lookupBackendVariety,
 	maybeLookupBackendVariety,
 	isStableKey,
+	isCryptographicallySecure,
+	isVerifiable,
 ) where
 
 import Annex.Common
@@ -101,3 +103,11 @@ varietyMap = M.fromList $ zip (map B.backendVariety list) list
 isStableKey :: Key -> Bool
 isStableKey k = maybe False (`B.isStableKey` k) 
 	(maybeLookupBackendVariety (fromKey keyVariety k))
+
+isCryptographicallySecure :: Key -> Bool
+isCryptographicallySecure k = maybe False (`B.isCryptographicallySecure` k)
+	(maybeLookupBackendVariety (fromKey keyVariety k))
+
+isVerifiable :: Key -> Bool
+isVerifiable k = maybe False (isJust . B.verifyKeyContent)
+	(maybeLookupBackendVariety (fromKey keyVariety k))

Backend/Hash.hs

@@ -41,6 +41,17 @@ data Hash
 	| Blake2sHash HashSize
 	| Blake2spHash HashSize
 
+cryptographicallySecure :: Hash -> Bool
+cryptographicallySecure (SHA2Hash _) = True
+cryptographicallySecure (SHA3Hash _) = True
+cryptographicallySecure (SkeinHash _) = True
+cryptographicallySecure (Blake2bHash _) = True
+cryptographicallySecure (Blake2bpHash _) = True
+cryptographicallySecure (Blake2sHash _) = True
+cryptographicallySecure (Blake2spHash _) = True
+cryptographicallySecure SHA1Hash = False
+cryptographicallySecure MD5Hash = False
+
 {- Order is slightly significant; want SHA256 first, and more general
  - sizes earlier. -}
 hashes :: [Hash]
@@ -68,6 +79,7 @@ genBackend hash = Backend
 	, canUpgradeKey = Just needsUpgrade
 	, fastMigrate = Just trivialMigrate
 	, isStableKey = const True
+	, isCryptographicallySecure = const (cryptographicallySecure hash)
 	}
 
 genBackendE :: Hash -> Backend

Backend/URL.hs

@@ -28,6 +28,7 @@ backend = Backend
 	-- The content of an url can change at any time, so URL keys are
 	-- not stable.
 	, isStableKey = const False
+	, isCryptographicallySecure = const False
 	}
 
 {- Every unique url has a corresponding key. -}

Backend/WORM.hs

@@ -29,6 +29,7 @@ backend = Backend
 	, canUpgradeKey = Just needsUpgrade
 	, fastMigrate = Just removeProblemChars
 	, isStableKey = const True
+	, isCryptographicallySecure = const False
 	}
 
 {- The key includes the file size, modification time, and the

Command/Fsck.hs

@@ -261,7 +261,7 @@ verifyLocationLog key keystatus ai = do
 	 - insecure hash is present. This should only be able to happen
 	 - if the repository already contained the content before the
 	 - config was set. -}
-	when (present && not (cryptographicallySecure (fromKey keyVariety key))) $
+	when (present && not (Backend.isCryptographicallySecure key)) $
 		whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $
 			warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"
 

Limit.hs

@@ -34,6 +34,7 @@ import Utility.Glob
 import Utility.HumanTime
 import Utility.DataUnits
 import qualified Utility.RawFilePath as R
+import Backend
 
 import Data.Time.Clock.POSIX
 import qualified Data.Set as S
@@ -305,7 +306,7 @@ addSecureHash :: Annex ()
 addSecureHash = addLimit $ Right limitSecureHash
 
 limitSecureHash :: MatchFiles Annex
-limitSecureHash _ = checkKey $ pure . cryptographicallySecure . fromKey keyVariety
+limitSecureHash _ = checkKey $ pure . isCryptographicallySecure
 
 {- Adds a limit to skip files that are too large or too small -}
 addLargerThan :: String -> Annex ()

Types/Backend.hs

@@ -2,7 +2,7 @@
  -
  - Most things should not need this, using Types instead
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -18,7 +18,8 @@ import Utility.FileSystemEncoding
 data BackendA a = Backend
 	{ backendVariety :: KeyVariety
 	, getKey :: Maybe (KeySource -> MeterUpdate -> a Key)
-	-- Verifies the content of a key.
+	-- Verifies the content of a key using a hash. This does not need
+	-- to be cryptographically secure.
 	, verifyKeyContent :: Maybe (Key -> FilePath -> a Bool)
 	-- Checks if a key can be upgraded to a better form.
 	, canUpgradeKey :: Maybe (Key -> Bool)
@@ -28,6 +29,8 @@ data BackendA a = Backend
 	-- Checks if a key is known (or assumed) to always refer to the
 	-- same data.
 	, isStableKey :: Key -> Bool
+	-- Checks if a key is verified using a cryptographically secure hash.
+	, isCryptographicallySecure :: Key -> Bool
 	}
 
 instance Show (BackendA a) where

Types/Key.hs

@@ -23,8 +23,6 @@ module Types.Key (
 	HashSize(..),
 	hasExt,
 	sameExceptExt,
-	cryptographicallySecure,
-	isVerifiable,
 	formatKeyVariety,
 	parseKeyVariety,
 ) where
@@ -262,36 +260,6 @@ sameExceptExt (SHA1Key _) (SHA1Key _) = True
 sameExceptExt (MD5Key _) (MD5Key _) = True
 sameExceptExt _ _ = False
 
-{- Is the Key variety cryptographically secure, such that no two differing
- - file contents can be mapped to the same Key? -}
-cryptographicallySecure :: KeyVariety -> Bool
-cryptographicallySecure (SHA2Key _ _) = True
-cryptographicallySecure (SHA3Key _ _) = True
-cryptographicallySecure (SKEINKey _ _) = True
-cryptographicallySecure (Blake2bKey _ _) = True
-cryptographicallySecure (Blake2bpKey _ _) = True
-cryptographicallySecure (Blake2sKey _ _) = True
-cryptographicallySecure (Blake2spKey _ _) = True
-cryptographicallySecure _ = False
-
-{- Is the Key variety backed by a hash, which allows verifying content?
- - It does not have to be cryptographically secure against eg birthday
- - attacks.
- -}
-isVerifiable :: KeyVariety -> Bool
-isVerifiable (SHA2Key _ _) = True
-isVerifiable (SHA3Key _ _) = True
-isVerifiable (SKEINKey _ _) = True
-isVerifiable (Blake2bKey _ _) = True
-isVerifiable (Blake2bpKey _ _) = True
-isVerifiable (Blake2sKey _ _) = True
-isVerifiable (Blake2spKey _ _) = True
-isVerifiable (SHA1Key _) = True
-isVerifiable (MD5Key _) = True
-isVerifiable WORMKey = False
-isVerifiable URLKey = False
-isVerifiable (OtherKey  _) =  False
-
 formatKeyVariety :: KeyVariety -> S.ByteString
 formatKeyVariety v = case v of
 	SHA2Key sz e -> adde e (addsz sz "SHA")