automatically derive an annex-uuid from a gcrypt-uuids

1 files changed, 22 insertions, 0 deletions

diff --git a/Annex/UUID.hs b/Annex/UUID.hs
index c36861bbe..4e274503b 100644
--- a/Annex/UUID.hs
+++ b/Annex/UUID.hs
@@ -17,8 +17,11 @@ module Annex.UUID (
 	getUncachedUUID,
 	prepUUID,
 	genUUID,
+	genUUIDInNameSpace,
+	gCryptNameSpace,
 	removeRepoUUID,
 	storeUUID,
+	setUUID,
 ) where
 
 import Common.Annex
@@ -27,7 +30,9 @@ import qualified Git.Config
 import Config
 
 import qualified Data.UUID as U
+import qualified Data.UUID.V5 as U5
 import System.Random
+import Data.Bits.Utils
 
 configkey :: ConfigKey
 configkey = annexConfig "uuid"
@@ -36,6 +41,17 @@ configkey = annexConfig "uuid"
 genUUID :: IO UUID
 genUUID = UUID . show <$> (randomIO :: IO U.UUID)
 
+{- Generates a UUID from a given string, using a namespace.
+ - Given the same namespace, the same string will always result
+ - in the same UUID. -}
+genUUIDInNameSpace :: U.UUID -> String -> UUID
+genUUIDInNameSpace namespace = UUID . show . U5.generateNamed namespace . s2w8
+
+{- Namespace used for UUIDs derived from git-remote-gcrypt ids. -}
+gCryptNameSpace :: U.UUID
+gCryptNameSpace = U5.generateNamed U5.namespaceURL $
+	s2w8 "http://git-annex.branchable.com/design/gcrypt/" 
+
 {- Get current repository's UUID. -}
 getUUID :: Annex UUID
 getUUID = getRepoUUID =<< gitRepo
@@ -72,3 +88,9 @@ prepUUID = whenM ((==) NoUUID <$> getUUID) $
 
 storeUUID :: ConfigKey -> UUID -> Annex ()
 storeUUID configfield = setConfig configfield . fromUUID
+
+{- Only sets the configkey in the Repo; does not change .git/config -}
+setUUID :: Git.Repo -> UUID -> IO Git.Repo
+setUUID r u = do
+	let s = show configkey ++ "=" ++ fromUUID u
+	Git.Config.store s r