implement isCryptographicallySecureKey for VURL

Considerable difficulty to work around an import cycle. Had to move the
list of backends (except for VURL) to Backend.Variety to VURL could use
it.

Sponsored-by: Kevin Mueller on Patreon

Backend/External.hs

@@ -72,7 +72,8 @@ makeBackend' ebname@(ExternalBackendName bname) hasext (Right p) = do
 		, canUpgradeKey = Nothing
 		, fastMigrate = Nothing
 		, isStableKey = const isstable
-		, isCryptographicallySecure = pure iscryptographicallysecure
+		, isCryptographicallySecure = iscryptographicallysecure
+		, isCryptographicallySecureKey = const (pure iscryptographicallysecure)
 		}
 makeBackend' ebname hasext (Left _) = return $ unavailBackend ebname hasext
 
@@ -86,7 +87,8 @@ unavailBackend (ExternalBackendName bname) hasext =
 		, canUpgradeKey = Nothing
 		, fastMigrate = Nothing
 		, isStableKey = const False
-		, isCryptographicallySecure = pure False
+		, isCryptographicallySecure = False
+		, isCryptographicallySecureKey = const (pure False)
 		}
 
 genKeyExternal :: ExternalBackendName -> HasExt -> KeySource -> MeterUpdate -> Annex Key

Backend/Hash.hs

@@ -81,7 +81,9 @@ genBackend hash = Backend
 	, canUpgradeKey = Just needsUpgrade
 	, fastMigrate = Just trivialMigrate
 	, isStableKey = const True
-	, isCryptographicallySecure = pure $ cryptographicallySecure hash
+	, isCryptographicallySecure = cryptographicallySecure hash
+	, isCryptographicallySecureKey = const $ pure $
+		cryptographicallySecure hash
 	}
 
 genBackendE :: Hash -> Backend

Backend/URL.hs

@@ -1,5 +1,4 @@
-{- git-annex "URL" and "VURL" backends -- keys whose content is
- - available from urls.
+{- git-annex URL backend -- keys whose content is available from urls.
  -
  - Copyright 2011-2024 Joey Hess <id@joeyh.name>
  -
@@ -15,10 +14,9 @@ import Annex.Common
 import Types.Key
 import Types.Backend
 import Backend.Utilities
-import Logs.EquivilantKeys
 
 backends :: [Backend]
-backends = [backendURL, backendVURL]
+backends = [backendURL]
 
 backendURL :: Backend
 backendURL = Backend
@@ -31,25 +29,8 @@ backendURL = Backend
 	-- The content of an url can change at any time, so URL keys are
 	-- not stable.
 	, isStableKey = const False
-	, isCryptographicallySecure = pure False
-	}
-
-backendVURL :: Backend
-backendVURL = Backend
-	{ backendVariety = VURLKey
-	, genKey = Nothing
-	, verifyKeyContent = Nothing -- TODO
-	, verifyKeyContentIncrementally = Nothing -- TODO
-	, canUpgradeKey = Nothing
-	, fastMigrate = Nothing
-	-- Even if a hash is recorded on initial download from the web and
-	-- is used to verify every subsequent transfer including other
-	-- downloads from the web, in a split-brain situation there
-	-- can be more than one hash and different versions of the content.
-	-- So the content is not stable.
-	, isStableKey = const False
-	, isCryptographicallySecure = pure False 
-	-- TODO it is when all recorded hashes are
+	, isCryptographicallySecure = False
+	, isCryptographicallySecureKey = const (pure False)
 	}
 
 {- Every unique url has a corresponding key. -}

Backend/Utilities.hs

@@ -1,6 +1,6 @@
 {- git-annex backend utilities
  -
- - Copyright 2012-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}

Backend/VURL.hs

@@ -0,0 +1,59 @@
+{- git-annex VURL backend -- like URL, but with hash-based verification
+ - of transfers between git-annex repositories.
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Backend.VURL (
+	backends,
+) where
+
+import Annex.Common
+import Types.Key
+import Types.Backend
+import Logs.EquivilantKeys
+import Backend.Variety
+
+backends :: [Backend]
+backends = [backendVURL]
+
+backendVURL :: Backend
+backendVURL = Backend
+	{ backendVariety = VURLKey
+	, genKey = Nothing
+	, verifyKeyContent = Nothing -- TODO
+	, verifyKeyContentIncrementally = Nothing -- TODO
+	, canUpgradeKey = Nothing
+	, fastMigrate = Nothing
+	-- Even if a hash is recorded on initial download from the web and
+	-- is used to verify every subsequent transfer including other
+	-- downloads from the web, in a split-brain situation there
+	-- can be more than one hash and different versions of the content.
+	-- So the content is not stable.
+	, isStableKey = const False
+	-- Not all keys using this backend are necessarily 
+	-- cryptographically secure.
+	, isCryptographicallySecure = False
+	-- A key is secure when all recorded equivilant keys are.
+	-- If there are none recorded yet, it's secure because when
+	-- downloaded, an equivilant key that is cryptographically secure
+	-- will be constructed then.
+	, isCryptographicallySecureKey = \k ->
+		equivkeys k >>= \case
+			[] -> return True
+			l -> do
+				let check ek = getbackend ek >>= \case
+					Nothing -> pure False
+					Just b -> isCryptographicallySecureKey b ek
+				allM check l
+	}
+  where
+	equivkeys k = filter allowedequiv <$> getEquivilantKeys k
+	-- Don't allow using VURL keys as equivilant keys, because that
+	-- could let a crafted git-annex branch cause an infinite loop.
+	allowedequiv ek = fromKey keyVariety ek /= VURLKey
+	varietymap = makeVarietyMap regularBackendList
+	getbackend ek = maybeLookupBackendVarietyMap (fromKey keyVariety ek) varietymap
+

Backend/Variety.hs

@@ -0,0 +1,35 @@
+{- git-annex backend varieties
+ -
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Backend.Variety where
+
+import qualified Data.Map as M
+
+import Annex.Common
+import Types.Key
+import Types.Backend
+import qualified Backend.External
+
+-- When adding a new backend, import it here and add it to the builtinList.
+import qualified Backend.Hash
+import qualified Backend.WORM
+import qualified Backend.URL
+
+{- Regular backends. Does not include externals or VURL. -}
+regularBackendList :: [Backend]
+regularBackendList = Backend.Hash.backends 
+	++ Backend.WORM.backends 
+	++ Backend.URL.backends
+
+makeVarietyMap :: [Backend] -> M.Map KeyVariety Backend
+makeVarietyMap l = M.fromList $ zip (map backendVariety l) l
+
+maybeLookupBackendVarietyMap :: KeyVariety -> M.Map KeyVariety Backend -> Annex (Maybe Backend)
+maybeLookupBackendVarietyMap (ExternalKey s hasext) _varitymap =
+	Just <$> Backend.External.makeBackend s hasext
+maybeLookupBackendVarietyMap v varietymap = 
+	pure $ M.lookup v varietymap

Backend/WORM.hs

@@ -32,7 +32,8 @@ backend = Backend
 	, canUpgradeKey = Just needsUpgrade
 	, fastMigrate = Just removeProblemChars
 	, isStableKey = const True
-	, isCryptographicallySecure = pure False
+	, isCryptographicallySecure = False
+	, isCryptographicallySecureKey = const (pure False)
 	}
 
 {- The key includes the file size, modification time, and the