refactor cluster code into own module

This commit is contained in:
Joey Hess 2024-06-18 10:36:04 -04:00
parent 8290f70978
commit f0d6114286
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 76 additions and 17 deletions

67
Annex/Cluster.hs Normal file
View file

@ -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"
}

View file

@ -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

View file

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