refactor cluster code into own module

Annex/Cluster.hs

@@ -0,0 +1,67 @@
+{- clusters
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE RankNTypes #-}
+
+module Annex.Cluster where
+
+import Annex.Common
+import Types.Cluster
+import Logs.Cluster
+import P2P.Proxy
+import P2P.Protocol
+import P2P.IO
+import Logs.Location
+import Types.Command
+import Remote.List
+import qualified Remote
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+{- Proxy to a cluster. -}
+proxyCluster 
+	:: ClusterUUID
+	-> CommandPerform
+	-> ServerMode
+	-> ClientSide
+	-> (forall a. ((a -> CommandPerform) -> Annex (Either ProtoFailure a) -> CommandPerform))
+	-> CommandPerform
+proxyCluster clusteruuid proxydone servermode clientside protoerrhandler = do
+	getClientProtocolVersion (fromClusterUUID clusteruuid) clientside
+		withclientversion protoerrhandler
+  where
+	proxymethods = ProxyMethods
+		{ removedContent = \u k -> logChange k u InfoMissing
+		, addedContent = \u k -> logChange k u InfoPresent
+		}
+	
+	withclientversion (Just (clientmaxversion, othermsg)) = do
+		-- The protocol versions supported by the nodes are not
+		-- known at this point, and would be too expensive to
+		-- determine. Instead, pick the newest protocol version
+		-- that we and the client both speak.
+		let protocolversion = min maxProtocolVersion clientmaxversion
+		selectnode <- clusterProxySelector clusteruuid
+		proxy proxydone proxymethods servermode clientside selectnode
+			protocolversion othermsg protoerrhandler
+	withclientversion Nothing = proxydone
+
+clusterProxySelector :: ClusterUUID -> Annex ProxySelector
+clusterProxySelector clusteruuid = do
+	nodes <- (fromMaybe S.empty . M.lookup clusteruuid . clusterUUIDs)
+		<$> getClusters
+	remotes <- filter (flip S.member nodes . ClusterNodeUUID . Remote.uuid)
+		<$> remoteList
+	return $ ProxySelector
+		{ proxyCHECKPRESENT = \k -> error "TODO"
+		, proxyLOCKCONTENT = \k -> error "TODO"
+		, proxyUNLOCKCONTENT = error "TODO"
+		, proxyREMOVE = \k -> error "TODO"
+		, proxyGET = \k -> error "TODO"
+		, proxyPUT = \k -> error "TODO"
+		}

Command/P2PStdIO.hs

@@ -18,6 +18,7 @@ import qualified CmdLine.GitAnnexShell.Checks as Checks
 import Remote.Helper.Ssh (openP2PShellConnection', closeP2PShellConnection)
 import Logs.Location
 import Logs.Cluster
+import Annex.Cluster
 import qualified Remote
 
 import System.IO.Error
@@ -73,30 +74,20 @@ performProxy clientuuid servermode remote = do
 		let closer = do
 			closeRemoteSide remoteside
 			p2pDone
-		proxy closer proxyMethods servermode clientside
+		proxy closer proxymethods servermode clientside
 			(singleProxySelector remoteside)
 			protocolversion othermsg p2pErrHandler
 	withclientversion _ Nothing = p2pDone
+	
+	proxymethods = ProxyMethods
+		{ removedContent = \u k -> logChange k u InfoMissing
+		, addedContent = \u k -> logChange k u InfoPresent
+		}
 
 performProxyCluster :: UUID -> ClusterUUID -> P2P.ServerMode -> CommandPerform
 performProxyCluster clientuuid clusteruuid servermode = do
 	clientside <- proxyClientSide clientuuid
-	getClientProtocolVersion (fromClusterUUID clusteruuid) clientside 
+	proxyCluster clusteruuid p2pDone servermode clientside p2pErrHandler
-		(withclientversion clientside)
-		p2pErrHandler
-  where
-	withclientversion clientside (Just (clientmaxversion, othermsg)) = do
-		let protocolversion = min P2P.maxProtocolVersion clientmaxversion
-		let selectnode = giveup "FIXME" -- FIXME
-		proxy p2pDone proxyMethods servermode clientside selectnode
-			protocolversion othermsg p2pErrHandler
-	withclientversion _ Nothing = p2pDone
-
-proxyMethods :: ProxyMethods
-proxyMethods = ProxyMethods
-	{ removedContent = \u k -> logChange k u InfoMissing
-	, addedContent = \u k -> logChange k u InfoPresent
-	}
 
 proxyClientSide :: UUID -> Annex ClientSide
 proxyClientSide clientuuid = do

git-annex.cabal

@@ -508,6 +508,7 @@ Executable git-annex
     Annex.ChangedRefs
     Annex.CheckAttr
     Annex.CheckIgnore
+    Annex.Cluster
     Annex.Common
     Annex.Concurrent
     Annex.Concurrent.Utility