initial, working support for getting from clusters

Currently tends to put all the load on a single node, which will need to
be improved.

Annex/Cluster.hs

@@ -15,6 +15,7 @@ import Logs.Cluster
 import P2P.Proxy
 import P2P.Protocol
 import P2P.IO
+import Annex.Proxy
 import Logs.Location
 import Types.Command
 import Remote.List
@@ -46,22 +47,31 @@ proxyCluster clusteruuid proxydone servermode clientside protoerrhandler = do
 		-- determine. Instead, pick the newest protocol version
 		-- that we and the client both speak.
 		let protocolversion = min maxProtocolVersion clientmaxversion
-		selectnode <- clusterProxySelector clusteruuid
+		selectnode <- clusterProxySelector clusteruuid protocolversion
 		proxy proxydone proxymethods servermode clientside selectnode
 			protocolversion othermsg protoerrhandler
 	withclientversion Nothing = proxydone
 
-clusterProxySelector :: ClusterUUID -> Annex ProxySelector
-clusterProxySelector clusteruuid = do
+clusterProxySelector :: ClusterUUID -> ProtocolVersion -> Annex ProxySelector
+clusterProxySelector clusteruuid protocolversion = do
 	nodes <- (fromMaybe S.empty . M.lookup clusteruuid . clusterUUIDs)
 		<$> getClusters
 	remotes <- filter (flip S.member nodes . ClusterNodeUUID . Remote.uuid)
 		<$> remoteList
+	remotesides <- mapM (proxySshRemoteSide protocolversion) remotes
 	return $ ProxySelector
 		{ proxyCHECKPRESENT = \k -> error "TODO"
-		, proxyLOCKCONTENT = \k -> error "TODO"
-		, proxyUNLOCKCONTENT = error "TODO"
-		, proxyREMOVE = \k -> error "TODO"
-		, proxyGET = \k -> error "TODO"
+		, proxyGET = \k -> do
+			locs <- S.fromList <$> loggedLocations k
+			case filter (flip S.member locs . remoteUUID) remotesides of
+				-- TODO: Avoid always using same remote
+				(r:_) -> return (Just r)
+				[] -> return Nothing
 		, proxyPUT = \k -> error "TODO"
+		, proxyREMOVE = \k -> error "TODO"
+		-- Content is not locked on the cluster as a whole,
+		-- instead it can be locked on individual nodes that are
+		-- proxied to the client.
+		, proxyLOCKCONTENT = const (pure Nothing)
+		, proxyUNLOCKCONTENT = pure Nothing
 		}

P2P/Proxy.hs

@@ -55,20 +55,20 @@ closeRemoteSide remoteside =
  - -}
 data ProxySelector = ProxySelector
 	{ proxyCHECKPRESENT :: Key -> Annex RemoteSide
-	, proxyLOCKCONTENT :: Key -> Annex RemoteSide
-	, proxyUNLOCKCONTENT :: Annex RemoteSide
+	, proxyLOCKCONTENT :: Key -> Annex (Maybe RemoteSide)
+	, proxyUNLOCKCONTENT :: Annex (Maybe RemoteSide)
 	, proxyREMOVE :: Key -> Annex RemoteSide
-	, proxyGET :: Key -> Annex RemoteSide
+	, proxyGET :: Key -> Annex (Maybe RemoteSide)
 	, proxyPUT :: Key -> Annex RemoteSide
 	}
 
 singleProxySelector :: RemoteSide -> ProxySelector
 singleProxySelector r = ProxySelector
 	{ proxyCHECKPRESENT = const (pure r)
-	, proxyLOCKCONTENT = const (pure r)
-	, proxyUNLOCKCONTENT = pure r
+	, proxyLOCKCONTENT = const (pure (Just r))
+	, proxyUNLOCKCONTENT = pure (Just r)
 	, proxyREMOVE = const (pure r)
-	, proxyGET = const (pure r)
+	, proxyGET = const (pure (Just r))
 	, proxyPUT = const (pure r)
 	}
 
@@ -163,19 +163,28 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) prox
 		CHECKPRESENT k -> do
 			remoteside <- proxyCHECKPRESENT proxyselector k
 			proxyresponse remoteside message (const proxynextclientmessage)
-		LOCKCONTENT k -> do
-			remoteside <- proxyLOCKCONTENT proxyselector k
-			proxyresponse remoteside message (const proxynextclientmessage)
-		UNLOCKCONTENT -> do
-			remoteside <- proxyUNLOCKCONTENT proxyselector
-			proxynoresponse remoteside message proxynextclientmessage
+		LOCKCONTENT k -> proxyLOCKCONTENT proxyselector k >>= \case
+			Just remoteside -> 
+				proxyresponse remoteside message 
+					(const proxynextclientmessage)
+			Nothing ->
+				protoerrhandler proxynextclientmessage $
+					client $ net $ sendMessage FAILURE
+		UNLOCKCONTENT -> proxyUNLOCKCONTENT proxyselector >>= \case
+			Just remoteside ->
+				proxynoresponse remoteside message
+					proxynextclientmessage
+			Nothing -> proxynextclientmessage ()
 		REMOVE k -> do
 			remoteside <- proxyREMOVE proxyselector k
 			servermodechecker checkREMOVEServerMode $
 				handleREMOVE remoteside k message
-		GET _ _ k -> do
-			remoteside <- proxyGET proxyselector k
-			handleGET remoteside message
+		GET _ _ k -> proxyGET proxyselector k >>= \case
+			Just remoteside -> handleGET remoteside message
+			Nothing -> 
+				protoerrhandler proxynextclientmessage $
+					client $ net $ sendMessage $ 
+						ERROR "content not present"
 		PUT _ k -> do
 			remoteside <- proxyPUT proxyselector k
 			servermodechecker checkPUTServerMode $

doc/todo/git-annex_proxies.mdwn

@@ -57,6 +57,11 @@ For June's work on [[design/passthrough_proxy]], implementation plan:
 * Getting a key from a cluster should proxy from one of the nodes that has
   it, or from the proxy repository itself if it has the key.
 
+* Getting a key from a cluster currently always selects the lowest cost
+  remote, and always the same remote if cost is the same. Should
+  round-robin amoung remotes, and prefer to avoid using remotes that
+  other git-annex processes are currently using.
+
 * Implement upload with fanout and reporting back additional UUIDs over P2P
   protocol.