From 1704b5e327dcea691685e7c1e84f90575a3ddd52 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 27 Feb 2025 14:54:03 -0400
Subject: [PATCH] refactoring

---
 Backend.hs                | 12 +++++++++++-
 Backend/VURL/Utilities.hs |  8 ++++++++
 Remote/Web.hs             | 19 ++++++-------------
 3 files changed, 25 insertions(+), 14 deletions(-)

diff --git a/Backend.hs b/Backend.hs
index 4a7ace6524..de4c7bbee8 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -10,13 +10,14 @@
 module Backend (
 	builtinList,
 	defaultBackend,
-	defaultHashBackend,
+	hashBackend,
 	genKey,
 	getBackend,
 	chooseBackend,
 	lookupBackendVariety,
 	lookupBuiltinBackendVariety,
 	maybeLookupBackendVariety,
+	unknownBackendVarietyMessage,
 	isStableKey,
 	isCryptographicallySecureKey,
 	isCryptographicallySecure,
@@ -54,6 +55,15 @@ defaultBackend = maybe cache return =<< Annex.getState Annex.backend
 	valid name = not (null name)
 	lookupname = lookupBackendVariety . parseKeyVariety . encodeBS
 
+{- A hashing backend. Takes git config into account, but
+ - guarantees the backend is cryptographically secure. -}
+hashBackend :: Annex Backend
+hashBackend = do
+	db <- defaultBackend
+	return $ if isCryptographicallySecure db
+		then db
+		else defaultHashBackend
+
 {- Generates a key for a file. -}
 genKey :: KeySource -> MeterUpdate -> Backend -> Annex (Key, Backend)
 genKey source meterupdate b = case B.genKey b of
diff --git a/Backend/VURL/Utilities.hs b/Backend/VURL/Utilities.hs
index 82e5939e7c..0fdb038ccb 100644
--- a/Backend/VURL/Utilities.hs
+++ b/Backend/VURL/Utilities.hs
@@ -56,3 +56,11 @@ generateEquivilantKey b f =
 		, contentLocation = f
 		, inodeCache = Nothing
 		}
+
+recordVurlKey :: Backend -> OsPath -> Key -> [Key] -> Annex Bool
+recordVurlKey b f key eks = generateEquivilantKey b f >>= \case
+	Nothing -> return False
+	Just ek -> do
+		unless (ek `elem` eks) $
+			setEquivilantKey key ek
+		return True
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 4728a64c6a..0fdad0e92c 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -30,7 +30,7 @@ import Annex.SpecialRemote.Config
 import Logs.Remote
 import Logs.EquivilantKeys
 import Backend
-import Backend.VURL.Utilities (generateEquivilantKey)
+import Backend.VURL.Utilities (recordVurlKey)
 
 import qualified Data.Map as M
 
@@ -169,18 +169,11 @@ downloadKey urlincludeexclude key _af dest p vc =
 		| otherwise = return (Just v)
 	
 	recordvurlkey eks = do
-		-- Make sure to pick a backend that is cryptographically
-		-- secure.
-		db <- defaultBackend
-		let b = if isCryptographicallySecure db
-			then db
-			else defaultHashBackend
-		generateEquivilantKey b dest >>= \case
-			Nothing -> return Nothing
-			Just ek -> do
-				unless (ek `elem` eks) $
-					setEquivilantKey key ek
-				return (Just Verified)
+		b <- hashBackend
+		ifM (recordVurlKey b dest key eks)
+			( return (Just Verified)
+			, return Nothing
+			)
 
 uploadKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
 uploadKey _ _ _ _ = giveup "upload to web not supported"