From 344141da63a9f6c46b63a52a116c9757fcf80110 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 25 Sep 2024 11:07:58 -0400
Subject: [PATCH] sim: add commands for cluster management

Clusters are not actually simulated yet.
---
 Annex/Sim.hs           | 33 +++++++++++++++++++++++++++++++++
 Annex/Sim/File.hs      | 12 ++++++++++++
 doc/git-annex-sim.mdwn | 25 +++++++++++++++++++++++++
 3 files changed, 70 insertions(+)

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index dfae56949b..0cae7929cf 100644
--- a/Annex/Sim.hs
+++ b/Annex/Sim.hs
@@ -71,6 +71,7 @@ data SimState t = SimState
 	, simGroupWanted :: M.Map Group PreferredContentExpression
 	, simMaxSize :: M.Map UUID MaxSize
 	, simRebalance :: Bool
+	, simClusters :: M.Map RepoName (S.Set RemoteName)
 	, simHistory :: [SimCommand]
 	, simVectorClock :: VectorClock
 	, simRootDirectory :: FilePath
@@ -94,6 +95,7 @@ emptySimState rngseed rootdir = SimState
 	, simGroupWanted = mempty
 	, simMaxSize = mempty
 	, simRebalance = False
+	, simClusters = mempty
 	, simHistory = []
 	, simVectorClock = VectorClock 0
 	, simRootDirectory = rootdir
@@ -230,6 +232,9 @@ data SimCommand
 	| CommandRandomGroupWanted Group [PreferredContentExpression]
 	| CommandMaxSize RepoName MaxSize
 	| CommandRebalance Bool
+	| CommandInitCluster RepoName
+	| CommandAddCluster RepoName [RemoteName]
+	| CommandRemoveCluster RepoName RemoteName
 	| CommandVisit RepoName [String]
 	| CommandComment String
 	| CommandBlank
@@ -524,6 +529,34 @@ applySimCommand' (CommandRebalance b) st _ =
 	Right $ Right $ st
 		{ simRebalance = b
 		}
+applySimCommand' (CommandInitCluster clustername) st _ =
+	checkNonexistantRepo clustername st $
+		let (u, st') = genSimUUID st clustername
+		    st'' = st'
+		    	{ simClusters = M.insert clustername mempty
+				(simClusters st')
+			}
+		in Right $ Right $
+			addRepo clustername (newSimRepoConfig u False) st''
+applySimCommand' (CommandAddCluster clustername nodes) st _ =
+	checkKnownRepo clustername st $ \u ->
+		case M.lookup clustername (simClusters st) of
+			Nothing -> Left $ fromRepoName clustername ++ " is not a cluster (use initcluster before addcluster)"
+			Just nodeset -> 
+				let nodeset' = S.union nodeset (S.fromList nodes)
+				in Right $ Right $ st
+				 	{ simClusters = M.insert clustername nodeset'
+						(simClusters st)
+					}
+applySimCommand' (CommandRemoveCluster clustername node) st _ =
+	case M.lookup clustername (simClusters st) of
+		Nothing -> Left $ fromRepoName clustername ++ " is not a cluster"
+		Just nodeset -> 
+			let nodeset' = S.delete node nodeset
+			in Right $ Right $ st
+				{ simClusters = M.insert clustername nodeset'
+					(simClusters st)
+				}
 applySimCommand' (CommandComment _) st _ = Right $ Right st
 applySimCommand' CommandBlank st _ = Right $ Right st
 applySimCommand' (CommandVisit _ _) _ _ = error "applySimCommand' CommandVisit"
diff --git a/Annex/Sim/File.hs b/Annex/Sim/File.hs
index d4bc59c75c..c3b104507a 100644
--- a/Annex/Sim/File.hs
+++ b/Annex/Sim/File.hs
@@ -88,6 +88,12 @@ generateSimFile = unlines . map unwords . go
 		["maxsize", repo, showsize (fromMaxSize maxsize)] : go rest
 	go (CommandRebalance b : rest) =
 		["rebalance", if b then "on" else "off"] : go rest
+	go (CommandInitCluster (RepoName repo) : rest) =
+		["initcluster", repo] : go rest
+	go (CommandAddCluster (RepoName repo) nodes : rest) =
+		("addcluster" : repo : map fromRemoteName nodes) : go rest
+	go (CommandRemoveCluster (RepoName repo) (RemoteName node) : rest) =
+		["removecluster", repo, node] : go rest
 	go (CommandVisit (RepoName repo) cmdparams : rest) =
 		(["visit", repo] ++ cmdparams) : go rest
 	go (CommandComment s : rest) = 
@@ -204,6 +210,12 @@ parseSimCommand ("maxsize":repo:size:[]) =
 parseSimCommand ("rebalance":onoff:[]) = case isTrueFalse onoff of
 	Just b -> Right $ CommandRebalance b
 	Nothing -> Left $ "Unable to parse rebalance value \"" ++ onoff ++ "\""
+parseSimCommand ("initcluster":name:[]) =
+	Right $ CommandInitCluster (RepoName name)
+parseSimCommand ("addcluster":name:nodes) =
+	Right $ CommandAddCluster (RepoName name) (map RemoteName nodes)
+parseSimCommand ("removecluster":name:node:[]) =
+	Right $ CommandRemoveCluster (RepoName name) (RemoteName node)
 parseSimCommand ("visit":repo:cmdparams) =
 	Right $ CommandVisit (RepoName repo) cmdparams
 parseSimCommand ws = parseError ws
diff --git a/doc/git-annex-sim.mdwn b/doc/git-annex-sim.mdwn
index 09505ee9d4..5d96c08f78 100644
--- a/doc/git-annex-sim.mdwn
+++ b/doc/git-annex-sim.mdwn
@@ -368,6 +368,31 @@ as passed to "git annex sim" while a simulation is running.
     step 100
     rebalance off
 
+* `initcluster name`
+
+  Initializes a simulated cluster with the given name.
+
+* `addcluster name [node ...]`
+
+  Adds each of the listed nodes to the cluster. The cluster is connected to
+  each node, and will accept files sent to it and store them on the nodes.
+  Repositories that are connected to the cluster will also be able to
+  receive files from it.
+
+  Note that adding a connection to a cluster does not automatically
+  set up connections to its nodes. To replicate git-annex's behavior with
+  a real cluster remote, those connections can be manually configured. For
+  example:
+
+    addcluster mycluster node1 node2
+    connect foo -> mycluster
+    connect foo -> node1
+    connect foo -> node2
+
+* `removecluster name node`
+
+  Removes a node from the cluster.
+
 # OPTIONS
 
 * The [[git-annex-common-options]](1) can be used.