refactor cluster code into own module

diff --git a/Annex/Cluster.hs b/Annex/Cluster.hs
new file mode 100644 (file)
index 0000000..e929983
--- /dev/null
+++ b/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"
+               }

diff --git a/Command/P2PStdIO.hs b/Command/P2PStdIO.hs
index b251641a3c9ee518c3f3dde8e00e20a112c18cd6..21237813187fe4886aea9b8536f492852971d4c9 100644 (file)
--- a/Command/P2PStdIO.hs
+++ b/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 
-               (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
-       }
+       proxyCluster clusteruuid p2pDone servermode clientside p2pErrHandler
 
 proxyClientSide :: UUID -> Annex ClientSide
 proxyClientSide clientuuid = do

diff --git a/git-annex.cabal b/git-annex.cabal
index 37e5fddd5f50cafe189b6841330a9cfae3668322..d04848b7a36b4d1cb24b59b422e6b53b9c917447 100644 (file)
--- a/git-annex.cabal
+++ b/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