summaryrefslogtreecommitdiff
path: root/src/Network/Tox/TCP.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/TCP.hs')
-rw-r--r--src/Network/Tox/TCP.hs80
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 #-}
5module Network.Tox.TCP where 5module Network.Tox.TCP where
6 6
7import Control.Arrow
7import Control.Concurrent 8import Control.Concurrent
8import Control.Concurrent.STM 9import Control.Concurrent.STM
10import Crypto.Random
11import Data.Functor.Contravariant
9import Data.Functor.Identity 12import Data.Functor.Identity
13import Data.IP
10import Data.Serialize 14import Data.Serialize
15import Network.Socket (SockAddr(..))
11 16
12import Crypto.Tox 17import Crypto.Tox
13import Data.ByteString (hPut,hGet) 18import Data.ByteString (hPut,hGet,ByteString)
14import Data.Tox.Relay 19import Data.Tox.Relay
15import Network.Address (setPort,PortNumber,SockAddr) 20import qualified Data.Word64Map
21import DebugTag
22import DPut
23import Network.Address (setPort,PortNumber)
24import Network.Kademlia.Routing
25import Network.Kademlia.Search
16import Network.QueryResponse 26import Network.QueryResponse
17import Network.QueryResponse.TCP 27import Network.QueryResponse.TCP
28import Network.Tox.DHT.Handlers (toxSpace)
29import Network.Tox.Onion.Transport (OnionMessage(..),OnionResponse(..),N1)
18import qualified Network.Tox.NodeId as UDP 30import qualified Network.Tox.NodeId as UDP
19 31
20 32
@@ -28,12 +40,18 @@ data NodeInfo = NodeInfo
28 40
29type NodeId = UDP.NodeId 41type NodeId = UDP.NodeId
30 42
43instance Show NodeInfo where
44 show (NodeInfo udp port) = show udp ++ "{tcp:"++show port++"}"
45
31nodeId :: NodeInfo -> NodeId 46nodeId :: NodeInfo -> NodeId
32nodeId ni = UDP.nodeId $ udpNodeInfo ni 47nodeId ni = UDP.nodeId $ udpNodeInfo ni
33 48
34nodeAddr :: NodeInfo -> SockAddr 49nodeAddr :: NodeInfo -> SockAddr
35nodeAddr ni = setPort (tcpPort ni) $ UDP.nodeAddr $ udpNodeInfo ni 50nodeAddr ni = setPort (tcpPort ni) $ UDP.nodeAddr $ udpNodeInfo ni
36 51
52nodeIP :: NodeInfo -> IP
53nodeIP ni = UDP.nodeIP $ udpNodeInfo ni
54
37tcpStream :: (Serialize y, Sized y, Serialize x, Sized x) => 55tcpStream :: (Serialize y, Sized y, Serialize x, Sized x) =>
38 TransportCrypto -> StreamHandshake NodeInfo x y 56 TransportCrypto -> StreamHandshake NodeInfo x y
39tcpStream crypto = StreamHandshake 57tcpStream crypto = StreamHandshake
@@ -81,3 +99,61 @@ tcpStream crypto = StreamHandshake
81 99
82toxTCP :: TransportCrypto -> IO (Transport err NodeInfo RelayPacket) 100toxTCP :: TransportCrypto -> IO (Transport err NodeInfo RelayPacket)
83toxTCP crypto = tcpTransport 30 (tcpStream crypto) 101toxTCP crypto = tcpTransport 30 (tcpStream crypto)
102
103tcpSpace :: KademliaSpace NodeId NodeInfo
104tcpSpace = contramap udpNodeInfo toxSpace
105
106nodeSearch :: Client err meth tid NodeInfo RelayPacket -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo
107nodeSearch client = Search
108 { searchSpace = tcpSpace
109 , searchNodeAddress = nodeIP &&& tcpPort
110 , searchQuery = getNodes client
111 }
112
113getNodes :: Client err meth tid NodeInfo RelayPacket -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo], [NodeInfo], Maybe ()))
114getNodes client seeking dst = do
115 return Nothing -- TODO
116
117handleOOB :: PublicKey -> ByteString -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket))
118handleOOB k bs src dst = do
119 dput XMisc $ "TODO: handleOOB " ++ show src
120 return Nothing
121
122handle2route :: OnionResponse N1 -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket))
123handle2route o src dst = do
124 dput XMisc $ "TODO: handle2route " ++ show src
125 return Nothing
126
127
128tcpClient :: TransportCrypto -> IO (Client String () Nonce8 NodeInfo RelayPacket)
129tcpClient 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 }