From 3de39735765344b3728f5649e47d27b69f9094f4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 12 Sep 2016 23:09:37 -0400 Subject: refactor --- HTTP/Client.hs | 80 +++++++++++++++++++++++++++++++++++++++++- Servers.hs | 28 +++++++++++++++ Storage/Network.hs | 100 +---------------------------------------------------- keysafe.cabal | 1 + 4 files changed, 109 insertions(+), 100 deletions(-) create mode 100644 Servers.hs 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) diff --git a/Servers.hs b/Servers.hs new file mode 100644 index 0000000..ddc0d6e --- /dev/null +++ b/Servers.hs @@ -0,0 +1,28 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Servers where + +import Network.Wai.Handler.Warp (Port) +import Servant.Client + +type HostName = String + +data Server = Server + { serverName :: HostName + , serverPort :: Port + } + +serverUrl :: Server -> BaseUrl +serverUrl srv = BaseUrl Http (serverName srv) (serverPort srv) "" + +-- | These can be either tor .onion addresses, or regular hostnames. +-- Using tor is highly recommended, to avoid correlation attacks. +networkServers :: IO [Server] +networkServers = return + [ Server "vzgrspuxbtnlrtup.onion" 4242 -- keysafe.joeyh.name + , Server "localhost" 4242 + , Server "localhost" 4242 + ] diff --git a/Storage/Network.hs b/Storage/Network.hs index 9739f2f..b6b778a 100644 --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -14,40 +14,9 @@ module Storage.Network ( import Types import Types.Storage -import Types.Cost -import Data.List -import Data.Char -import HTTP +import Servers import HTTP.Client import HTTP.ProofOfWork -import Servant.Client -import Network.Wai.Handler.Warp (Port) -import Network.HTTP.Client hiding (port, host) -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 - -type HostName = String - -data Server = Server - { serverName :: HostName - , serverPort :: Port - } - -serverUrl :: Server -> BaseUrl -serverUrl srv = BaseUrl Http (serverName srv) (serverPort srv) "" - --- | These can be either tor .onion addresses, or regular hostnames. --- Using tor is highly recommended, to avoid correlation attacks. -networkServers :: IO [Server] -networkServers = return - [ Server "vzgrspuxbtnlrtup.onion" 4242 -- keysafe.joeyh.name - , Server "localhost" 4242 - , Server "localhost" 4242 - ] networkStorage :: Server -> Storage networkStorage server = Storage @@ -79,70 +48,3 @@ count srv = serverRequest srv CountFailure id NoPOWIdent countObjects -- | Not needed for servers. move :: Server -> Storage -> IO () move _ _ = error "move is not implemented for servers" - -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) diff --git a/keysafe.cabal b/keysafe.cabal index b13ee88..00bfd68 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -83,6 +83,7 @@ Executable keysafe HTTP.RateLimit SecretKey Serialization + Servers Share Storage Storage.Local -- cgit v1.2.3