automatically derive an annex-uuid from a gcrypt-uuids

This commit is contained in:
Joey Hess 2013-09-05 16:02:39 -04:00
parent 76d5611da8
commit a48a4e2f8a
4 changed files with 90 additions and 0 deletions

View file

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