summaryrefslogtreecommitdiff
path: root/dht/src
diff options
context:
space:
mode:
Diffstat (limited to 'dht/src')
-rw-r--r--dht/src/Data/Tox/DHT/Multi.hs45
-rw-r--r--dht/src/Data/Tox/Onion.hs19
-rw-r--r--dht/src/Network/Tox.hs66
-rw-r--r--dht/src/Network/Tox/Onion/Routes.hs33
-rw-r--r--dht/src/Network/Tox/Onion/Transport.hs53
-rw-r--r--dht/src/Network/Tox/TCP.hs60
6 files changed, 161 insertions, 115 deletions
diff --git a/dht/src/Data/Tox/DHT/Multi.hs b/dht/src/Data/Tox/DHT/Multi.hs
index f769e384..7c8804b5 100644
--- a/dht/src/Data/Tox/DHT/Multi.hs
+++ b/dht/src/Data/Tox/DHT/Multi.hs
@@ -11,6 +11,7 @@ import Crypto.PubKey.Curve25519 (PublicKey)
11import qualified Network.Tox.NodeId as UDP 11import qualified Network.Tox.NodeId as UDP
12 ;import Network.Tox.NodeId (NodeId) 12 ;import Network.Tox.NodeId (NodeId)
13import qualified Network.Tox.TCP.NodeId as TCP 13import qualified Network.Tox.TCP.NodeId as TCP
14import Data.Tox.Onion (OnionDestination,RouteId)
14import Data.Tox.Relay hiding (NodeInfo) 15import Data.Tox.Relay hiding (NodeInfo)
15import Network.Address (either4or6) 16import Network.Address (either4or6)
16import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_) 17import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_)
@@ -64,25 +65,40 @@ instance GShow S where
64 gshowsPrec _ SessionUDP = showString "UDP" 65 gshowsPrec _ SessionUDP = showString "UDP"
65 gshowsPrec _ SessionTCP = showString "TCP" 66 gshowsPrec _ SessionTCP = showString "TCP"
66 67
68data O addr where
69 OnionUDP :: O (OnionDestination RouteId)
70 OnionTCP :: O (OnionDestination RouteId)
71
72instance GEq O where
73 geq OnionUDP OnionUDP = Just Refl
74 geq OnionTCP OnionTCP = Just Refl
75 geq _ _ = Nothing
76instance GCompare O where
77 gcompare OnionUDP OnionUDP = GEQ
78 gcompare OnionUDP OnionTCP = GLT
79 gcompare OnionTCP OnionTCP = GEQ
80 gcompare OnionTCP OnionUDP = GGT
81instance GShow O where
82 gshowsPrec _ OnionUDP = showString "UDP"
83 gshowsPrec _ OnionTCP = showString "TCP"
84
85untagOnion :: DSum O Identity -> OnionDestination RouteId
86untagOnion (OnionUDP :=> Identity o) = o
87untagOnion (OnionTCP :=> Identity o) = o
88
67-- Canonical in case of 6-mapped-4 addresses. 89-- Canonical in case of 6-mapped-4 addresses.
68canonize :: DSum S Identity -> DSum S Identity 90canonize :: DSum S Identity -> DSum S Identity
69canonize (SessionUDP :=> Identity saddr) = SessionUDP ==> either id id (either4or6 saddr) 91canonize (SessionUDP :=> Identity saddr) = SessionUDP ==> either id id (either4or6 saddr)
70canonize taddr = taddr 92canonize taddr = taddr
71 93
72data A addr where
73 AddrUDP :: SockAddr -> A UDP.NodeInfo
74 AddrTCP :: Maybe ConId -> TCP.NodeInfo -> A TCP.ViaRelay
75
76deriving instance Eq (A addr)
77
78type NodeInfo = DSum T Identity 94type NodeInfo = DSum T Identity
79type SessionAddress = DSum S Identity 95type SessionAddress = DSum S Identity
80 96type OnionAddress = DSum O Identity
81type Address = DSum T A
82 97
83#if MIN_VERSION_dependent_sum(0,6,0) 98#if MIN_VERSION_dependent_sum(0,6,0)
84deriveArgDict ''T 99deriveArgDict ''T
85deriveArgDict ''S 100deriveArgDict ''S
101deriveArgDict ''O
86#else 102#else
87instance ShowTag T Identity where 103instance ShowTag T Identity where
88 showTaggedPrec UDP = showsPrec 104 showTaggedPrec UDP = showsPrec
@@ -90,6 +106,9 @@ instance ShowTag T Identity where
90instance ShowTag S Identity where 106instance ShowTag S Identity where
91 showTaggedPrec SessionUDP = showsPrec 107 showTaggedPrec SessionUDP = showsPrec
92 showTaggedPrec SessionTCP = showsPrec 108 showTaggedPrec SessionTCP = showsPrec
109instance ShowTag O Identity where
110 showTaggedPrec OnionUDP = showsPrec
111 showTaggedPrec OnionTCP = showsPrec
93instance EqTag S Identity where 112instance EqTag S Identity where
94 eqTagged SessionUDP SessionUDP = (==) 113 eqTagged SessionUDP SessionUDP = (==)
95 eqTagged SessionTCP SessionTCP = (==) 114 eqTagged SessionTCP SessionTCP = (==)
@@ -99,16 +118,6 @@ instance OrdTag S Identity where
99#endif 118#endif
100 119
101 120
102{-
103nodeInfo :: NodeId -> DSum T A -> Either String (DSum T Identity )
104nodeInfo nid (UDP :=> AddrUDP saddr ) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr
105nodeInfo nid (TCP :=> AddrTCP conid relay) = Right $ TCP ==> ViaRelay conid nid relay
106
107nodeAddr :: DSum T Identity -> DSum T A
108nodeAddr (UDP :=> Identity ni ) = UDP :=> AddrUDP (UDP.nodeAddr ni)
109nodeAddr (TCP :=> Identity (ViaRelay conid _ relay)) = TCP :=> AddrTCP conid relay
110-}
111
112nodeInfo :: NodeId -> DSum S Identity -> Either String (DSum T Identity) 121nodeInfo :: NodeId -> DSum S Identity -> Either String (DSum T Identity)
113nodeInfo nid (SessionUDP :=> Identity saddr) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr 122nodeInfo nid (SessionUDP :=> Identity saddr) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr
114nodeInfo nid (SessionTCP :=> Identity taddr@(ViaRelay _ nid2 _)) = 123nodeInfo nid (SessionTCP :=> Identity taddr@(ViaRelay _ nid2 _)) =
diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs
index a9bc4e1d..55e81069 100644
--- a/dht/src/Data/Tox/Onion.hs
+++ b/dht/src/Data/Tox/Onion.hs
@@ -19,7 +19,7 @@
19module Data.Tox.Onion where 19module Data.Tox.Onion where
20 20
21 21
22import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort,localhost4,localhost6) 22import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort,localhost4,localhost6,nullAddress4)
23import Network.QueryResponse 23import Network.QueryResponse
24import Crypto.Tox hiding (encrypt,decrypt) 24import Crypto.Tox hiding (encrypt,decrypt)
25import Network.Tox.NodeId 25import Network.Tox.NodeId
@@ -873,6 +873,19 @@ data OnionRoute = OnionRoute
873 } 873 }
874 deriving Show 874 deriving Show
875 875
876dummySecret :: SecretKey
877dummySecret = fromJust $ decodeSecret "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
878
879dummyNodeId :: NodeId
880dummyNodeId = read "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
881
882dummyNode :: NodeInfo
883dummyNode = k where Right k = nodeInfo dummyNodeId nullAddress4
884
885dummyRoute :: OnionRoute
886dummyRoute = OnionRoute dummySecret dummySecret dummySecret
887 dummyNode dummyNode dummyNode
888 Nothing
876 889
877wrapOnion :: Serialize (Forwarding n msg) => 890wrapOnion :: Serialize (Forwarding n msg) =>
878 TransportCrypto 891 TransportCrypto
@@ -956,6 +969,10 @@ instance Read AnnouncedRendezvous where
956 } 969 }
957 970
958 971
972-- | Lookup the secret key for the given toxid public key. If it is not found,
973-- then the SearchingAlias symbol will be used to indicate that a new temporary
974-- key pair should be generated or that all known keys should be tried until one
975-- succeeds to decrypt the message.
959selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector 976selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector
960selectAlias crypto pkey = do 977selectAlias crypto pkey = do
961 ks <- filter (\(sk,pk) -> pk == id2key pkey) 978 ks <- filter (\(sk,pk) -> pk == id2key pkey)
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs
index 4898513a..60b793af 100644
--- a/dht/src/Network/Tox.hs
+++ b/dht/src/Network/Tox.hs
@@ -34,6 +34,7 @@ import qualified Data.ByteString as B
34 ;import Data.ByteString (ByteString) 34 ;import Data.ByteString (ByteString)
35import qualified Data.ByteString.Char8 as C8 35import qualified Data.ByteString.Char8 as C8
36import Data.Data 36import Data.Data
37import qualified Data.Dependent.Map as DMap
37import Data.Dependent.Sum 38import Data.Dependent.Sum
38import Data.Functor.Identity 39import Data.Functor.Identity
39import Data.Functor.Contravariant 40import Data.Functor.Contravariant
@@ -252,37 +253,6 @@ getOnionAlias crypto dhtself remoteNode = atomically $ do
252 _ -> ni { nodeId = key2id (onionAliasPublic crypto) } 253 _ -> ni { nodeId = key2id (onionAliasPublic crypto) }
253 return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing 254 return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing
254 255
255newOnionClient :: DRG g =>
256 TransportCrypto
257 -> Transport String (Onion.OnionDestination RouteId) Onion.Message
258 -> DHT.Routing
259 -> TVar SessionTokens
260 -> TVar Onion.AnnouncedKeys
261 -> OnionRouter
262 -> TVar (g, Data.Word64Map.Word64Map a)
263 -> ((Maybe Onion.Message -> IO ()) -> a)
264 -> (a -> Maybe Onion.Message -> IO void)
265 -> Client String
266 DHT.PacketKind
267 DHT.TransactionId
268 (Onion.OnionDestination RouteId)
269 Onion.Message
270newOnionClient crypto net r toks keydb orouter map_var store load = c
271 where
272 eprinter = logErrors
273 c = Client
274 { clientNet = addHandler (reportParseError eprinter) (handleMessage c) net
275 , clientDispatcher = DispatchMethods
276 { classifyInbound = Onion.classify
277 , lookupHandler = Onion.handlers net r toks keydb
278 , tableMethods = hookQueries orouter DHT.transactionKey
279 $ transactionMethods' store load (contramap w64Key w64MapMethods) gen
280 }
281 , clientErrorReporter = eprinter
282 , clientPending = map_var
283 , clientAddress = getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 r)
284 , clientResponseId = genNonce24 map_var
285 }
286 256
287newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rendezvous for. 257newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rendezvous for.
288 -> [String] -- ^ Bind-address to listen on. Must provide at least one. 258 -> [String] -- ^ Bind-address to listen on. Must provide at least one.
@@ -346,8 +316,8 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do
346 let lookupClose _ = return Nothing 316 let lookupClose _ = return Nothing
347 317
348 mkrouting <- DHT.newRouting addr crypto updateIP updateIP 318 mkrouting <- DHT.newRouting addr crypto updateIP updateIP
349 (orouter,relaynet,otbl) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp) 319 (orouter,relaynet,onioncryptTCP) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp)
350 (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes) 320 (cryptonet,dhtcrypt,onioncryptUDP,dtacrypt,handshakes)
351 <- toxTransport crypto orouter lookupClose addr udp relaynet 321 <- toxTransport crypto orouter lookupClose addr udp relaynet
352 (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x)) 322 (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x))
353 (fromMaybe (\_ _ -> return ()) tcp) 323 (fromMaybe (\_ _ -> return ()) tcp)
@@ -378,12 +348,30 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do
378 toks <- do 348 toks <- do
379 nil <- nullSessionTokens 349 nil <- nullSessionTokens
380 atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids. 350 atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids.
381 let onionnet = layerTransportM (Onion.decrypt crypto) (Onion.encrypt crypto) onioncrypt 351
382 let onionclient = newOnionClient crypto onionnet (mkrouting dhtclient) toks keydb orouter' otbl 352 onioncrypt <- mergeTransports $ DMap.fromList
383 Right $ \case 353 [ Multi.OnionUDP :=> ByAddress onioncryptUDP
384 Right v -> v 354 , Multi.OnionTCP :=> ByAddress onioncryptTCP ]
385 Left v -> \_ -> 355 oniondrg <- drgNew
386 dput XUnexpected "TCP-sent onion query got response over UDP?" 356 let onionnet = layerTransportM
357 (\msg od -> Onion.decrypt crypto msg $ Multi.untagOnion od)
358 (\msg od -> do
359 (msg', od') <- Onion.encrypt crypto msg od
360 -- TODO: lookupRoute is unnecessarily done twice
361 -- because that was convenient for me. The other
362 -- call was done when building the transport.
363 -- Consider simplifying this.
364 mtcp <- case od' of
365 Onion.OnionDestination _ ni (Just rid)
366 -> (>>= Onion.routeRelayPort) <$> lookupRoute orouter' ni rid
367 _ -> return Nothing
368 return (msg', maybe (Multi.OnionUDP ==> od') (const $ Multi.OnionTCP ==> od') mtcp))
369 onioncrypt
370 onionclient <- newClient oniondrg onionnet (const Onion.classify)
371 (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 $ mkrouting dhtclient))
372 (const $ Onion.handlers onionnet (mkrouting dhtclient) toks keydb)
373 (hookQueries orouter' DHT.transactionKey)
374 (const id)
387 375
388 return Tox 376 return Tox
389 { toxDHT = dhtclient 377 { toxDHT = dhtclient
diff --git a/dht/src/Network/Tox/Onion/Routes.hs b/dht/src/Network/Tox/Onion/Routes.hs
index baca693b..b20ad7dd 100644
--- a/dht/src/Network/Tox/Onion/Routes.hs
+++ b/dht/src/Network/Tox/Onion/Routes.hs
@@ -159,9 +159,8 @@ newOnionRouter :: TransportCrypto
159 -> Bool -- is tcp enabled? 159 -> Bool -- is tcp enabled?
160 -> IO ( OnionRouter 160 -> IO ( OnionRouter
161 , Transport String TCP.ViaRelay B.ByteString 161 , Transport String TCP.ViaRelay B.ByteString
162 , TVar ( ChaChaDRG 162 , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
163 , Word64Map (Either (Maybe (Bool,TCP.RelayPacket) -> IO ()) 163 )
164 (Maybe (OnionMessage Identity) -> IO ()))))
165newOnionRouter crypto perror tcp_enabled = do 164newOnionRouter crypto perror tcp_enabled = do
166 drg0 <- drgNew 165 drg0 <- drgNew
167 (rlog,pq,rm) <- atomically $ do 166 (rlog,pq,rm) <- atomically $ do
@@ -169,26 +168,12 @@ newOnionRouter crypto perror tcp_enabled = do
169 pq <- newTVar W64.empty 168 pq <- newTVar W64.empty
170 rm <- newArray (0,11) Nothing 169 rm <- newArray (0,11) Nothing
171 return (rlog,pq,rm) 170 return (rlog,pq,rm)
172 ((tbl,(tcptbl,tcpcons,relaynet)),tcp) <- do 171 ((tbl,(tcptbl,tcpcons,relaynet,onionnet)),tcp) <- do
173 (tcptbl, client) <- TCP.newClient crypto Left $ \case 172 (tcptbl, client) <- TCP.newClient crypto
174 Left v -> void . v . Just . (,) False 173 id
175 Right v -> \case 174 (. (Just . (,) False))
176 TCP.OnionPacketResponse x@(OnionAnnounceResponse n8 n24 _) -> do 175 (lookupSender' pq rlog)
177 mod <- lookupSender' pq rlog localhost4 n8 176 (\_ (RouteId rid) -> atomically $ fmap storedRoute <$> readArray rm rid)
178 perror $ "TCP announce response from " ++ show mod
179 forM_ mod $ \od -> do
180 Onion.decrypt crypto x od >>= \case
181 Right (y,_) -> do perror $ "decrypted announce response, sending " ++ show y
182 let
183 RouteId rid = fromMaybe (routeId (nodeId (onionNodeInfo od)))
184 $ onionRouteSpec od
185 Nonce8 w8 = n8
186 atomically $ do
187 modifyTVar' pq (W64.delete w8)
188 modifyArray rm (fmap gotResponse) rid
189 void $ v $ Just y
190 _ -> return ()
191 x -> perror $ "Unexpected TCP query result: " ++ show x
192 177
193 let addr = SockAddrInet 0 0 178 let addr = SockAddrInet 0 0
194 tentative_udp = NodeInfo 179 tentative_udp = NodeInfo
@@ -269,7 +254,7 @@ newOnionRouter crypto perror tcp_enabled = do
269 $ clientNet c } 254 $ clientNet c }
270 } 255 }
271 } 256 }
272 return (or,relaynet,tcptbl) 257 return (or,relaynet,onionnet)
273 258
274updateTCP :: OnionRouter -> TCP.NodeInfo -> p -> IO () 259updateTCP :: OnionRouter -> TCP.NodeInfo -> p -> IO ()
275updateTCP or addr x = do 260updateTCP or addr x = do
diff --git a/dht/src/Network/Tox/Onion/Transport.hs b/dht/src/Network/Tox/Onion/Transport.hs
index 407cd387..913d339d 100644
--- a/dht/src/Network/Tox/Onion/Transport.hs
+++ b/dht/src/Network/Tox/Onion/Transport.hs
@@ -24,6 +24,7 @@ module Network.Tox.Onion.Transport
24 , decrypt 24 , decrypt
25 , peelSymmetric 25 , peelSymmetric
26 , OnionRoute(..) 26 , OnionRoute(..)
27 , dummyRoute
27 , N0 28 , N0
28 , N1 29 , N1
29 , N2 30 , N2
@@ -39,9 +40,11 @@ module Network.Tox.Onion.Transport
39 , wrapOnion 40 , wrapOnion
40 , wrapOnionPure 41 , wrapOnionPure
41 , unwrapAnnounceResponse 42 , unwrapAnnounceResponse
43 , wrapIndirectHops
42 ) where 44 ) where
43 45
44import Data.ByteString (ByteString) 46import qualified Data.ByteString as B
47 ;import Data.ByteString (ByteString)
45import Data.Maybe 48import Data.Maybe
46import Data.Serialize 49import Data.Serialize
47import Network.Socket 50import Network.Socket
@@ -50,8 +53,10 @@ import Crypto.Tox hiding (encrypt,decrypt)
50import Network.Tox.TCP.NodeId (udpNodeInfo) 53import Network.Tox.TCP.NodeId (udpNodeInfo)
51import qualified Data.Tox.Relay as TCP 54import qualified Data.Tox.Relay as TCP
52import Data.Tox.Onion 55import Data.Tox.Onion
56import Network.Address (nullAddress4)
53import Network.Tox.DHT.Transport (SendNodes(..)) 57import Network.Tox.DHT.Transport (SendNodes(..))
54import Network.Tox.NodeId 58import Network.Tox.NodeId
59import Network.QueryResponse
55 60
56{- 61{-
57encodeOnionAddr :: TransportCrypto 62encodeOnionAddr :: TransportCrypto
@@ -88,28 +93,28 @@ wrapForRoute :: TransportCrypto
88 -> NodeInfo 93 -> NodeInfo
89 -> OnionRoute 94 -> OnionRoute
90 -> IO (Either TCP.RelayPacket (OnionRequest N0)) 95 -> IO (Either TCP.RelayPacket (OnionRequest N0))
91wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort=Nothing} = do 96wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort=Nothing} =
92 -- We needn't use the same nonce value here, but I think it is safe to do so. 97 wrapIndirectHops crypto msg ni r $ \nonce saddr msg' -> do
93 let nonce = msgNonce msg 98 fwd <- wrapOnion crypto (routeAliasA r)
94 fwd <- wrapOnion crypto (routeAliasA r) 99 nonce
95 nonce 100 (id2key . nodeId $ routeNodeA r)
96 (id2key . nodeId $ routeNodeA r) 101 saddr
97 (nodeAddr $ routeNodeB r) 102 msg'
98 =<< wrapOnion crypto (routeAliasB r) 103 return $ Right OnionRequest { onionNonce = nonce
99 nonce 104 , onionForward = fwd
100 (id2key . nodeId $ routeNodeB r) 105 , pathFromOwner = NoReturnPath
101 (nodeAddr $ routeNodeC r) 106 }
102 =<< wrapOnion crypto (routeAliasC r) 107wrapForRoute crypto msg ni r@OnionRoute { routeRelayPort = Just _ } =
103 nonce 108 wrapIndirectHops crypto msg ni r $ \nonce saddr fwd ->
104 (id2key . nodeId $ routeNodeC r) 109 return $ Left $ TCP.OnionPacket nonce $ Addressed (nodeAddr $ routeNodeB r) fwd
105 (nodeAddr ni) 110
106 (NotForwarded msg) 111wrapIndirectHops :: TransportCrypto
107 return $ Right OnionRequest 112 -> OnionMessage Encrypted
108 { onionNonce = nonce 113 -> NodeInfo
109 , onionForward = fwd 114 -> OnionRoute
110 , pathFromOwner = NoReturnPath 115 -> (Nonce24 -> SockAddr -> Forwarding N2 (OnionMessage Encrypted) -> IO a)
111 } 116 -> IO a
112wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort = Just tcpport} = do 117wrapIndirectHops crypto msg ni r fin = do
113 let nonce = msgNonce msg 118 let nonce = msgNonce msg
114 fwd <- wrapOnion crypto (routeAliasB r) 119 fwd <- wrapOnion crypto (routeAliasB r)
115 nonce 120 nonce
@@ -120,7 +125,7 @@ wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort = Just tcpport} = do
120 (id2key . nodeId $ routeNodeC r) 125 (id2key . nodeId $ routeNodeC r)
121 (nodeAddr ni) 126 (nodeAddr ni)
122 (NotForwarded msg) 127 (NotForwarded msg)
123 return $ Left $ TCP.OnionPacket nonce $ Addressed (nodeAddr $ routeNodeB r) fwd 128 fin nonce (nodeAddr $ routeNodeB r) fwd
124 129
125unwrapAnnounceResponse :: Maybe NodeId -> NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32) 130unwrapAnnounceResponse :: Maybe NodeId -> NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32)
126unwrapAnnounceResponse alias ni (AnnounceResponse is_stored (SendNodes ns0)) | let ns = map udpNodeInfo ns0 131unwrapAnnounceResponse alias ni (AnnounceResponse is_stored (SendNodes ns0)) | let ns = map udpNodeInfo ns0
diff --git a/dht/src/Network/Tox/TCP.hs b/dht/src/Network/Tox/TCP.hs
index c4727a20..04119164 100644
--- a/dht/src/Network/Tox/TCP.hs
+++ b/dht/src/Network/Tox/TCP.hs
@@ -43,7 +43,7 @@ import Data.Tox.Relay
43import qualified Data.Word64Map 43import qualified Data.Word64Map
44import DebugTag 44import DebugTag
45import DPut 45import DPut
46import Network.Address (setPort,PortNumber,localhost4,fromSockAddr) 46import Network.Address (setPort,PortNumber,localhost4,fromSockAddr,nullAddress4)
47import Network.Kademlia.Routing 47import Network.Kademlia.Routing
48import Network.Kademlia.Search hiding (sendQuery) 48import Network.Kademlia.Search hiding (sendQuery)
49import Network.QueryResponse 49import Network.QueryResponse
@@ -319,21 +319,25 @@ type RelayCache = TCPCache (SessionProtocol (SessionData,RelayPacket) RelayPacke
319-- defaults are 'id' and 'tryPutMVar'. The resulting customized table state 319-- defaults are 'id' and 'tryPutMVar'. The resulting customized table state
320-- will be returned to the caller along with the new client. 320-- will be returned to the caller along with the new client.
321newClient :: TransportCrypto 321newClient :: TransportCrypto
322 -> ((Maybe (Bool,RelayPacket) -> IO ()) -> a) -- ^ store mvar for query 322 -> ((Maybe (Bool,RelayPacket) -> IO ()) -> a) -- ^ store mvar for relay query
323 -> (a -> RelayPacket -> IO void) -- ^ load mvar for query 323 -> (a -> RelayPacket -> IO void) -- ^ load mvar for relay query
324 -> (SockAddr -> Nonce8 -> IO (Maybe (OnionDestination RouteId))) -- ^ lookup sender of onion query
325 -> (UDP.NodeInfo -> RouteId -> IO (Maybe OnionRoute)) -- ^ lookup OnionRoute by id
324 -> IO ( ( TVar (ChaChaDRG, Data.Word64Map.Word64Map a) 326 -> IO ( ( TVar (ChaChaDRG, Data.Word64Map.Word64Map a)
325 , RelayCache 327 , RelayCache
326 , Transport String ViaRelay ByteString ) 328 , Transport String ViaRelay ByteString
329 , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) )
327 , Client String PacketNumber Nonce8 NodeInfo (Bool,RelayPacket)) 330 , Client String PacketNumber Nonce8 NodeInfo (Bool,RelayPacket))
328newClient crypto store load = do 331newClient crypto store load lookupSender getRoute = do
329 (tcpcache,net0) <- toxTCP crypto 332 (tcpcache,net0) <- toxTCP crypto
330 (relaynet,net1) <- partitionRelay net0 333 (relaynet,net1) <- partitionRelay net0
331 let net2 = {- XXX: Client type forces this pointless layering. -} 334 (onionnet,net2) <- partitionOnion crypto lookupSender getRoute net1
332 layerTransport ((Right .) . (,) . (,) False . snd) (,) net1 335 let net3 = {- XXX: Client type forces this pointless layering. -}
336 layerTransport ((Right .) . (,) . (,) False . snd) (,) net2
333 drg <- drgNew 337 drg <- drgNew
334 map_var <- atomically $ newTVar (drg, Data.Word64Map.empty) 338 map_var <- atomically $ newTVar (drg, Data.Word64Map.empty)
335 return $ (,) (map_var,tcpcache,relaynet) Client 339 return $ (,) (map_var,tcpcache,relaynet,onionnet) Client
336 { clientNet = net2 340 { clientNet = net3
337 , clientDispatcher = DispatchMethods 341 , clientDispatcher = DispatchMethods
338 { classifyInbound = (. snd) $ \case 342 { classifyInbound = (. snd) $ \case
339 RelayPing n -> IsQuery PingPacket n 343 RelayPing n -> IsQuery PingPacket n
@@ -393,3 +397,41 @@ partitionRelay tr = partitionTransportM parse encode tr
393 encode :: (ByteString, ViaRelay) -> IO (Maybe ((Bool,RelayPacket), NodeInfo)) 397 encode :: (ByteString, ViaRelay) -> IO (Maybe ((Bool,RelayPacket), NodeInfo))
394 encode (bs, ViaRelay (Just conid) _ ni) = return $ Just ((False,RelayData bs conid), ni) 398 encode (bs, ViaRelay (Just conid) _ ni) = return $ Just ((False,RelayData bs conid), ni)
395 encode (bs, ViaRelay Nothing nid ni) = return $ Just ((False,OOBSend (UDP.id2key nid) bs), ni) 399 encode (bs, ViaRelay Nothing nid ni) = return $ Just ((False,OOBSend (UDP.id2key nid) bs), ni)
400
401
402partitionOnion :: TransportCrypto
403 -> (SockAddr -> Nonce8 -> IO (Maybe (OnionDestination RouteId)))
404 -> (UDP.NodeInfo -> RouteId -> IO (Maybe OnionRoute))
405 -> TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket)
406 -> IO ( Transport err (OnionDestination RouteId) (OnionMessage Encrypted)
407 , TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket))
408partitionOnion crypto lookupSender getRoute tr = partitionTransportM parse encode tr
409 where
410 parse :: ((SessionData,RelayPacket), NodeInfo)
411 -> IO (Either (OnionMessage Encrypted , OnionDestination RouteId)
412 ((SessionData,RelayPacket), NodeInfo))
413 parse pass@((_,OnionPacketResponse msg@(OnionAnnounceResponse n8 _ _)), nodeA) = do
414 m <- lookupSender (nodeAddr nodeA) n8
415 case m of
416 Nothing -> return $ Right pass
417 Just od -> return $ Left (msg, od)
418 parse ((_,OnionPacketResponse msg@(OnionToRouteResponse asym)), nodeA) =
419 return $
420 let Right ni = UDP.nodeInfo (UDP.key2id $ senderKey asym) nullAddress4
421 -- -- We have this information, but currently, we're discarding it...
422 -- r = dummyRoute { routeNodeA = udpNodeInfo nodeA
423 -- , routeRelayPort = Just $ tcpPort nodeA }
424 tryAllKeys = SearchingAlias -- We unfortunately don't know what toxid was used to encrypt this.
425 -- Toxcore only supports a single toxid per DHT node and in that case,
426 -- it is unambiguous.
427 in Left (msg, OnionDestination tryAllKeys ni Nothing)
428 parse pass = return $ Right pass
429
430 encode :: (OnionMessage Encrypted,OnionDestination RouteId) -> IO (Maybe ((Bool,RelayPacket),NodeInfo))
431 encode (msg,OnionDestination _ ni (Just rid)) = do
432 moroute <- getRoute ni rid
433 forM (moroute >>= \r -> (,) r <$> routeRelayPort r) $ \(oroute,tcpport) ->
434 wrapIndirectHops crypto msg ni oroute $ \nonce saddr fwd ->
435 return ( (True,OnionPacket nonce $ Addressed saddr fwd)
436 , NodeInfo (routeNodeA oroute) tcpport )
437 encode _ = return Nothing
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-14 09:36:51 +0000