diff options
Diffstat (limited to 'src/Network/Tox/TCP.hs')
-rw-r--r-- | src/Network/Tox/TCP.hs | 80 |
1 files changed, 78 insertions, 2 deletions
diff --git a/src/Network/Tox/TCP.hs b/src/Network/Tox/TCP.hs index 28bcd244..608becc3 100644 --- a/src/Network/Tox/TCP.hs +++ b/src/Network/Tox/TCP.hs | |||
@@ -4,17 +4,29 @@ | |||
4 | {-# LANGUAGE FlexibleContexts #-} | 4 | {-# LANGUAGE FlexibleContexts #-} |
5 | module Network.Tox.TCP where | 5 | module Network.Tox.TCP where |
6 | 6 | ||
7 | import Control.Arrow | ||
7 | import Control.Concurrent | 8 | import Control.Concurrent |
8 | import Control.Concurrent.STM | 9 | import Control.Concurrent.STM |
10 | import Crypto.Random | ||
11 | import Data.Functor.Contravariant | ||
9 | import Data.Functor.Identity | 12 | import Data.Functor.Identity |
13 | import Data.IP | ||
10 | import Data.Serialize | 14 | import Data.Serialize |
15 | import Network.Socket (SockAddr(..)) | ||
11 | 16 | ||
12 | import Crypto.Tox | 17 | import Crypto.Tox |
13 | import Data.ByteString (hPut,hGet) | 18 | import Data.ByteString (hPut,hGet,ByteString) |
14 | import Data.Tox.Relay | 19 | import Data.Tox.Relay |
15 | import Network.Address (setPort,PortNumber,SockAddr) | 20 | import qualified Data.Word64Map |
21 | import DebugTag | ||
22 | import DPut | ||
23 | import Network.Address (setPort,PortNumber) | ||
24 | import Network.Kademlia.Routing | ||
25 | import Network.Kademlia.Search | ||
16 | import Network.QueryResponse | 26 | import Network.QueryResponse |
17 | import Network.QueryResponse.TCP | 27 | import Network.QueryResponse.TCP |
28 | import Network.Tox.DHT.Handlers (toxSpace) | ||
29 | import Network.Tox.Onion.Transport (OnionMessage(..),OnionResponse(..),N1) | ||
18 | import qualified Network.Tox.NodeId as UDP | 30 | import qualified Network.Tox.NodeId as UDP |
19 | 31 | ||
20 | 32 | ||
@@ -28,12 +40,18 @@ data NodeInfo = NodeInfo | |||
28 | 40 | ||
29 | type NodeId = UDP.NodeId | 41 | type NodeId = UDP.NodeId |
30 | 42 | ||
43 | instance Show NodeInfo where | ||
44 | show (NodeInfo udp port) = show udp ++ "{tcp:"++show port++"}" | ||
45 | |||
31 | nodeId :: NodeInfo -> NodeId | 46 | nodeId :: NodeInfo -> NodeId |
32 | nodeId ni = UDP.nodeId $ udpNodeInfo ni | 47 | nodeId ni = UDP.nodeId $ udpNodeInfo ni |
33 | 48 | ||
34 | nodeAddr :: NodeInfo -> SockAddr | 49 | nodeAddr :: NodeInfo -> SockAddr |
35 | nodeAddr ni = setPort (tcpPort ni) $ UDP.nodeAddr $ udpNodeInfo ni | 50 | nodeAddr ni = setPort (tcpPort ni) $ UDP.nodeAddr $ udpNodeInfo ni |
36 | 51 | ||
52 | nodeIP :: NodeInfo -> IP | ||
53 | nodeIP ni = UDP.nodeIP $ udpNodeInfo ni | ||
54 | |||
37 | tcpStream :: (Serialize y, Sized y, Serialize x, Sized x) => | 55 | tcpStream :: (Serialize y, Sized y, Serialize x, Sized x) => |
38 | TransportCrypto -> StreamHandshake NodeInfo x y | 56 | TransportCrypto -> StreamHandshake NodeInfo x y |
39 | tcpStream crypto = StreamHandshake | 57 | tcpStream crypto = StreamHandshake |
@@ -81,3 +99,61 @@ tcpStream crypto = StreamHandshake | |||
81 | 99 | ||
82 | toxTCP :: TransportCrypto -> IO (Transport err NodeInfo RelayPacket) | 100 | toxTCP :: TransportCrypto -> IO (Transport err NodeInfo RelayPacket) |
83 | toxTCP crypto = tcpTransport 30 (tcpStream crypto) | 101 | toxTCP crypto = tcpTransport 30 (tcpStream crypto) |
102 | |||
103 | tcpSpace :: KademliaSpace NodeId NodeInfo | ||
104 | tcpSpace = contramap udpNodeInfo toxSpace | ||
105 | |||
106 | nodeSearch :: Client err meth tid NodeInfo RelayPacket -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo | ||
107 | nodeSearch client = Search | ||
108 | { searchSpace = tcpSpace | ||
109 | , searchNodeAddress = nodeIP &&& tcpPort | ||
110 | , searchQuery = getNodes client | ||
111 | } | ||
112 | |||
113 | getNodes :: Client err meth tid NodeInfo RelayPacket -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo], [NodeInfo], Maybe ())) | ||
114 | getNodes client seeking dst = do | ||
115 | return Nothing -- TODO | ||
116 | |||
117 | handleOOB :: PublicKey -> ByteString -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket)) | ||
118 | handleOOB k bs src dst = do | ||
119 | dput XMisc $ "TODO: handleOOB " ++ show src | ||
120 | return Nothing | ||
121 | |||
122 | handle2route :: OnionResponse N1 -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket)) | ||
123 | handle2route o src dst = do | ||
124 | dput XMisc $ "TODO: handle2route " ++ show src | ||
125 | return Nothing | ||
126 | |||
127 | |||
128 | tcpClient :: TransportCrypto -> IO (Client String () Nonce8 NodeInfo RelayPacket) | ||
129 | tcpClient crypto = do | ||
130 | net <- toxTCP crypto | ||
131 | drg <- drgNew | ||
132 | map_var <- atomically $ newTVar (drg, Data.Word64Map.empty) | ||
133 | return Client | ||
134 | { clientNet = net | ||
135 | , clientDispatcher = DispatchMethods | ||
136 | { classifyInbound = \case | ||
137 | RelayPing n -> IsQuery () n | ||
138 | RelayPong n -> IsResponse n | ||
139 | OnionPacketResponse (OnionResponse _ (OnionAnnounceResponse n8 n24 ciphered)) -> IsResponse n8 | ||
140 | OnionPacketResponse o@(OnionResponse _ (OnionToRouteResponse _)) -> IsUnsolicited $ handle2route o | ||
141 | OOBRecv k bs -> IsUnsolicited $ handleOOB k bs | ||
142 | , lookupHandler = \() -> Just MethodHandler | ||
143 | { methodParse = \(RelayPing n8) -> Right () | ||
144 | , methodSerialize = \n8 src dst () -> RelayPong n8 | ||
145 | , methodAction = \src () -> return () | ||
146 | } | ||
147 | , tableMethods = transactionMethods (contramap (\(Nonce8 w64) -> w64) w64MapMethods) | ||
148 | $ first (either error Nonce8 . decode) . randomBytesGenerate 8 | ||
149 | } | ||
150 | , clientErrorReporter = logErrors | ||
151 | , clientPending = map_var | ||
152 | , clientAddress = \_ -> return $ NodeInfo | ||
153 | { udpNodeInfo = either error id $ UDP.nodeInfo (UDP.key2id $ transportPublic crypto) (SockAddrInet 0 0) | ||
154 | , tcpPort = 0 | ||
155 | } | ||
156 | , clientResponseId = return | ||
157 | , clientEnterQuery = \_ -> return () | ||
158 | , clientLeaveQuery = \_ _ -> return () | ||
159 | } | ||