1 files changed, 116 insertions, 0 deletions
diff --git a/HTTP/Client.hs b/HTTP/Client.hs
new file mode 100644
index 0000000..25ff536
--- /dev/null
+++ b/HTTP/Client.hs
@@ -0,0 +1,116 @@
+{- Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module HTTP.Client where
+
+import HTTP
+import HTTP.ProofOfWork
+import Types
+import Types.Server
+import Types.Storage
+import Types.Cost
+import Servant.API
+import Servant.Client
+import Data.Proxy
+import Network.HTTP.Client hiding (port, host, Proxy)
+import Network.HTTP.Client.Internal (Connection, makeConnection)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
+import Control.Exception
+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
+
+motd :: Manager -> BaseUrl -> ClientM Motd
+getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (POWGuarded StorableObject)
+putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Manager -> BaseUrl -> ClientM (POWGuarded StoreResult)
+countObjects :: Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (POWGuarded CountResult)
+motd :<|> getObject :<|> putObject :<|> countObjects = client httpAPI
+
+tryA :: IO a -> IO (Either SomeException a)
+tryA = try
+
+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 = do
+	r <- tryA $ go Nothing maxProofOfWork
+	case r of
+		Left e -> return $ onerr (show e)
+		Right v -> return v
+  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)
+
+-- 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 = go Nothing (serverUrls srv)
+  where
+	go lasterr [] = return $ Left $
+		maybe "no known address" (\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
+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 :: String -> 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)
+
+serverUrls :: Server -> [BaseUrl]
+serverUrls srv = map go (serverAddress srv)
+  where
+	go (ServerAddress addr port) = BaseUrl Http addr port ""