--- /dev/null
+{- Balancing between UUIDs
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Annex.Balanced where
+
+import Key
+import Types.UUID
+import Utility.Hash
+
+import Data.List
+import Data.Maybe
+import Data.Bits (shiftL)
+import qualified Data.Set as S
+import qualified Data.ByteArray as BA
+
+type BalancedPicker = S.Set UUID -> Key -> UUID
+
+-- The set of UUIDs provided here are all the UUIDs that are ever
+-- expected to be picked amoung. A subset of that can be provided
+-- when later using the BalancedPicker.
+balancedPicker :: S.Set UUID -> BalancedPicker
+balancedPicker s = \s' key ->
+ let n = calcMac tointeger HmacSha256 combineduuids (serializeKey' key)
+ in S.elemAt (fromIntegral (n `mod` m)) s'
+ where
+ combineduuids = mconcat (map fromUUID (S.toAscList s))
+ m = fromIntegral (S.size s)
+
+ tointeger :: Digest a -> Integer
+ tointeger = foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0
+ . BA.unpack
+
+{- The selection for a given key never changes. -}
+prop_balanced_stable :: Bool
+prop_balanced_stable = balancedPicker us us k == toUUID "332"
+ where
+ us = S.fromList $ map (toUUID . show) [1..500 :: Int]
+ k = fromJust $ deserializeKey "WORM--test"
macWithCipher :: Mac -> Cipher -> S.ByteString -> String
macWithCipher mac c = macWithCipher' mac (cipherMac c)
macWithCipher' :: Mac -> S.ByteString -> S.ByteString -> String
-macWithCipher' mac c s = calcMac mac c s
+macWithCipher' mac c s = calcMac show mac c s
{- Ensure that macWithCipher' returns the same thing forevermore. -}
prop_HmacSha1WithCipher_sane :: Bool
import Utility.Glob
import Utility.HumanTime
import Utility.DataUnits
-import Utility.Hash
import qualified Database.Keys
import qualified Utility.RawFilePath as R
import Backend
import qualified Data.Map as M
import qualified System.FilePath.ByteString as P
import System.PosixCompat.Files (accessTime, isSymbolicLink)
-import qualified Data.ByteArray as BA
-import Data.Bits (shiftL)
{- Some limits can look at the current status of files on
- disk, or in the annex. This allows controlling which happens. -}
limitFullyBalanced :: Maybe UUID -> Annex GroupMap -> MkLimit Annex
limitFullyBalanced mu getgroupmap groupname = Right $ MatchFiles
{ matchAction = const $ checkKey $ \key -> do
- groupmembers <- fromMaybe S.empty
- . M.lookup (toGroup groupname)
- . uuidsByGroup
- <$> getgroupmap
+ gm <- getgroupmap
+ let groupmembers = fromMaybe S.empty $
+ M.lookup g (uuidsByGroup gm)
-- TODO free space checking
- return $ case mu of
- Just u -> u == pickBalanced key groupmembers
- Nothing -> False
+ return $ case (mu, M.lookup g (balancedPickerByGroup gm)) of
+ (Just u, Just picker) -> u == picker groupmembers key
+ _ -> False
, matchNeedsFileName = False
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchDesc = "fullybalanced" =? groupname
}
where
-
-pickBalanced :: Key -> S.Set UUID -> UUID
-pickBalanced key s =
- let m = fromIntegral (S.size s)
- n = keyToInteger key
- in S.elemAt (fromIntegral (n `mod` m)) s
-
-{- Converts a Key into a stable Integer.
- -
- - The SHA2 hash of the key is used to constrain the size of the Integer
- - and to get an even distribution.
- -}
-keyToInteger :: Key -> Integer
-keyToInteger key =
- foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 $
- BA.unpack (sha2_256s (serializeKey' key))
+ g = toGroup groupname
{- Adds a limit to skip files not using a specified key-value backend. -}
addInBackend :: String -> Annex ()
{- git-annex group log
-
- - Copyright 2012, 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
import Logs.UUIDBased
import Types.Group
import Types.StandardGroups
+import Annex.Balanced
{- Returns the groups of a given repo UUID. -}
lookupGroups :: UUID -> Annex (S.Set Group)
return m
makeGroupMap :: M.Map UUID (S.Set Group) -> GroupMap
-makeGroupMap byuuid = GroupMap byuuid bygroup
+makeGroupMap byuuid = GroupMap byuuid bygroup (M.map balancedPicker bygroup)
where
bygroup = M.fromListWith S.union $
concatMap explode $ M.toList byuuid
import qualified Annex.VariantFile
import qualified Annex.View
import qualified Annex.View.ViewedFile
+import qualified Annex.Balanced
import qualified Logs.View
import qualified Command.TestRemote
import qualified Utility.Path.Tests
, testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips
, testProperty "prop_viewedFile_rountrips" Annex.View.ViewedFile.prop_viewedFile_roundtrips
, testProperty "prop_standardGroups_parse" Logs.PreferredContent.prop_standardGroups_parse
+ , testProperty "prop_balanced_stable" Annex.Balanced.prop_balanced_stable
] ++ map (uncurry testProperty) combos
where
combos = concat
{- git-annex repo groups
-
- - Copyright 2012, 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
import Types.UUID
import Utility.FileSystemEncoding
+import Annex.Balanced
import qualified Data.Map as M
import qualified Data.Set as S
data GroupMap = GroupMap
{ groupsByUUID :: M.Map UUID (S.Set Group)
, uuidsByGroup :: M.Map Group (S.Set UUID)
+ , balancedPickerByGroup :: M.Map Group BalancedPicker
}
emptyGroupMap :: GroupMap
-emptyGroupMap = GroupMap M.empty M.empty
+emptyGroupMap = GroupMap M.empty M.empty M.empty
-}
{-# LANGUAGE BangPatterns, PackageImports #-}
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
module Utility.Hash (
sha2_224_context,
sha2_256,
sha2_256_context,
- sha2_256s,
sha2_384,
sha2_384_context,
sha2_512,
sha2_256_context :: Context SHA256
sha2_256_context = hashInit
-sha2_256s :: S.ByteString -> Digest SHA256
-sha2_256s = hash
-
sha2_384 :: L.ByteString -> Digest SHA384
sha2_384 = hashlazy
deriving (Eq)
calcMac
- :: Mac -- ^ MAC
+ :: (forall a. Digest a -> t) -- ^ applied to MAC'ed message
+ -> Mac -- ^ MAC
-> S.ByteString -- ^ secret key
-> S.ByteString -- ^ message
- -> String -- ^ MAC'ed message, in hexadecimal
-calcMac mac = case mac of
+ -> t
+calcMac f mac = case mac of
HmacSha1 -> use SHA1
HmacSha224 -> use SHA224
HmacSha256 -> use SHA256
HmacSha384 -> use SHA384
HmacSha512 -> use SHA512
where
- use alg k m = show (hmacGetDigest (hmacWitnessAlg alg k m))
+ use alg k m = f (hmacGetDigest (hmacWitnessAlg alg k m))
hmacWitnessAlg :: HashAlgorithm a => a -> S.ByteString -> S.ByteString -> HMAC a
hmacWitnessAlg _ = hmac
-- Check that all the MACs continue to produce the same.
props_macs_stable :: [(String, Bool)]
-props_macs_stable = map (\(desc, mac, result) -> (desc ++ " stable", calcMac mac key msg == result))
+props_macs_stable = map (\(desc, mac, result) -> (desc ++ " stable", calcMac show mac key msg == result))
[ ("HmacSha1", HmacSha1, "46b4ec586117154dacd49d664e5d63fdc88efb51")
, ("HmacSha224", HmacSha224, "4c1f774863acb63b7f6e9daa9b5c543fa0d5eccf61e3ffc3698eacdd")
, ("HmacSha256", HmacSha256, "f9320baf0249169e73850cd6156ded0106e2bb6ad8cab01b7bbbebe6d1065317")
verify v secret = v == mkVerifiable (verifiableVal v) secret
calcDigest :: String -> Secret -> HMACDigest
-calcDigest v secret = calcMac HmacSha1 secret (fromString v)
+calcDigest v secret = calcMac show HmacSha1 secret (fromString v)
prop_verifiable_sane :: TestableString -> TestableString -> Bool
prop_verifiable_sane v ts =
not occur. Users wanting 2 copies can have 2 groups which are each
balanced, although that would mean more repositories on more drives.
-* picking a low UUID and picking keys that mod N == 0 would let an attacker
- generate keys that balancing always puts on that UUID. To avoid this
- use HMAC with the set of UUIDs and the key. Then any such attack can be
- prevented by adding another UUID to the set, it could even be a dummy
- UUID that is marked as having 0 size, so it will never be used.
-
* document balancing algo well enough that someone else could implement it
from the design doc
Annex.AdjustedBranch.Merge
Annex.AdjustedBranch.Name
Annex.AutoMerge
+ Annex.Balanced
Annex.BloomFilter
Annex.Branch
Annex.Branch.Transitions
projects / git-annex.git / commitdiff