diff --git a/Annex/Cluster.hs b/Annex/Cluster.hs new file mode 100644 index 0000000000..e9299836fe --- /dev/null +++ b/Annex/Cluster.hs @@ -0,0 +1,67 @@ +{- clusters + - + - Copyright 2024 Joey Hess + - + - 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 b251641a3c..2123781318 100644 --- 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 37e5fddd5f..d04848b7a3 100644 --- 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