From 3de39735765344b3728f5649e47d27b69f9094f4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 12 Sep 2016 23:09:37 -0400
Subject: refactor

---
 HTTP/Client.hs | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 79 insertions(+), 1 deletion(-)

(limited to 'HTTP')

diff --git a/HTTP/Client.hs b/HTTP/Client.hs
index 74381be..19cfe9b 100644
--- a/HTTP/Client.hs
+++ b/HTTP/Client.hs
@@ -7,12 +7,23 @@ module HTTP.Client where
 
 import HTTP
 import HTTP.ProofOfWork
+import Servers
 import Types
 import Types.Storage
+import Types.Cost
 import Servant.API
 import Servant.Client
 import Data.Proxy
-import Network.HTTP.Client (Manager)
+import Network.Wai.Handler.Warp (Port)
+import Network.HTTP.Client hiding (port, host, Proxy)
+import Network.HTTP.Client.Internal (Connection, makeConnection)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
+import qualified Network.Socket
+import Network.Socket.ByteString (sendAll, recv)
+import Network.Socks5
+import qualified Data.ByteString.UTF8 as BU8
+import Data.List
+import Data.Char
 
 httpAPI :: Proxy HttpAPI
 httpAPI = Proxy
@@ -22,3 +33,70 @@ getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Manager -> BaseUrl -> C
 putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Manager -> BaseUrl -> ClientM (POWGuarded StoreResult)
 countObjects :: Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (POWGuarded CountResult)
 motd :<|> getObject :<|> putObject :<|> countObjects = client httpAPI
+
+serverRequest
+	:: POWIdent p
+	=> Server
+	-> (String -> a)
+	-> (r -> a)
+	-> p
+	-> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (POWGuarded r))
+	-> IO a
+serverRequest srv onerr onsuccess p a = go Nothing maxProofOfWork
+  where
+	go pow (Seconds timeleft)
+		| timeleft <= 0 = return $ onerr "server asked for too much proof of work; gave up"
+		| otherwise = do
+			res <- serverRequest' srv (a pow)
+			case res of
+				Left err -> return $ onerr err
+				Right (Result r) -> return $ onsuccess r
+				Right (NeedProofOfWork req) -> go
+					(Just $ genProofOfWork req p)
+					(Seconds timeleft - generationTime req)
+
+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
+  where
+	url = serverUrl srv
+
+-- | HTTP Manager supporting tor .onion and regular hosts
+torableManager :: IO Manager
+torableManager = newManager $ defaultManagerSettings
+	{ managerRawConnection = return conn
+	}
+  where
+	conn addr host port
+		| ".onion" `isSuffixOf` map toLower host = torConnection host port
+		| otherwise = do
+			regular <- managerRawConnection defaultManagerSettings
+			regular addr host port
+
+torConnection :: HostName -> Port -> IO Connection
+torConnection onionaddress p = do
+	(socket, _) <- socksConnect torsockconf socksaddr
+	socketConnection socket 8192
+  where
+	torsocksport = 9050
+	torsockconf = defaultSocksConf "127.0.0.1" torsocksport
+	socksdomain = SocksAddrDomainName (BU8.fromString onionaddress)
+	socksaddr = SocksAddress socksdomain (fromIntegral p)
+
+socketConnection :: Network.Socket.Socket -> Int -> IO Connection
+socketConnection socket chunksize = makeConnection
+	(recv socket chunksize)
+	(sendAll socket)
+	(Network.Socket.close socket)
-- 
cgit v1.2.3