From 3923667ebdb24680dbb415bd688a8c0326df2212 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 22 Sep 2016 10:40:06 -0400
Subject: allow servers to have multiple or no addresses

This allows the server list to contain 3 servers although only 1 is running
so far; uploads to the others will be queued.

It also allows a server to be spread amoung multiple addresses, which may
be useful later for scaling.

This changes BackupRecord serialization, but it's not been in a keysafe
release yet, so that's not a problem.

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.
---
 HTTP/Client.hs | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

(limited to 'HTTP')

diff --git a/HTTP/Client.hs b/HTTP/Client.hs
index 48a430c..f13620e 100644
--- a/HTTP/Client.hs
+++ b/HTTP/Client.hs
@@ -64,23 +64,25 @@ serverRequest srv onerr onsuccess p a = do
 					(Just $ genProofOfWork req p)
 					(Seconds timeleft - generationTime req)
 
+-- A new Manager is allocated for each request, rather than reusing
+-- any connection. This is a feature; it makes correlation attacks
+-- harder because the server can't tell if two connections
+-- accessing different objects came from the same user, except by
+-- comparing IP addresses (which are masked somewhat by using tor).
 serverRequest'
 	:: Server
 	-> (Manager -> BaseUrl -> ExceptT ServantError IO r)
 	-> IO (Either String r)
-serverRequest' srv a = do
-	-- A new Manager is allocated for each request, rather than reusing
-	-- any connection. This is a feature; it makes correlation attacks
-	-- harder because the server can't tell if two connections
-	-- accessing different objects came from the same user, except by
-	-- comparing IP addresses (which are masked somewhat by using tor).
-	manager <- torableManager
-	res <- runExceptT $ a manager url
-	return $ case res of
-		Left err -> Left $ "server failure: " ++ show err
-		Right r -> Right r
+serverRequest' srv a = go Nothing (serverUrls srv)
   where
-	url = serverUrl srv
+	go lasterr [] = return $ Left $
+		maybe "no available servers" (\err -> "server failure: " ++ show err) lasterr
+	go _ (url:urls) = do
+		manager <- torableManager
+		res <- runExceptT $ a manager url
+		case res of
+			Left err -> go (Just err) urls
+			Right r -> return (Right r)
 
 -- | HTTP Manager supporting tor .onion and regular hosts
 torableManager :: IO Manager
@@ -94,7 +96,7 @@ torableManager = newManager $ defaultManagerSettings
 			regular <- managerRawConnection defaultManagerSettings
 			regular addr host port
 
-torConnection :: HostName -> Port -> IO Connection
+torConnection :: String -> Port -> IO Connection
 torConnection onionaddress p = do
 	(socket, _) <- socksConnect torsockconf socksaddr
 	socketConnection socket 8192
-- 
cgit v1.2.3