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,21 +194,33 @@ checkProxy remoteuuid ouruuid = M.lookup ouruuid <$> getProxies >>= \case
 	Just proxies ->
 		case filter (\p -> proxyRemoteUUID p == remoteuuid) (S.toList proxies) of
 			[] -> notconfigured
-			ps -> do
-				-- 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.
-				rs <- concat . byCost <$> remoteList
-				let sameuuid r = uuid r == remoteuuid
-				let samename r p = name r == proxyRemoteName p
-				case headMaybe (filter (\r -> sameuuid r && any (samename r) ps) rs) of
-					Nothing -> notconfigured
-					Just r -> do
-						Annex.changeState $ \st ->
-							st { Annex.proxyremote = Just r }
-						return True
+			ps -> case mkClusterUUID remoteuuid of
+				Just cu -> proxyforcluster cu
+				Nothing -> proxyfor ps
   where
+	-- 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
+		case headMaybe (filter (\r -> sameuuid r && any (samename r) ps) rs) of
+			Nothing -> notconfigured
+			Just r -> do
+				Annex.changeState $ \st ->
+					st { Annex.proxyremote = Just (Right r) }
+				return True
+
+	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
-		Just r -> performProxy theiruuid servermode r
+		Nothing ->
+			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,48 +56,60 @@ 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
-		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
+	p2pErrHandler (const p2pDone) (runFullProto runst conn server)
 
 performProxy :: UUID -> P2P.ServerMode -> Remote -> CommandPerform
 performProxy clientuuid servermode remote = do
-	clientrunst <- liftIO (mkRunState $ Serving clientuuid Nothing)
-	let clientside = ClientSide clientrunst (stdioP2PConnection Nothing)
-	getClientProtocolVersion remote clientside 
+	clientside <- proxyClientSide clientuuid
+	getClientProtocolVersion (Remote.uuid remote) clientside 
 		(withclientversion clientside)
-		protoerrhandler
+		p2pErrHandler
   where
 	withclientversion clientside (Just (clientmaxversion, othermsg)) = do
-		remoteside <- connectremote clientmaxversion
-		proxy done proxymethods servermode clientside remoteside 
-			othermsg protoerrhandler
-	withclientversion _ Nothing = done
+		remoteside <- proxySshRemoteSide clientmaxversion remote
+		proxy p2pDone proxymethods servermode clientside remoteside 
+			othermsg p2pErrHandler
+	withclientversion _ Nothing = p2pDone
 	
 	proxymethods = ProxyMethods
 		{ removedContent = \u k -> logChange k u InfoMissing
 		, addedContent = \u k -> logChange k u InfoPresent
 		}
 
-	-- FIXME: Support special remotes.
-	connectremote clientmaxversion = mkRemoteSide (Remote.uuid remote) $
-		openP2PShellConnection' remote clientmaxversion >>= \case
-			Just conn@(P2P.IO.OpenConnection (remoterunst, remoteconn, _)) ->
-				return $ Just 
-					( remoterunst
-					, remoteconn
-					, void $ liftIO $ closeP2PShellConnection conn
-					)
-			_  -> return Nothing
+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
+		giveup "TODO"
+	withclientversion _ Nothing = p2pDone
 
-	protoerrhandler cont a = a >>= \case
-		-- Avoid displaying an error when the client hung up on us.
-		Left (ProtoFailureIOError e) | isEOFError e -> done
-		Left e -> giveup (describeProtoFailure e)
-		Right v -> cont v
-	
-	done = next $ return True
+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 
+				( remoterunst
+				, remoteconn
+				, void $ liftIO $ closeP2PShellConnection conn
+				)
+		_  -> return Nothing
+
+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 -> p2pDone
+	Left e -> giveup (describeProtoFailure e)
+	Right v -> cont v
+
+p2pDone :: CommandPerform
+p2pDone = next $ return True

Logs/Cluster.hs

@@ -8,14 +8,10 @@
 {-# LANGUAGE OverloadedStrings, TupleSections #-}
 
 module Logs.Cluster (
-	ClusterUUID,
-	isClusterUUID,
-	fromClusterUUID,
-	ClusterNodeUUID(..),
+	module Types.Cluster,
 	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 =
-	protoerrhandler cont $ client $ getClientProtocolVersion' remote
+getClientProtocolVersion remoteuuid (ClientSide clientrunst clientconn) cont protoerrhandler =
+	protoerrhandler cont $ client $ getClientProtocolVersion' remoteuuid
   where
 	client = liftIO . runNetProto clientrunst clientconn
 
 getClientProtocolVersion'
-	:: Remote
+	:: UUID
 	-> Proto (Maybe (ProtocolVersion, Maybe Message))
-getClientProtocolVersion' remote = do
-	net $ sendMessage (AUTH_SUCCESS (Remote.uuid remote))
+getClientProtocolVersion' remoteuuid = do
+	net $ sendMessage (AUTH_SUCCESS remoteuuid)
 	msg <- net receiveMessage
 	case msg of
 		Nothing -> return Nothing