From 7bbd822a17874cef42069e34c8adcdff035862d5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sun, 23 Jun 2024 06:20:11 -0400
Subject: [PATCH] avoid using cluster nodes in drop proof when dropping from
 cluster

This is obviously necessary in order for dropping from a cluster to be able to
drop from all nodes.

It also avoids violating numcopies when a cluster node is a special remote.
If it were used in the drop proof, nothing would prevent the cluster from
dropping from it.
---
 Annex/NumCopies.hs              | 34 +++++++++++++++++++++++----------
 doc/todo/git-annex_proxies.mdwn | 10 ----------
 2 files changed, 24 insertions(+), 20 deletions(-)

diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs
index 4d680c8411..b656aa2b46 100644
--- a/Annex/NumCopies.hs
+++ b/Annex/NumCopies.hs
@@ -32,7 +32,7 @@ import qualified Annex
 import Types.NumCopies
 import Logs.NumCopies
 import Logs.Trust
-import Types.Cluster
+import Logs.Cluster
 import Annex.CheckAttr
 import qualified Remote
 import qualified Types.Remote as Remote
@@ -42,8 +42,10 @@ import Annex.CatFile
 import qualified Database.Keys
 
 import Control.Exception
-import qualified Control.Monad.Catch as M
+import qualified Control.Monad.Catch as MC
 import Data.Typeable
+import qualified Data.Set as S
+import qualified Data.Map as M
 
 defaultNumCopies :: NumCopies
 defaultNumCopies = configuredNumCopies 1
@@ -284,11 +286,11 @@ verifyEnoughCopiesToDrop nolocmsg key removallock neednum needmin skip preverifi
 			-- of exceptions by using DropException.
 			let a = lockcontent key $ \v -> 
 				cont v `catchNonAsync` (throw . DropException)
-			a `M.catches`
-				[ M.Handler (\ (e :: AsyncException) -> throwM e)
-				, M.Handler (\ (e :: SomeAsyncException) -> throwM e)
-				, M.Handler (\ (DropException e') -> throwM e')
-				, M.Handler (\ (_e :: SomeException) -> fallback)
+			a `MC.catches`
+				[ MC.Handler (\ (e :: AsyncException) -> throwM e)
+				, MC.Handler (\ (e :: SomeAsyncException) -> throwM e)
+				, MC.Handler (\ (DropException e') -> throwM e')
+				, MC.Handler (\ (_e :: SomeException) -> fallback)
 				]
 		Nothing -> fallback
 
@@ -332,8 +334,10 @@ pluralCopies _ = "copies"
  - The return lists also exclude any repositories that are untrusted,
  - since those should not be used for verification.
  -
- - Cluster UUIDs are also excluded since locking on a cluster is done by
- - locking on individual nodes.
+ - When dropping from a cluster UUID, its nodes are excluded.
+ -
+ - Cluster UUIDs are also excluded since locking a key on a cluster
+ - is done by locking on individual nodes.
  -
  - The UnVerifiedCopy list is cost ordered.
  - The VerifiedCopy list contains repositories that are trusted to
@@ -344,8 +348,13 @@ verifiableCopies key exclude = do
 	locs <- filter (not . isClusterUUID) <$> Remote.keyLocations key
 	(remotes, trusteduuids) <- Remote.remoteLocations (Remote.IncludeIgnored False) locs
 		=<< trustGet Trusted
+	clusternodes <- if any isClusterUUID exclude
+		then do
+			clusters <- getClusters
+			pure $ concatMap (getclusternodes clusters) exclude
+		else pure []
 	untrusteduuids <- trustGet UnTrusted
-	let exclude' = exclude ++ untrusteduuids
+	let exclude' = exclude ++ untrusteduuids ++ clusternodes
 	let remotes' = Remote.remotesWithoutUUID remotes (exclude' ++ trusteduuids)
 	let verified = map (mkVerifiedCopy TrustedCopy) $
 		filter (`notElem` exclude') trusteduuids
@@ -354,3 +363,8 @@ verifiableCopies key exclude = do
 		then [UnVerifiedHere]
 		else []
 	return (herec ++ map UnVerifiedRemote remotes', verified)
+  where
+	getclusternodes clusters u = case mkClusterUUID u of
+		Just cu -> maybe [] (map fromClusterNodeUUID . S.toList) $
+			M.lookup cu (clusterUUIDs clusters)
+		Nothing -> []
diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index 395a0ec0df..deb95561e2 100644
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -70,16 +70,6 @@ For June's work on [[design/passthrough_proxy]], implementation plan:
 * Implement cluster drops, trying to remove from all nodes, and returning
   which UUIDs it was dropped from. 
 
-  Problem: May lock content on cluster
-  nodes to satisfy numcopies (rather than locking elsewhere) and so not be
-  able to drop from nodes. Avoid using cluster nodes when constructing drop
-  proof for cluster.
-
-  Problem: When nodes are special remotes, may
-  treat nodes as copies while dropping from cluster, and so violate
-  numcopies. (But not mincopies.) This is also solved by avoiding using
-  cluster nodes when constructing drop proof for cluster.
-
   Problem: `move --from cluster` in "does this make it worse"
   check may fail to realize that dropping from multiple nodes does in fact
   make it worse.