From ddf30becc00ee476ec0044e1e5c7257d5e741a20 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 11 Jan 2020 21:22:03 -0500 Subject: Fix for tcp-bound DHTKey message (I think). --- dht/src/Data/Tox/DHT/Multi.hs | 27 +------------------------- dht/src/Network/Tox.hs | 41 +++++++++++++++++++--------------------- dht/src/Network/Tox/Transport.hs | 5 +---- 3 files changed, 21 insertions(+), 52 deletions(-) (limited to 'dht') diff --git a/dht/src/Data/Tox/DHT/Multi.hs b/dht/src/Data/Tox/DHT/Multi.hs index 8d614262..acd645a3 100644 --- a/dht/src/Data/Tox/DHT/Multi.hs +++ b/dht/src/Data/Tox/DHT/Multi.hs @@ -11,7 +11,7 @@ import Crypto.PubKey.Curve25519 (PublicKey) import qualified Network.Tox.NodeId as UDP ;import Network.Tox.NodeId (NodeId) import qualified Network.Tox.TCP.NodeId as TCP -import Data.Tox.Onion (OnionDestination,RouteId,AnnouncedRendezvous) +import Data.Tox.Onion (OnionDestination,RouteId) import Data.Tox.Relay hiding (NodeInfo) import Network.Address (either4or6) import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_) @@ -95,28 +95,10 @@ type NodeInfo = DSum T Identity type SessionAddress = DSum S Identity type OnionAddress = DSum O Identity -data R addr where - RendezvousUDP :: R AnnouncedRendezvous - RendezvousTCP :: R AnnouncedRendezvous - -instance GEq R where - geq RendezvousUDP RendezvousUDP = Just Refl - geq RendezvousTCP RendezvousTCP = Just Refl - geq _ _ = Nothing -instance GCompare R where - gcompare RendezvousUDP RendezvousUDP = GEQ - gcompare RendezvousUDP RendezvousTCP = GLT - gcompare RendezvousTCP RendezvousTCP = GEQ - gcompare RendezvousTCP RendezvousUDP = GGT -instance GShow R where - gshowsPrec _ RendezvousUDP = showString "UDP" - gshowsPrec _ RendezvousTCP = showString "TCP" - #if MIN_VERSION_dependent_sum(0,6,0) deriveArgDict ''T deriveArgDict ''S deriveArgDict ''O -deriveArgDict ''R #else instance ShowTag T Identity where showTaggedPrec UDP = showsPrec @@ -133,15 +115,8 @@ instance EqTag S Identity where instance OrdTag S Identity where compareTagged SessionUDP SessionUDP = compare compareTagged SessionTCP SessionTCP = compare -instance ShowTag R Identity where - showTaggedPrec RendezvousUDP = showsPrec - showTaggedPrec RendezvousTCP = showsPrec #endif -untagRendezvous :: DSum R Identity -> AnnouncedRendezvous -untagRendezvous (RendezvousUDP :=> Identity o) = o -untagRendezvous (RendezvousTCP :=> Identity o) = o - nodeInfo :: NodeId -> DSum S Identity -> Either String (DSum T Identity) nodeInfo nid (SessionUDP :=> Identity saddr) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs index a7e5d2c2..f136ab96 100644 --- a/dht/src/Network/Tox.hs +++ b/dht/src/Network/Tox.hs @@ -315,9 +315,8 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do let lookupClose _ = return Nothing mkrouting <- DHT.newRouting addr crypto updateIP updateIP - (orouter,relaynet,onioncryptTCP0) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp) - (dtacryptTCP,onioncryptTCP) <- partitionTransportM (Onion.parseDataToRoute crypto) (Onion.encodeDataToRoute crypto) onioncryptTCP0 - (cryptonet,dhtcrypt,onioncryptUDP,dtacryptUDP,handshakes) + (orouter,relaynet,onioncryptTCP) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp) + (cryptonet,dhtcrypt,onioncryptUDP,handshakes) <- toxTransport crypto orouter lookupClose addr udp relaynet (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x)) (fromMaybe (\_ _ -> return ()) tcp) @@ -356,31 +355,29 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do nil <- nullSessionTokens atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids. - onioncrypt <- mergeTransports $ DMap.fromList - [ Multi.OnionUDP :=> ByAddress onioncryptUDP - , Multi.OnionTCP :=> ByAddress {- $ onInbound updateOnTCP -} onioncryptTCP ] - dtacrypt0 <- mergeTransports $ DMap.fromList - [ Multi.RendezvousUDP :=> ByAddress dtacryptUDP - , Multi.RendezvousTCP :=> ByAddress dtacryptTCP - ] - oniondrg <- drgNew - let onionnet = layerTransportM - (\msg od -> Onion.decrypt crypto msg $ Multi.untagOnion od) - (\msg od -> do - (msg', od') <- Onion.encrypt crypto msg od + onioncrypt <- + layerTransportM (\msg addr -> return $ Right (msg,Multi.untagOnion addr)) + (\msg addr -> do -- TODO: lookupRoute is unnecessarily done twice -- because that was convenient for me. The other - -- call was done when building the transport. + -- call was done when building the onioncryptUDP + -- transport. -- Consider simplifying this. - mtcp <- case od' of + mtcp <- case addr of Onion.OnionDestination _ ni (Just rid) -> (>>= Onion.routeRelayPort) <$> lookupRoute orouter' ni rid _ -> return Nothing - return (msg', maybe (Multi.OnionUDP ==> od') (const $ Multi.OnionTCP ==> od') mtcp)) - onioncrypt - dtacrypt = layerTransport (\msg addr -> Right (msg,Multi.untagRendezvous addr)) - (\msg addr -> (msg, Multi.RendezvousUDP ==> addr)) - dtacrypt0 + return (msg, maybe (Multi.OnionUDP ==> addr) (const $ Multi.OnionTCP ==> addr) mtcp)) + <$> mergeTransports (DMap.fromList + [ Multi.OnionUDP :=> ByAddress onioncryptUDP + , Multi.OnionTCP :=> ByAddress {- $ onInbound updateOnTCP -} onioncryptTCP ]) + + -- dtacrypt :: Transport String AnnouncedRendezvous (PublicKey,OnionData) + (dtacrypt,onioncrypt) <- partitionTransportM (Onion.parseDataToRoute crypto) (Onion.encodeDataToRoute crypto) onioncrypt + oniondrg <- drgNew + let onionnet = layerTransportM (\msg od -> Onion.decrypt crypto msg od) + (\msg od -> Onion.encrypt crypto msg od) + onioncrypt onionclient <- newClient oniondrg onionnet (const Onion.classify) (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 $ mkrouting dhtclient)) (const $ Onion.handlers onionnet (mkrouting dhtclient) toks keydb) diff --git a/dht/src/Network/Tox/Transport.hs b/dht/src/Network/Tox/Transport.hs index 55e31e2a..b017f7be 100644 --- a/dht/src/Network/Tox/Transport.hs +++ b/dht/src/Network/Tox/Transport.hs @@ -43,7 +43,6 @@ toxTransport :: -> IO ( Transport String Multi.SessionAddress (CryptoPacket Encrypted) , Transport String Multi.NodeInfo (DHTMessage Encrypted8) , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) - , Transport String AnnouncedRendezvous (PublicKey,OnionData) , Transport String Multi.SessionAddress (Handshake Encrypted)) toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp @@ -61,11 +60,10 @@ toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do [ Multi.UDP :=> ByAddress dhtUDP , Multi.TCP :=> ByAddress dhtTCP ] - (onion1,udp2) <- partitionTransportM + (onion,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter) (encodeOnionAddr crypto $ lookupRoute orouter) udp1 - (dta,onion) <- partitionTransportM (parseDataToRoute crypto) (encodeDataToRoute crypto) onion1 multi_netcrypto <- mergeTransports $ DMap.fromList [ Multi.SessionUDP :=> ByAddress netcrypto , Multi.SessionTCP :=> ByAddress netcryptoTCP ] @@ -77,7 +75,6 @@ toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do return ( multi_netcrypto , forwardDHTRequests crypto (fmap (fmap (Multi.UDP ==>)) . closeLookup) dht , onion - , dta , multi_handshakes ) -- cgit v1.2.3