1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
module Network.Tox.Transport (toxTransport, RouteId) where
import Network.QueryResponse
import Crypto.Tox
import Data.Tox.Relay as TCP
import qualified Data.Tox.DHT.Multi as Multi
import Network.Tox.DHT.Transport as UDP
import Network.Tox.TCP (ViaRelay)
import Network.Tox.Onion.Transport
import Network.Tox.Crypto.Transport
import Network.Tox.Onion.Routes
import Control.Applicative
import Control.Concurrent.STM
import qualified Data.ByteString as B
import qualified Data.Dependent.Map as DMap
import Data.Dependent.Sum
import Data.Functor.Identity
import Data.Maybe
import Network.Socket
pendingCookiesUDP :: TransportCrypto -> SockAddr -> STM (Maybe UDP.NodeInfo)
pendingCookiesUDP crypto saddr = do
cs <- readTVar $ pendingCookies crypto
return $ do
(_,key) <- lookup saddr cs <|> listToMaybe (map snd cs)
either (const Nothing) Just $ nodeInfo (key2id key) saddr
pendingCookiesTCP :: ViaRelay -> STM (Maybe ViaRelay)
pendingCookiesTCP ni = return $ Just ni
toxTransport ::
TransportCrypto
-> OnionRouter
-> (PublicKey -> IO (Maybe UDP.NodeInfo))
-> SockAddr -- ^ UDP bind-address
-> UDPTransport
-> Transport String ViaRelay B.ByteString
-> (TCP.NodeInfo -> RelayPacket -> IO ()) -- ^ (UNUSED) TCP server-bound callback.
-> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP client-bound callback.
-> IO ( Transport String Multi.SessionAddress (CryptoPacket Encrypted)
, Transport String Multi.NodeInfo (DHTMessage Encrypted8)
, Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
, Transport String Multi.SessionAddress (Handshake Encrypted))
toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do
(netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp
(dhtUDP,udp1) <- partitionTransportM (parseDHTAddr (pendingCookiesUDP crypto) nodeInfo)
(fmap Just . encodeDHTAddr nodeAddr)
$ forwardOnions crypto addr udp0 tcp2client
-- rlynet0 = layerTransportM (DHT.decrypt crypto Multi.relayNodeId) (DHT.encrypt crypto Multi.relayNodeId) relaynet
(netcryptoTCP, relaynet0) <- partitionTransport parseCrypto encodeCrypto relaynet
(dhtTCP,relaynet1) <- partitionTransportM
(parseDHTAddr pendingCookiesTCP (\nid viarelay -> Right viarelay))
(fmap Just . encodeDHTAddr id)
relaynet0
let _ = dhtTCP :: Transport String ViaRelay (DHTMessage Encrypted8)
dht <- mergeTransports $ DMap.fromList
[ Multi.UDP :=> ByAddress dhtUDP
, Multi.TCP :=> ByAddress dhtTCP
]
(onion,udp2) <- partitionTransportM
(parseOnionAddr $ lookupSender orouter)
(encodeOnionAddr crypto $ lookupRoute orouter)
udp1
multi_netcrypto <- mergeTransports $ DMap.fromList
[ Multi.SessionUDP :=> ByAddress netcrypto
, Multi.SessionTCP :=> ByAddress netcryptoTCP ]
let handshakes = layerTransport parseHandshakes encodeHandshakes udp2
handshakesTCP = layerTransport parseHandshakes encodeHandshakes relaynet1
multi_handshakes <- mergeTransports $ DMap.fromList
[ Multi.SessionUDP :=> ByAddress handshakes
, Multi.SessionTCP :=> ByAddress handshakesTCP ]
return ( multi_netcrypto
, forwardDHTRequests crypto (fmap (fmap (Multi.UDP ==>)) . closeLookup) dht
, onion
, multi_handshakes
)
-- instance (Sized a, Sized b) => Sized (a,b) where size = _todo
-- Byte value Packet Kind Return address
-- :----------- :--------------------
-- `0x00` Ping Request DHTNode
-- `0x01` Ping Response -
-- `0x02` Nodes Request DHTNode
-- `0x04` Nodes Response -
-- `0x18` Cookie Request DHTNode, but without sending pubkey in response
-- `0x19` Cookie Response - (no pubkey)
--
-- `0x21` LAN Discovery DHTNode (No reply, port 33445, trigger Nodes Request/Response)
--
-- `0x20` DHT Request DHTNode/-forward
--
-- `0x1a` Crypto Handshake CookieAddress
--
-- `0x1b` Crypto Data SessionAddress
--
-- `0x83` Announce Request OnionToOwner
-- `0x84` Announce Response -
-- `0x85` Onion Data Request OnionToOwner
-- `0x86` Onion Data Response -
--
-- `0xf0` Bootstrap Info SockAddr?
--
-- `0x80` Onion Request 0 -forward
-- `0x81` Onion Request 1 -forward
-- `0x82` Onion Request 2 -forward
-- `0x8c` Onion Response 3 -return
-- `0x8d` Onion Response 2 -return
-- `0x8e` Onion Response 1 -return
|
