This commit is contained in:
Joey Hess 2025-02-27 16:17:42 -04:00
parent e6ae5e8d56
commit d2091730e9
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 36 additions and 31 deletions

View file

@ -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

View file

@ -1,6 +1,6 @@
{- Logs listing keys that are equivalent to a key.
-
- Copyright 2024 Joey Hess <id@joeyh.name>
- Copyright 2024-2025 Joey Hess <id@joeyh.name>
-
- 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
}

View file

@ -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"