diff options
author | Joe Crayne <joe@jerkface.net> | 2020-01-11 21:22:03 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-11 21:22:03 -0500 |
commit | ddf30becc00ee476ec0044e1e5c7257d5e741a20 (patch) | |
tree | 0cf685cf031401f44724d421d67055fa0dacfb62 /dht/src | |
parent | f8ef399a959eaacf14c09e5bd0794de934f397eb (diff) |
Fix for tcp-bound DHTKey message (I think).
Diffstat (limited to 'dht/src')
-rw-r--r-- | dht/src/Data/Tox/DHT/Multi.hs | 27 | ||||
-rw-r--r-- | dht/src/Network/Tox.hs | 41 | ||||
-rw-r--r-- | dht/src/Network/Tox/Transport.hs | 5 |
3 files changed, 21 insertions, 52 deletions
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) | |||
11 | import qualified Network.Tox.NodeId as UDP | 11 | import qualified Network.Tox.NodeId as UDP |
12 | ;import Network.Tox.NodeId (NodeId) | 12 | ;import Network.Tox.NodeId (NodeId) |
13 | import qualified Network.Tox.TCP.NodeId as TCP | 13 | import qualified Network.Tox.TCP.NodeId as TCP |
14 | import Data.Tox.Onion (OnionDestination,RouteId,AnnouncedRendezvous) | 14 | import Data.Tox.Onion (OnionDestination,RouteId) |
15 | import Data.Tox.Relay hiding (NodeInfo) | 15 | import Data.Tox.Relay hiding (NodeInfo) |
16 | import Network.Address (either4or6) | 16 | import Network.Address (either4or6) |
17 | import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_) | 17 | import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_) |
@@ -95,28 +95,10 @@ type NodeInfo = DSum T Identity | |||
95 | type SessionAddress = DSum S Identity | 95 | type SessionAddress = DSum S Identity |
96 | type OnionAddress = DSum O Identity | 96 | type OnionAddress = DSum O Identity |
97 | 97 | ||
98 | data R addr where | ||
99 | RendezvousUDP :: R AnnouncedRendezvous | ||
100 | RendezvousTCP :: R AnnouncedRendezvous | ||
101 | |||
102 | instance GEq R where | ||
103 | geq RendezvousUDP RendezvousUDP = Just Refl | ||
104 | geq RendezvousTCP RendezvousTCP = Just Refl | ||
105 | geq _ _ = Nothing | ||
106 | instance GCompare R where | ||
107 | gcompare RendezvousUDP RendezvousUDP = GEQ | ||
108 | gcompare RendezvousUDP RendezvousTCP = GLT | ||
109 | gcompare RendezvousTCP RendezvousTCP = GEQ | ||
110 | gcompare RendezvousTCP RendezvousUDP = GGT | ||
111 | instance GShow R where | ||
112 | gshowsPrec _ RendezvousUDP = showString "UDP" | ||
113 | gshowsPrec _ RendezvousTCP = showString "TCP" | ||
114 | |||
115 | #if MIN_VERSION_dependent_sum(0,6,0) | 98 | #if MIN_VERSION_dependent_sum(0,6,0) |
116 | deriveArgDict ''T | 99 | deriveArgDict ''T |
117 | deriveArgDict ''S | 100 | deriveArgDict ''S |
118 | deriveArgDict ''O | 101 | deriveArgDict ''O |
119 | deriveArgDict ''R | ||
120 | #else | 102 | #else |
121 | instance ShowTag T Identity where | 103 | instance ShowTag T Identity where |
122 | showTaggedPrec UDP = showsPrec | 104 | showTaggedPrec UDP = showsPrec |
@@ -133,15 +115,8 @@ instance EqTag S Identity where | |||
133 | instance OrdTag S Identity where | 115 | instance OrdTag S Identity where |
134 | compareTagged SessionUDP SessionUDP = compare | 116 | compareTagged SessionUDP SessionUDP = compare |
135 | compareTagged SessionTCP SessionTCP = compare | 117 | compareTagged SessionTCP SessionTCP = compare |
136 | instance ShowTag R Identity where | ||
137 | showTaggedPrec RendezvousUDP = showsPrec | ||
138 | showTaggedPrec RendezvousTCP = showsPrec | ||
139 | #endif | 118 | #endif |
140 | 119 | ||
141 | untagRendezvous :: DSum R Identity -> AnnouncedRendezvous | ||
142 | untagRendezvous (RendezvousUDP :=> Identity o) = o | ||
143 | untagRendezvous (RendezvousTCP :=> Identity o) = o | ||
144 | |||
145 | 120 | ||
146 | nodeInfo :: NodeId -> DSum S Identity -> Either String (DSum T Identity) | 121 | nodeInfo :: NodeId -> DSum S Identity -> Either String (DSum T Identity) |
147 | nodeInfo nid (SessionUDP :=> Identity saddr) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr | 122 | 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 | |||
315 | let lookupClose _ = return Nothing | 315 | let lookupClose _ = return Nothing |
316 | 316 | ||
317 | mkrouting <- DHT.newRouting addr crypto updateIP updateIP | 317 | mkrouting <- DHT.newRouting addr crypto updateIP updateIP |
318 | (orouter,relaynet,onioncryptTCP0) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp) | 318 | (orouter,relaynet,onioncryptTCP) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp) |
319 | (dtacryptTCP,onioncryptTCP) <- partitionTransportM (Onion.parseDataToRoute crypto) (Onion.encodeDataToRoute crypto) onioncryptTCP0 | 319 | (cryptonet,dhtcrypt,onioncryptUDP,handshakes) |
320 | (cryptonet,dhtcrypt,onioncryptUDP,dtacryptUDP,handshakes) | ||
321 | <- toxTransport crypto orouter lookupClose addr udp relaynet | 320 | <- toxTransport crypto orouter lookupClose addr udp relaynet |
322 | (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x)) | 321 | (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x)) |
323 | (fromMaybe (\_ _ -> return ()) tcp) | 322 | (fromMaybe (\_ _ -> return ()) tcp) |
@@ -356,31 +355,29 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do | |||
356 | nil <- nullSessionTokens | 355 | nil <- nullSessionTokens |
357 | atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids. | 356 | atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids. |
358 | 357 | ||
359 | onioncrypt <- mergeTransports $ DMap.fromList | 358 | onioncrypt <- |
360 | [ Multi.OnionUDP :=> ByAddress onioncryptUDP | 359 | layerTransportM (\msg addr -> return $ Right (msg,Multi.untagOnion addr)) |
361 | , Multi.OnionTCP :=> ByAddress {- $ onInbound updateOnTCP -} onioncryptTCP ] | 360 | (\msg addr -> do |
362 | dtacrypt0 <- mergeTransports $ DMap.fromList | ||
363 | [ Multi.RendezvousUDP :=> ByAddress dtacryptUDP | ||
364 | , Multi.RendezvousTCP :=> ByAddress dtacryptTCP | ||
365 | ] | ||
366 | oniondrg <- drgNew | ||
367 | let onionnet = layerTransportM | ||
368 | (\msg od -> Onion.decrypt crypto msg $ Multi.untagOnion od) | ||
369 | (\msg od -> do | ||
370 | (msg', od') <- Onion.encrypt crypto msg od | ||
371 | -- TODO: lookupRoute is unnecessarily done twice | 361 | -- TODO: lookupRoute is unnecessarily done twice |
372 | -- because that was convenient for me. The other | 362 | -- because that was convenient for me. The other |
373 | -- call was done when building the transport. | 363 | -- call was done when building the onioncryptUDP |
364 | -- transport. | ||
374 | -- Consider simplifying this. | 365 | -- Consider simplifying this. |
375 | mtcp <- case od' of | 366 | mtcp <- case addr of |
376 | Onion.OnionDestination _ ni (Just rid) | 367 | Onion.OnionDestination _ ni (Just rid) |
377 | -> (>>= Onion.routeRelayPort) <$> lookupRoute orouter' ni rid | 368 | -> (>>= Onion.routeRelayPort) <$> lookupRoute orouter' ni rid |
378 | _ -> return Nothing | 369 | _ -> return Nothing |
379 | return (msg', maybe (Multi.OnionUDP ==> od') (const $ Multi.OnionTCP ==> od') mtcp)) | 370 | return (msg, maybe (Multi.OnionUDP ==> addr) (const $ Multi.OnionTCP ==> addr) mtcp)) |
380 | onioncrypt | 371 | <$> mergeTransports (DMap.fromList |
381 | dtacrypt = layerTransport (\msg addr -> Right (msg,Multi.untagRendezvous addr)) | 372 | [ Multi.OnionUDP :=> ByAddress onioncryptUDP |
382 | (\msg addr -> (msg, Multi.RendezvousUDP ==> addr)) | 373 | , Multi.OnionTCP :=> ByAddress {- $ onInbound updateOnTCP -} onioncryptTCP ]) |
383 | dtacrypt0 | 374 | |
375 | -- dtacrypt :: Transport String AnnouncedRendezvous (PublicKey,OnionData) | ||
376 | (dtacrypt,onioncrypt) <- partitionTransportM (Onion.parseDataToRoute crypto) (Onion.encodeDataToRoute crypto) onioncrypt | ||
377 | oniondrg <- drgNew | ||
378 | let onionnet = layerTransportM (\msg od -> Onion.decrypt crypto msg od) | ||
379 | (\msg od -> Onion.encrypt crypto msg od) | ||
380 | onioncrypt | ||
384 | onionclient <- newClient oniondrg onionnet (const Onion.classify) | 381 | onionclient <- newClient oniondrg onionnet (const Onion.classify) |
385 | (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 $ mkrouting dhtclient)) | 382 | (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 $ mkrouting dhtclient)) |
386 | (const $ Onion.handlers onionnet (mkrouting dhtclient) toks keydb) | 383 | (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 :: | |||
43 | -> IO ( Transport String Multi.SessionAddress (CryptoPacket Encrypted) | 43 | -> IO ( Transport String Multi.SessionAddress (CryptoPacket Encrypted) |
44 | , Transport String Multi.NodeInfo (DHTMessage Encrypted8) | 44 | , Transport String Multi.NodeInfo (DHTMessage Encrypted8) |
45 | , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) | 45 | , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) |
46 | , Transport String AnnouncedRendezvous (PublicKey,OnionData) | ||
47 | , Transport String Multi.SessionAddress (Handshake Encrypted)) | 46 | , Transport String Multi.SessionAddress (Handshake Encrypted)) |
48 | toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do | 47 | toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do |
49 | (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp | 48 | (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp |
@@ -61,11 +60,10 @@ toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do | |||
61 | [ Multi.UDP :=> ByAddress dhtUDP | 60 | [ Multi.UDP :=> ByAddress dhtUDP |
62 | , Multi.TCP :=> ByAddress dhtTCP | 61 | , Multi.TCP :=> ByAddress dhtTCP |
63 | ] | 62 | ] |
64 | (onion1,udp2) <- partitionTransportM | 63 | (onion,udp2) <- partitionTransportM |
65 | (parseOnionAddr $ lookupSender orouter) | 64 | (parseOnionAddr $ lookupSender orouter) |
66 | (encodeOnionAddr crypto $ lookupRoute orouter) | 65 | (encodeOnionAddr crypto $ lookupRoute orouter) |
67 | udp1 | 66 | udp1 |
68 | (dta,onion) <- partitionTransportM (parseDataToRoute crypto) (encodeDataToRoute crypto) onion1 | ||
69 | multi_netcrypto <- mergeTransports $ DMap.fromList | 67 | multi_netcrypto <- mergeTransports $ DMap.fromList |
70 | [ Multi.SessionUDP :=> ByAddress netcrypto | 68 | [ Multi.SessionUDP :=> ByAddress netcrypto |
71 | , Multi.SessionTCP :=> ByAddress netcryptoTCP ] | 69 | , Multi.SessionTCP :=> ByAddress netcryptoTCP ] |
@@ -77,7 +75,6 @@ toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do | |||
77 | return ( multi_netcrypto | 75 | return ( multi_netcrypto |
78 | , forwardDHTRequests crypto (fmap (fmap (Multi.UDP ==>)) . closeLookup) dht | 76 | , forwardDHTRequests crypto (fmap (fmap (Multi.UDP ==>)) . closeLookup) dht |
79 | , onion | 77 | , onion |
80 | , dta | ||
81 | , multi_handshakes | 78 | , multi_handshakes |
82 | ) | 79 | ) |
83 | 80 | ||