add git-annex updatecluster command

Seems to work fine, making the right changes to the git-annex branch.

Types/Cluster.hs

@@ -10,6 +10,7 @@
 module Types.Cluster (
 	ClusterUUID,
 	mkClusterUUID,
+	genClusterUUID,
 	isClusterUUID,
 	fromClusterUUID,
 	ClusterNodeUUID(..),
@@ -32,17 +33,13 @@ import Data.Char
 newtype ClusterUUID = ClusterUUID UUID
 	deriving (Show, Eq, Ord)
 
--- Smart constructor for a ClusterUUID.
---
--- The input UUID can be any regular UUID (eg V4). It is converted to a valid
--- cluster UUID.
+-- Smart constructor for a ClusterUUID. Only allows valid cluster UUIDs.
 mkClusterUUID :: UUID -> Maybe ClusterUUID
-mkClusterUUID (UUID b)
-	| B.length b > 14 = Just $ ClusterUUID $ UUID $
-		"ac" <> B.drop 2 (B.take 14 b) <> "8" <> B.drop 15 b
+mkClusterUUID u
+	| isClusterUUID u = Just (ClusterUUID u)
 	| otherwise = Nothing
-mkClusterUUID NoUUID = Nothing
 
+-- Check if it is a valid cluster UUID.
 isClusterUUID :: UUID -> Bool
 isClusterUUID (UUID b) 
 	| B.take 2 b == "ac" = 
@@ -55,6 +52,15 @@ isClusterUUID (UUID b)
 	eight = fromIntegral (ord '8')
 isClusterUUID _ = False
 
+-- Generates a ClusterUUID from any regular UUID (eg V4). 
+-- It is converted to a valid cluster UUID.
+genClusterUUID :: UUID -> Maybe ClusterUUID
+genClusterUUID (UUID b)
+	| B.length b > 14 = Just $ ClusterUUID $ UUID $
+		"ac" <> B.drop 2 (B.take 14 b) <> "8" <> B.drop 15 b
+	| otherwise = Nothing
+genClusterUUID NoUUID = Nothing
+
 fromClusterUUID :: ClusterUUID -> UUID
 fromClusterUUID (ClusterUUID u) = u
 
@@ -69,3 +75,4 @@ data Clusters = Clusters
 	{ clusterUUIDs :: M.Map ClusterUUID (S.Set ClusterNodeUUID)
 	, clusterNodeUUIDs :: M.Map ClusterNodeUUID (S.Set ClusterUUID)
 	}
+	deriving (Show)

Types/GitConfig.hs

@@ -31,7 +31,7 @@ import qualified Git.Config
 import qualified Git.Construct
 import Git.Types
 import Git.ConfigTypes
-import Git.Remote (isRemoteKey, remoteKeyToRemoteName)
+import Git.Remote (isRemoteKey, isLegalName, remoteKeyToRemoteName)
 import Git.Branch (CommitMode(..))
 import Git.Quote (QuotePath(..))
 import Utility.DataUnits
@@ -156,7 +156,7 @@ data GitConfig = GitConfig
 	, annexPrivateRepos :: S.Set UUID
 	, annexAdviceNoSshCaching :: Bool
 	, annexViewUnsetDirectory :: ViewUnset
-	, annexClusters :: M.Map String ClusterUUID
+	, annexClusters :: M.Map RemoteName ClusterUUID
 	}
 
 extractGitConfig :: ConfigSource -> Git.Repo -> GitConfig
@@ -287,10 +287,8 @@ extractGitConfig configsource r = GitConfig
 		getmaybe (annexConfig "viewunsetdirectory")
 	, annexClusters = 
 		M.mapMaybe (mkClusterUUID . toUUID) $
-		M.mapKeys (drop (B.length clusterprefix) . fromConfigKey) $
-		M.filterWithKey
-			(\(ConfigKey k) _ -> clusterprefix `B.isPrefixOf` k)
-			(config r)
+			M.mapKeys removeclusterprefix $
+				M.filterWithKey isclusternamekey (config r)
 	}
   where
 	getbool k d = fromMaybe d $ getmaybebool k
@@ -316,6 +314,9 @@ extractGitConfig configsource r = GitConfig
 	hereuuid = maybe NoUUID toUUID $ getmaybe (annexConfig "uuid")
 
 	clusterprefix = annexConfigPrefix <> "cluster."
+	isclusternamekey k _ = clusterprefix `B.isPrefixOf` (fromConfigKey' k)
+		&& isLegalName (removeclusterprefix k)
+	removeclusterprefix k = drop (B.length clusterprefix) (fromConfigKey k)
 
 {- Merge a GitConfig that comes from git-config with one containing
  - repository-global defaults. -}
@@ -387,7 +388,7 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexMaxGitBundles :: Int
 	, remoteAnnexAllowEncryptedGitRepo :: Bool
 	, remoteAnnexProxy :: Bool
-	, remoteAnnexClusterNode :: Maybe [String]
+	, remoteAnnexClusterNode :: Maybe [RemoteName]
 	, remoteUrl :: Maybe String
 
 	{- These settings are specific to particular types of remotes
@@ -473,7 +474,9 @@ extractRemoteGitConfig r remotename = do
 		, remoteAnnexAllowEncryptedGitRepo = 
 			getbool AllowEncryptedGitRepoField False
 		, remoteAnnexProxy = getbool ProxyField False
-		, remoteAnnexClusterNode = words <$> getmaybe ClusterNodeField
+		, remoteAnnexClusterNode = 
+			(filter isLegalName . words)
+				<$> getmaybe ClusterNodeField
 		, remoteUrl = 
 			case Git.Config.getMaybe (remoteConfig remotename (remoteGitConfigKey UrlField)) r of
 				Just (ConfigValue b)