lift isCryptographicallySecure to Annex

Needed for VURL backend.

Sponsored-by: Nicholas Golder-Manning on Patreon

Annex/Transfer.hs

@@ -276,7 +276,7 @@ runTransferrer sd r k afile retrydecider direction _witness =
 preCheckSecureHashes :: Observable v => Key -> Maybe Backend -> Annex v -> Annex v
 preCheckSecureHashes k meventualbackend a = case meventualbackend of
 	Just eventualbackend -> go
-		(pure (Types.Backend.isCryptographicallySecure eventualbackend))
+		(Types.Backend.isCryptographicallySecure eventualbackend)
 		(Types.Backend.backendVariety eventualbackend)
 	Nothing -> go
 		(isCryptographicallySecure k)

Backend.hs

@@ -124,8 +124,8 @@ isStableKey k = maybe False (`B.isStableKey` k)
 	<$> maybeLookupBackendVariety (fromKey keyVariety k)
 
 isCryptographicallySecure :: Key -> Annex Bool
-isCryptographicallySecure k = maybe False isCryptographicallySecure'
+isCryptographicallySecure k = maybe (pure False) isCryptographicallySecure'
-	<$> maybeLookupBackendVariety (fromKey keyVariety k)
+	=<< maybeLookupBackendVariety (fromKey keyVariety k)
 
-isCryptographicallySecure' :: Backend -> Bool
+isCryptographicallySecure' :: Backend -> Annex Bool
 isCryptographicallySecure' = B.isCryptographicallySecure

Backend/External.hs

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

Backend/Hash.hs

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

Backend/URL.hs

@@ -31,7 +31,7 @@ backendURL = Backend
 	-- The content of an url can change at any time, so URL keys are
 	-- not stable.
 	, isStableKey = const False
-	, isCryptographicallySecure = False
+	, isCryptographicallySecure = pure False
 	}
 
 backendVURL :: Backend
@@ -48,7 +48,7 @@ backendVURL = Backend
 	-- can be more than one hash and different versions of the content.
 	-- So the content is not stable.
 	, isStableKey = const False
-	, isCryptographicallySecure = False 
+	, isCryptographicallySecure = pure False 
 	-- TODO it is when all recorded hashes are
 	}
 

Backend/WORM.hs

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

Remote/Web.hs

@@ -171,9 +171,10 @@ downloadKey urlincludeexclude key _af dest p vc =
 		-- Make sure to pick a backend that is cryptographically
 		-- secure.
 		db <- defaultBackend
-		let b = if isCryptographicallySecure' db
+		b <- ifM (isCryptographicallySecure' db)
-			then db
+			( pure db
-			else defaultHashBackend
+			, pure defaultHashBackend
+			)
 		showSideAction (UnquotedString descChecksum)
 		(hashk, _) <- genKey ks nullMeterUpdate b
 		unless (hashk `elem` eks) $

Types/Backend.hs

@@ -34,7 +34,7 @@ data BackendA a = Backend
 	-- same data.
 	, isStableKey :: Key -> Bool
 	-- Checks if a key is verified using a cryptographically secure hash.
-	, isCryptographicallySecure :: Bool
+	, isCryptographicallySecure :: a Bool
 	}
 
 instance Show (BackendA a) where