diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-08-29 18:46:48 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-08-29 18:47:22 -0400 |
commit | 6eab061c26ba8652063eaab6a04d710a8cf6be90 (patch) | |
tree | f3aade6828bdf2b04e86173c7caf94f3aec1d408 | |
parent | cf872ac1cc8f52de5da5035b6bf04bd8d5b37d22 (diff) | |
download | keysafe-6eab061c26ba8652063eaab6a04d710a8cf6be90.tar.gz |
support .onion addresses for servers
-rw-r--r-- | Storage/Network.hs | 51 | ||||
-rw-r--r-- | keysafe.cabal | 8 |
2 files changed, 51 insertions, 8 deletions
diff --git a/Storage/Network.hs b/Storage/Network.hs index 96aa1c0..c124761 100644 --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -5,19 +5,33 @@ {-# LANGUAGE OverloadedStrings #-} -module Storage.Network (Server(..), networkServers, networkStorage) where +module Storage.Network ( + Server(..), + networkServers, + networkStorage, + torableManager +) where import Types import Types.Storage +import Data.List +import Data.Char import HTTP import HTTP.Client import Servant.Client import Network.Wai.Handler.Warp (Port) -import Network.HTTP.Client (Manager, newManager, defaultManagerSettings) +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 :: String + { serverName :: HostName , serverPort :: Port } @@ -68,8 +82,7 @@ serverRequest -> (r -> a) -> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (ProofOfWorkRequirement r)) -> IO a -serverRequest srv onerr onsuccess a = - go Nothing =<< newManager defaultManagerSettings +serverRequest srv onerr onsuccess a = go Nothing =<< newManager torableManager where url = serverUrl srv go pow manager = do @@ -79,3 +92,31 @@ serverRequest srv onerr onsuccess a = "server failure: " ++ show err Right (Result r) -> return $ onsuccess r Right needpow -> error "NEEDPOW" -- loop with pow + +-- | HTTP Manager supporting tor .onion and regular hosts +torableManager :: ManagerSettings +torableManager = 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 47a7dcd..8648437 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -45,15 +45,17 @@ Executable keysafe , optparse-applicative == 0.12.* , readline == 1.0.* , zxcvbn-c == 1.0.* - , servant (>= 0.7 && < 0.8) - , servant-server (>= 0.7 && < 0.8) - , servant-client (>= 0.7 && < 0.8) + , servant == 0.7.* + , servant-server == 0.7.* + , servant-client == 0.7.* , aeson == 0.11.* , wai == 3.2.* , warp == 3.2.* , http-client == 0.4.* , transformers == 0.4.* , stm == 2.4.* + , socks == 0.5.* + , network == 2.6.* -- Temporarily inlined due to https://github.com/ocharles/argon2/issues/3 -- argon2 == 1.1.* Extra-Libraries: argon2 |