From d2091730e931f5b77e57b33ce58ff7d6cf65fa7c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 27 Feb 2025 16:17:42 -0400 Subject: [PATCH] refactor --- Backend/VURL/Utilities.hs | 25 ------------------------- Logs/EquivilantKeys.hs | 36 +++++++++++++++++++++++++++++++++++- Remote/Web.hs | 6 +----- 3 files changed, 36 insertions(+), 31 deletions(-) diff --git a/Backend/VURL/Utilities.hs b/Backend/VURL/Utilities.hs index 0fdb038ccb..46b06c41b8 100644 --- a/Backend/VURL/Utilities.hs +++ b/Backend/VURL/Utilities.hs @@ -10,10 +10,8 @@ module Backend.VURL.Utilities where import Annex.Common import Types.Key import Types.Backend -import Types.KeySource import Logs.EquivilantKeys import qualified Backend.Hash -import Utility.Metered migrateFromURLToVURL :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key) migrateFromURLToVURL oldkey newbackend _af inannex @@ -41,26 +39,3 @@ migrateFromVURLToURL oldkey newbackend _af _ (keyData oldkey) { keyVariety = URLKey } | otherwise = return Nothing - --- The Backend must use a cryptographically secure hash. -generateEquivilantKey :: Backend -> OsPath -> Annex (Maybe Key) -generateEquivilantKey b f = - case genKey b of - Just genkey -> do - showSideAction (UnquotedString Backend.Hash.descChecksum) - Just <$> genkey source nullMeterUpdate - Nothing -> return Nothing - where - source = KeySource - { keyFilename = mempty -- avoid adding any extension - , 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/Logs/EquivilantKeys.hs b/Logs/EquivilantKeys.hs index 0a0117301e..32accda777 100644 --- a/Logs/EquivilantKeys.hs +++ b/Logs/EquivilantKeys.hs @@ -1,6 +1,6 @@ {- Logs listing keys that are equivalent to a key. - - - Copyright 2024 Joey Hess + - Copyright 2024-2025 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -10,6 +10,8 @@ module Logs.EquivilantKeys ( getEquivilantKeys, setEquivilantKey, + updateEquivilantKeys, + generateEquivilantKey, ) where import Annex.Common @@ -17,6 +19,11 @@ import qualified Annex import Logs import Logs.Presence import qualified Annex.Branch +import qualified Backend.Hash +import Types.KeySource +import Types.Backend +import Types.Remote (Verification(..)) +import Utility.Metered getEquivilantKeys :: Key -> Annex [Key] getEquivilantKeys key = do @@ -29,3 +36,30 @@ setEquivilantKey key equivkey = do config <- Annex.getGitConfig addLog (Annex.Branch.RegardingUUID []) (equivilantKeysLogFile config key) InfoPresent (LogInfo (serializeKey' equivkey)) + +-- The Backend must use a cryptographically secure hash. +-- +-- This returns Verified when when an equivilant key has been added to the +-- log (or was already in the log). This is to avoid hashing the object +-- again later. +updateEquivilantKeys :: Backend -> OsPath -> Key -> [Key] -> Annex (Maybe Verification) +updateEquivilantKeys b obj key eks = generateEquivilantKey b obj >>= \case + Nothing -> return Nothing + Just ek -> do + unless (ek `elem` eks) $ + setEquivilantKey key ek + return (Just Verified) + +generateEquivilantKey :: Backend -> OsPath -> Annex (Maybe Key) +generateEquivilantKey b obj = + case genKey b of + Just genkey -> do + showSideAction (UnquotedString Backend.Hash.descChecksum) + Just <$> genkey source nullMeterUpdate + Nothing -> return Nothing + where + source = KeySource + { keyFilename = mempty -- avoid adding any extension + , contentLocation = obj + , inodeCache = Nothing + } diff --git a/Remote/Web.hs b/Remote/Web.hs index 0fdad0e92c..a097782efe 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -30,7 +30,6 @@ import Annex.SpecialRemote.Config import Logs.Remote import Logs.EquivilantKeys import Backend -import Backend.VURL.Utilities (recordVurlKey) import qualified Data.Map as M @@ -170,10 +169,7 @@ downloadKey urlincludeexclude key _af dest p vc = recordvurlkey eks = do b <- hashBackend - ifM (recordVurlKey b dest key eks) - ( return (Just Verified) - , return Nothing - ) + updateEquivilantKeys b dest key eks uploadKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () uploadKey _ _ _ _ = giveup "upload to web not supported"