Repository tuning parameters can now be passed when initializing a repository for the first time.

* init: Repository tuning parameters can now be passed when initializing a
  repository for the first time. For details, see
  http://git-annex.branchable.com/tuning/
* merge: Refuse to merge changes from a git-annex branch of a repo
  that has been tuned in incompatable ways.

2 files changed, 138 insertions, 0 deletions

diff --git a/Types/Difference.hs b/Types/Difference.hs
new file mode 100644
index 000000000..cbfad0fce
--- /dev/null
+++ b/Types/Difference.hs
@@ -0,0 +1,135 @@
+{- git-annex repository differences
+ -
+ - Copyright 2015 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.Difference (
+	Difference(..),
+	Differences(..),
+	getDifferences,
+	sanityCheckDifferences,
+	differenceConfigKey,
+	differenceConfigVal,
+	hasDifference,
+) where
+
+import Utility.PartialPrelude
+import qualified Git
+import qualified Git.Config
+
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Control.Applicative
+
+-- Describes differences from the v5 repository format.
+--
+-- The serilization is stored in difference.log, so avoid changes that
+-- would break compatability.
+--
+-- Not breaking comparability is why a list of Differences is used, rather
+-- than a sum type. With a sum type, adding a new field for some future
+-- difference would serialize to a value that an older version could not
+-- parse, even if that new field was not used. With the Differences list,
+-- old versions can still parse it, unless the new Difference constructor 
+-- is used.
+data Difference
+	= Version Int
+	| ObjectHashLower Bool
+	| ObjectHashDirectories Int
+	| BranchHashDirectories Int
+	deriving (Show, Read, Ord)
+
+instance Eq Difference where
+	Version a == Version b = a == b
+	ObjectHashLower a == ObjectHashLower b = a == b
+	ObjectHashDirectories a == ObjectHashDirectories b = a == b
+	BranchHashDirectories a == BranchHashDirectories b = a == b
+	_ == _ = False
+
+data Differences
+	= Differences [Difference]
+	| UnknownDifferences
+	deriving (Show, Read, Ord)
+
+instance Eq Differences where
+	Differences a == Differences b = simplify (defver:a) == simplify (defver:b)
+	_ == _ = False
+
+instance Monoid Differences where
+	mempty = Differences []
+	mappend (Differences l1) (Differences l2) = Differences (simplify (l1 ++ l2))
+	mappend _ _ = UnknownDifferences
+
+-- This is the default repository version that is assumed when no other one
+-- is given. Note that [] == [Version 5]
+defver :: Difference
+defver = Version 5
+
+-- Larger values of the same Difference constructor dominate
+-- over smaller values, so given [Version 6, Version 5], returns [Version 6]
+simplify :: [Difference] -> [Difference]
+simplify = go . sort
+  where
+	go [] = []
+	go (d:[]) = [d]
+	go (d1:d2:ds)
+		| like d1 d2 = go (d2:ds)
+		| otherwise = d1 : go (d2:ds)
+
+	like (Version _) (Version _) = True
+	like (ObjectHashLower _) (ObjectHashLower _) = True
+	like (ObjectHashDirectories _) (ObjectHashDirectories _) = True
+	like (BranchHashDirectories _) (BranchHashDirectories _) = True
+	like _ _ = False
+
+getDifferences :: Git.Repo -> Differences
+getDifferences r = checksane $ Differences $ catMaybes
+	[ ObjectHashLower 
+		<$> getmaybebool (differenceConfigKey (ObjectHashLower undefined))
+	, ObjectHashDirectories 
+		<$> getmayberead (differenceConfigKey (ObjectHashDirectories undefined))
+	, BranchHashDirectories
+		<$> getmayberead (differenceConfigKey (BranchHashDirectories undefined))
+	]
+  where
+	getmaybe k = Git.Config.getMaybe k r
+	getmayberead k = readish =<< getmaybe k
+	getmaybebool k = Git.Config.isTrue =<< getmaybe k
+	checksane = either error id . sanityCheckDifferences
+
+differenceConfigKey :: Difference -> String
+differenceConfigKey (Version _) = "annex.version"
+differenceConfigKey (ObjectHashLower _) = tunable "objecthashlower"
+differenceConfigKey (ObjectHashDirectories _) = tunable "objecthashdirectories"
+differenceConfigKey (BranchHashDirectories _) = tunable "branchhashdirectories"
+
+differenceConfigVal :: Difference -> String
+differenceConfigVal (Version v) = show v
+differenceConfigVal (ObjectHashLower b) = Git.Config.boolConfig b
+differenceConfigVal (ObjectHashDirectories n) = show n
+differenceConfigVal (BranchHashDirectories n) = show n
+
+tunable :: String -> String
+tunable k = "annex.tune." ++ k
+
+sanityCheckDifferences :: Differences -> Either String Differences
+sanityCheckDifferences d@(Differences l)
+	| null problems = Right d
+	| otherwise = Left (intercalate "; " problems)
+  where
+	problems = catMaybes (map check l)
+	check (ObjectHashDirectories n)
+		| n == 1 || n == 2 = Nothing
+		| otherwise = Just $ "Bad value for objecthashdirectories -- should be 1 or 2, not " ++ show n
+	check (BranchHashDirectories n)
+		| n == 1 || n == 2 = Nothing
+		| otherwise = Just $ "Bad value for branhhashdirectories -- should be 1 or 2, not " ++ show n
+	check _ = Nothing
+sanityCheckDifferences UnknownDifferences = Left "unknown differences detected; update git-annex"
+
+hasDifference :: (Difference -> Bool) -> Differences -> Bool
+hasDifference f (Differences l) = any f l
+hasDifference _ UnknownDifferences = False
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index ef8068cc4..5ac524f45 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -20,6 +20,7 @@ import Config.Cost
 import Types.Distribution
 import Types.Availability
 import Types.NumCopies
+import Types.Difference
 import Utility.HumanTime
 
 {- Main git-annex settings. Each setting corresponds to a git-config key
@@ -56,6 +57,7 @@ data GitConfig = GitConfig
 	, annexHardLink :: Bool
 	, coreSymlinks :: Bool
 	, gcryptId :: Maybe String
+	, annexDifferences :: Differences
 	}
 
 extractGitConfig :: Git.Repo -> GitConfig
@@ -93,6 +95,7 @@ extractGitConfig r = GitConfig
 	, annexHardLink = getbool (annex "hardlink") False
 	, coreSymlinks = getbool "core.symlinks" True
 	, gcryptId = getmaybe "core.gcrypt-id"
+	, annexDifferences = getDifferences r
 	}
   where
 	getbool k def = fromMaybe def $ getmaybebool k