diff options
Diffstat (limited to 'HTTP/Client.hs')
-rw-r--r-- | HTTP/Client.hs | 116 |
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 "" |