started on git-annex-shell cluster support

Works down to P2P protocol.

The question now is, how to handle protocol version negotiation for
clusters? Connecting to each node to find their protocol versions and
using the lowest would be too expensive with a lot of nodes. So it seems
that the cluster needs to pick its own protocol version to use with the
client.

Then it can either negotiate that same version with the nodes when
it comes time to use them, or it can translate between multiple protocol
versions. That seems complicated. Thinking it would be ok to refuse to
use a node if it is not able to negotiate the same protocol version with
it as with the client. That will mean that sometimes need nodes to be
upgraded when upgrading the cluster's proxy. But protocol versions
rarely change.

Annex.hs

@@ -215,7 +215,7 @@ data AnnexState = AnnexState
 	, urloptions :: Maybe UrlOptions
 	, insmudgecleanfilter :: Bool
 	, getvectorclock :: IO CandidateVectorClock
-	, proxyremote :: Maybe (Types.Remote.RemoteA Annex)
+	, proxyremote :: Maybe (Either ClusterUUID (Types.Remote.RemoteA Annex))
 	}
 
 newAnnexState :: GitConfig -> Git.Repo -> IO AnnexState

CmdLine/GitAnnexShell.hs

@@ -21,6 +21,7 @@ import Remote.GCrypt (getGCryptUUID)
 import P2P.Protocol (ServerMode(..))
 import Git.Types
 import Logs.Proxy
+import Logs.Cluster
 import Logs.UUID
 import Remote
 
@@ -193,11 +194,14 @@ checkProxy remoteuuid ouruuid = M.lookup ouruuid <$> getProxies >>= \case
 	Just proxies ->
 		case filter (\p -> proxyRemoteUUID p == remoteuuid) (S.toList proxies) of
 			[] -> notconfigured
-			ps -> do
+			ps -> case mkClusterUUID remoteuuid of
-				-- This repository may have multiple
+				Just cu -> proxyforcluster cu
-				-- remotes that access the same repository.
+				Nothing -> proxyfor ps
-				-- Proxy for the lowest cost one that
+  where
-				-- is configured to be used as a proxy.
+	-- This repository may have multiple remotes that access the same
+	-- repository. Proxy for the lowest cost one that is configured to
+	-- be used as a proxy.
+	proxyfor ps = do
 		rs <- concat . byCost <$> remoteList
 		let sameuuid r = uuid r == remoteuuid
 		let samename r p = name r == proxyRemoteName p
@@ -205,9 +209,18 @@ checkProxy remoteuuid ouruuid = M.lookup ouruuid <$> getProxies >>= \case
 			Nothing -> notconfigured
 			Just r -> do
 				Annex.changeState $ \st ->
-							st { Annex.proxyremote = Just r }
+					st { Annex.proxyremote = Just (Right r) }
 				return True
-  where
+
+	proxyforcluster cu = do
+		clusters <- getClusters
+		if M.member cu (clusterUUIDs clusters)
+			then do
+				Annex.changeState $ \st ->
+					st { Annex.proxyremote = Just (Left cu) }
+				return True
+			else notconfigured
+
 	notconfigured = M.lookup remoteuuid <$> uuidDescMap >>= \case
-		Just desc -> giveup $ "not configured to proxy for repository " ++ (fromUUIDDesc desc)
+		Just desc -> giveup $ "not configured to proxy for repository " ++ fromUUIDDesc desc
 		Nothing -> return False

Command/P2PStdIO.hs

@@ -17,6 +17,7 @@ import Annex.UUID
 import qualified CmdLine.GitAnnexShell.Checks as Checks
 import Remote.Helper.Ssh (openP2PShellConnection', closeP2PShellConnection)
 import Logs.Location
+import Logs.Cluster
 import qualified Remote
 
 import System.IO.Error
@@ -40,8 +41,12 @@ start theiruuid = startingCustomOutput (ActionItemOther Nothing) $ do
 			(False, True) -> P2P.ServeAppendOnly
 			(False, False) -> P2P.ServeReadWrite
 	Annex.getState Annex.proxyremote >>= \case
-		Nothing -> performLocal theiruuid servermode
+		Nothing ->
-		Just r -> performProxy theiruuid servermode r
+			performLocal theiruuid servermode
+		Just (Right r) ->
+			performProxy theiruuid servermode r
+		Just (Left clusteruuid) -> 
+			performProxyCluster theiruuid clusteruuid servermode
 
 performLocal :: UUID -> P2P.ServerMode -> CommandPerform
 performLocal theiruuid servermode = do
@@ -51,35 +56,45 @@ performLocal theiruuid servermode = do
 		P2P.net $ P2P.sendMessage (P2P.AUTH_SUCCESS myuuid)
 		P2P.serveAuthed servermode myuuid
 	runst <- liftIO $ mkRunState $ Serving theiruuid Nothing
-	runFullProto runst conn server >>= \case
+	p2pErrHandler (const p2pDone) (runFullProto runst conn server)
-		Right () -> done
-		-- Avoid displaying an error when the client hung up on us.
-		Left (ProtoFailureIOError e) | isEOFError e -> done
-		Left e -> giveup (describeProtoFailure e)
-  where
-	done = next $ return True
 
 performProxy :: UUID -> P2P.ServerMode -> Remote -> CommandPerform
 performProxy clientuuid servermode remote = do
-	clientrunst <- liftIO (mkRunState $ Serving clientuuid Nothing)
+	clientside <- proxyClientSide clientuuid
-	let clientside = ClientSide clientrunst (stdioP2PConnection Nothing)
+	getClientProtocolVersion (Remote.uuid remote) clientside 
-	getClientProtocolVersion remote clientside 
 		(withclientversion clientside)
-		protoerrhandler
+		p2pErrHandler
   where
 	withclientversion clientside (Just (clientmaxversion, othermsg)) = do
-		remoteside <- connectremote clientmaxversion
+		remoteside <- proxySshRemoteSide clientmaxversion remote
-		proxy done proxymethods servermode clientside remoteside 
+		proxy p2pDone proxymethods servermode clientside remoteside 
-			othermsg protoerrhandler
+			othermsg p2pErrHandler
-	withclientversion _ Nothing = done
+	withclientversion _ Nothing = p2pDone
 	
 	proxymethods = ProxyMethods
 		{ removedContent = \u k -> logChange k u InfoMissing
 		, addedContent = \u k -> logChange k u InfoPresent
 		}
 
-	-- FIXME: Support special remotes.
+performProxyCluster :: UUID -> ClusterUUID -> P2P.ServerMode -> CommandPerform
-	connectremote clientmaxversion = mkRemoteSide (Remote.uuid remote) $
+performProxyCluster clientuuid clusteruuid servermode = do
+	clientside <- proxyClientSide clientuuid
+	getClientProtocolVersion (fromClusterUUID clusteruuid) clientside 
+		(withclientversion clientside)
+		p2pErrHandler
+  where
+	withclientversion clientside (Just (clientmaxversion, othermsg)) = do
+		giveup "TODO"
+	withclientversion _ Nothing = p2pDone
+
+proxyClientSide :: UUID -> Annex ClientSide
+proxyClientSide clientuuid = do
+	clientrunst <- liftIO (mkRunState $ Serving clientuuid Nothing)
+	return $ ClientSide clientrunst (stdioP2PConnection Nothing)
+
+-- FIXME: Support special remotes.
+proxySshRemoteSide :: P2P.ProtocolVersion -> Remote -> Annex RemoteSide
+proxySshRemoteSide clientmaxversion remote = mkRemoteSide (Remote.uuid remote) $
 	openP2PShellConnection' remote clientmaxversion >>= \case
 		Just conn@(P2P.IO.OpenConnection (remoterunst, remoteconn, _)) ->
 			return $ Just 
@@ -89,10 +104,12 @@ performProxy clientuuid servermode remote = do
 				)
 		_  -> return Nothing
 
-	protoerrhandler cont a = a >>= \case
+p2pErrHandler :: (a -> CommandPerform) -> Annex (Either ProtoFailure a) -> CommandPerform
+p2pErrHandler cont a = a >>= \case
 	-- Avoid displaying an error when the client hung up on us.
-		Left (ProtoFailureIOError e) | isEOFError e -> done
+	Left (ProtoFailureIOError e) | isEOFError e -> p2pDone
 	Left e -> giveup (describeProtoFailure e)
 	Right v -> cont v
 
-	done = next $ return True
+p2pDone :: CommandPerform
+p2pDone = next $ return True

Logs/Cluster.hs

@@ -8,14 +8,10 @@
 {-# LANGUAGE OverloadedStrings, TupleSections #-}
 
 module Logs.Cluster (
-	ClusterUUID,
+	module Types.Cluster,
-	isClusterUUID,
-	fromClusterUUID,
-	ClusterNodeUUID(..),
 	getClusters,
 	loadClusters,
 	recordCluster,
-	Clusters(..)
 ) where
 
 import qualified Annex

P2P/Proxy.hs

@@ -12,7 +12,6 @@ module P2P.Proxy where
 import Annex.Common
 import P2P.Protocol
 import P2P.IO
-import qualified Remote
 import Utility.Metered (nullMeterUpdate)
 
 import Control.Concurrent.STM
@@ -60,20 +59,20 @@ type ProtoErrorHandled r =
  - brought up yet.
  -}
 getClientProtocolVersion 
-	:: Remote
+	:: UUID
 	-> ClientSide
 	-> (Maybe (ProtocolVersion, Maybe Message) -> Annex r)
 	-> ProtoErrorHandled r
-getClientProtocolVersion remote (ClientSide clientrunst clientconn) cont protoerrhandler =
+getClientProtocolVersion remoteuuid (ClientSide clientrunst clientconn) cont protoerrhandler =
-	protoerrhandler cont $ client $ getClientProtocolVersion' remote
+	protoerrhandler cont $ client $ getClientProtocolVersion' remoteuuid
   where
 	client = liftIO . runNetProto clientrunst clientconn
 
 getClientProtocolVersion'
-	:: Remote
+	:: UUID
 	-> Proto (Maybe (ProtocolVersion, Maybe Message))
-getClientProtocolVersion' remote = do
+getClientProtocolVersion' remoteuuid = do
-	net $ sendMessage (AUTH_SUCCESS (Remote.uuid remote))
+	net $ sendMessage (AUTH_SUCCESS remoteuuid)
 	msg <- net receiveMessage
 	case msg of
 		Nothing -> return Nothing