From 11dae7ee45996dd76dff47e20dd51d7da49f0a43 Mon Sep 17 00:00:00 2001 From: joe Date: Fri, 1 Jun 2018 21:49:53 -0400 Subject: tox: Separate transports for handshakes and crypto-packets. --- src/Network/Tox.hs | 27 ++++++++++++++++++++++----- src/Network/Tox/Crypto/Transport.hs | 24 +++++++++++++++++++++--- src/Network/Tox/Transport.hs | 16 ++++++++++------ 3 files changed, 53 insertions(+), 14 deletions(-) diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index ce9939a9..6df239b5 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs @@ -240,6 +240,7 @@ data Tox = Tox , toxOnion :: Onion.Client RouteId , toxToRoute :: Transport String Onion.AnnouncedRendezvous (PublicKey,Onion.OnionData) , toxCrypto :: Transport String SockAddr NetCrypto + , toxHandshakes :: Transport String SockAddr NetCrypto , toxCryptoSessions :: NetCryptoSessions , toxCryptoKeys :: TransportCrypto , toxRouting :: DHT.Routing @@ -439,8 +440,22 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do mkrouting <- DHT.newRouting addr crypto updateIP updateIP let ignoreErrors _ = return () -- Set this to (hPutStrLn stderr) to debug onion route building. orouter <- newOnionRouter ignoreErrors - (dhtcrypt,onioncrypt,dtacrypt,cryptonet) <- toxTransport crypto orouter lookupClose udp - let sessionsState = sessionsState0 { sessionTransport = cryptonet + (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes) <- toxTransport crypto orouter lookupClose udp + + -- TODO: Avoid adapting these transports here. + let nc_cryptonet = layerTransport (\x addr -> Right (NetCrypto x,addr)) + (\(NetCrypto x) addr -> (x,addr)) + cryptonet + nc_handshakes = layerTransport (\x addr -> Right (NetHandshake x,addr)) + (\(NetHandshake x) addr -> (x,addr)) + handshakes + nc_combo = nc_handshakes + { sendMessage = \addr -> \case + NetCrypto x -> sendMessage cryptonet addr x + NetHandshake x -> sendMessage handshakes addr x + } + + let sessionsState = sessionsState0 { sessionTransport = nc_combo , transportCrypto = crypto } let dhtnet0 = layerTransportM (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt tbl4 = DHT.routing4 $ mkrouting (error "missing client") @@ -465,7 +480,8 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do { toxDHT = dhtclient , toxOnion = onionclient , toxToRoute = onInbound (updateContactInfo roster) dtacrypt - , toxCrypto = addHandler (hPutStrLn stderr) (cryptoNetHandler sessionsState) cryptonet + , toxCrypto = addHandler (hPutStrLn stderr) (cryptoNetHandler sessionsState) nc_cryptonet + , toxHandshakes = addHandler (hPutStrLn stderr) (cryptoNetHandler sessionsState) nc_handshakes , toxCryptoSessions = sessionsState , toxCryptoKeys = crypto , toxRouting = mkrouting dhtclient @@ -481,10 +497,11 @@ onionTimeout Tox { toxOnionRoutes = or } (DHT.TransactionId n8 _) od = lookupTim forkTox :: Tox -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ()) forkTox tox = do - _ <- forkListener "toxCrypto" (toxCrypto tox) + _ <- forkListener "toxHandshakes" (toxHandshakes tox) _ <- forkListener "toxToRoute" (toxToRoute tox) _ <- forkListener "toxOnion" (clientNet $ toxOnion tox) - quit <- forkListener "toxDHT" (clientNet $ toxDHT tox) + _ <- forkListener "toxDHT" (clientNet $ toxDHT tox) + quit <- forkListener "toxCrypto" (toxCrypto tox) forkPollForRefresh (DHT.refresher4 $ toxRouting tox) forkPollForRefresh (DHT.refresher6 $ toxRouting tox) return ( quit diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs index 1444ffca..2c998006 100644 --- a/src/Network/Tox/Crypto/Transport.hs +++ b/src/Network/Tox/Crypto/Transport.hs @@ -5,9 +5,10 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} module Network.Tox.Crypto.Transport - ( parseNetCrypto - , encodeNetCrypto - -- CryptoTransport + ( parseCrypto + , encodeCrypto + , parseHandshakes + , encodeHandshakes , NetCrypto(..) , CryptoData(..) , CryptoMessage(..) @@ -80,6 +81,23 @@ data NetCrypto = NetHandshake (Handshake Encrypted) | NetCrypto (CryptoPacket Encrypted) +parseCrypto :: (ByteString, SockAddr) -> Either (CryptoPacket Encrypted, SockAddr) (ByteString, SockAddr) +parseCrypto ((B.uncons -> Just (0x1b,pkt)),saddr) = either (\_ -> Right (pkt,saddr)) + (\x -> Left (x ,saddr)) + $ runGet get pkt +parseCrypto not_mine = Right not_mine + +encodeCrypto :: (CryptoPacket Encrypted, SockAddr) -> Maybe (ByteString, SockAddr) +encodeCrypto (x,saddr) = Just (B.cons 0x1b (runPut $ put x),saddr) + +parseHandshakes :: ByteString -> SockAddr -> Either String (Handshake Encrypted, SockAddr) +parseHandshakes (B.uncons -> Just (0x1a,pkt)) saddr = left ("parseNetCrypto: "++) $ (,saddr) <$> runGet get pkt +parseHandshakes _ _ = Left "parseHandshakes_: ?" + +encodeHandshakes :: Handshake Encrypted -> SockAddr -> (ByteString, SockAddr) +encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr) + + parseNetCrypto :: ByteString -> SockAddr -> Either String (NetCrypto, SockAddr) parseNetCrypto (B.uncons -> Just (0x1a,pkt)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetHandshake <$> runGet get pkt parseNetCrypto (B.uncons -> Just (0x1b,pkt)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetCrypto <$> runGet get pkt diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs index 30df93c8..57f07aad 100644 --- a/src/Network/Tox/Transport.hs +++ b/src/Network/Tox/Transport.hs @@ -8,6 +8,7 @@ {-# LANGUAGE TypeOperators #-} module Network.Tox.Transport (toxTransport, RouteId) where +import Data.ByteString (ByteString) import Network.QueryResponse import Crypto.Tox import Network.Tox.DHT.Transport @@ -22,21 +23,24 @@ toxTransport :: -> OnionRouter -> (PublicKey -> IO (Maybe NodeInfo)) -> UDPTransport - -> IO ( Transport String NodeInfo (DHTMessage Encrypted8) + -> IO ( Transport String SockAddr (CryptoPacket Encrypted) + , Transport String NodeInfo (DHTMessage Encrypted8) , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) , Transport String AnnouncedRendezvous (PublicKey,OnionData) - , Transport String SockAddr NetCrypto ) + , Transport String SockAddr (Handshake Encrypted)) toxTransport crypto orouter closeLookup udp = do - (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr) $ forwardOnions crypto udp + (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp + (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr) $ forwardOnions crypto udp0 (onion1,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter) (encodeOnionAddr crypto $ lookupRoute orouter) udp1 (dta,onion) <- partitionTransportM (parseDataToRoute crypto) (encodeDataToRoute crypto) onion1 - let netcrypto = layerTransport parseNetCrypto encodeNetCrypto udp2 - return ( forwardDHTRequests crypto closeLookup dht + let handshakes = layerTransport parseHandshakes encodeHandshakes udp2 + return ( netcrypto + , forwardDHTRequests crypto closeLookup dht , onion , dta - , netcrypto + , handshakes ) -- cgit v1.2.3