refactor

4 files changed, 109 insertions, 100 deletions

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 <id@joeyh.name>
+ -
+ - 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