summaryrefslogtreecommitdiff
path: root/src/Network/Tox
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox')
-rw-r--r--src/Network/Tox/TCP.hs52
1 files changed, 42 insertions, 10 deletions
diff --git a/src/Network/Tox/TCP.hs b/src/Network/Tox/TCP.hs
index 48059108..e3f5012b 100644
--- a/src/Network/Tox/TCP.hs
+++ b/src/Network/Tox/TCP.hs
@@ -16,6 +16,7 @@ import Data.Functor.Identity
16import Data.Hashable 16import Data.Hashable
17import qualified Data.HashMap.Strict as HashMap 17import qualified Data.HashMap.Strict as HashMap
18import Data.IP 18import Data.IP
19import Data.Maybe
19import Data.Monoid 20import Data.Monoid
20import Data.Serialize 21import Data.Serialize
21import Data.Word 22import Data.Word
@@ -24,13 +25,14 @@ import Network.Socket (SockAddr(..))
24import qualified Text.ParserCombinators.ReadP as RP 25import qualified Text.ParserCombinators.ReadP as RP
25import System.IO.Error 26import System.IO.Error
26 27
28import ControlMaybe
27import Crypto.Tox 29import Crypto.Tox
28import Data.ByteString (hPut,hGet,ByteString,length) 30import Data.ByteString (hPut,hGet,ByteString,length)
29import Data.Tox.Relay 31import Data.Tox.Relay
30import qualified Data.Word64Map 32import qualified Data.Word64Map
31import DebugTag 33import DebugTag
32import DPut 34import DPut
33import Network.Address (setPort,PortNumber) 35import Network.Address (setPort,PortNumber,localhost4,fromSockAddr)
34import Network.Kademlia.Routing 36import Network.Kademlia.Routing
35import Network.Kademlia.Search hiding (sendQuery) 37import Network.Kademlia.Search hiding (sendQuery)
36import Network.QueryResponse 38import Network.QueryResponse
@@ -116,7 +118,13 @@ tcpStream crypto = StreamHandshake
116 dput XTCP $ "TCP:" ++ show addr ++ " <-- " ++ show hello 118 dput XTCP $ "TCP:" ++ show addr ++ " <-- " ++ show hello
117 hPut h $ encode $ encryptPayload (noncef $ helloNonce hello) hello 119 hPut h $ encode $ encryptPayload (noncef $ helloNonce hello) hello
118 welcomeE <- withSize $ fmap decode . hGet h . constSize 120 welcomeE <- withSize $ fmap decode . hGet h . constSize
119 let Right welcome = welcomeE >>= \w -> decryptPayload (noncef $ welcomeNonce w) w 121 let mwelcome = welcomeE >>= \w -> decryptPayload (noncef $ welcomeNonce w) w
122 nil = SessionProtocol
123 { streamGoodbye = return ()
124 , streamDecode = return Nothing
125 , streamEncode = \y -> return ()
126 }
127 either (\_ -> return nil) id $ mwelcome <&> \welcome -> do
120 dput XTCP $ "TCP:" ++ show addr ++ " --> " ++ show welcome 128 dput XTCP $ "TCP:" ++ show addr ++ " --> " ++ show welcome
121 noncef' <- lookupNonceFunction crypto skey (sessionPublicKey $ runIdentity $ welcomeData welcome) 129 noncef' <- lookupNonceFunction crypto skey (sessionPublicKey $ runIdentity $ welcomeData welcome)
122 nsend <- newMVar (sessionBaseNonce $ runIdentity $ helloData hello) 130 nsend <- newMVar (sessionBaseNonce $ runIdentity $ helloData hello)
@@ -166,12 +174,14 @@ toxTCP crypto = tcpTransport 30 (tcpStream crypto)
166tcpSpace :: KademliaSpace NodeId NodeInfo 174tcpSpace :: KademliaSpace NodeId NodeInfo
167tcpSpace = contramap udpNodeInfo toxSpace 175tcpSpace = contramap udpNodeInfo toxSpace
168 176
177{-
169nodeSearch :: TCPClient err () Nonce8 -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo 178nodeSearch :: TCPClient err () Nonce8 -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo
170nodeSearch tcp = Search 179nodeSearch tcp = Search
171 { searchSpace = tcpSpace 180 { searchSpace = tcpSpace
172 , searchNodeAddress = nodeIP &&& tcpPort 181 , searchNodeAddress = nodeIP &&& tcpPort
173 , searchQuery = getTCPNodes tcp 182 , searchQuery = getNodes tcp
174 } 183 }
184-}
175 185
176data TCPClient err meth tid = TCPClient 186data TCPClient err meth tid = TCPClient
177 { tcpCrypto :: TransportCrypto 187 { tcpCrypto :: TransportCrypto
@@ -179,24 +189,44 @@ data TCPClient err meth tid = TCPClient
179 , tcpGetGateway :: UDP.NodeInfo -> STM (Maybe NodeInfo) 189 , tcpGetGateway :: UDP.NodeInfo -> STM (Maybe NodeInfo)
180 } 190 }
181 191
192{-
182getTCPNodes :: TCPClient err () Nonce8 -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ())) 193getTCPNodes :: TCPClient err () Nonce8 -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ()))
183getTCPNodes tcp seeking dst = do 194getTCPNodes tcp seeking dst = do
184 r <- getUDPNodes tcp seeking (udpNodeInfo dst) 195 r <- getUDPNodes' tcp seeking (udpNodeInfo dst)
185 let tcps (ns,_,mb) = (ns',ns',mb) 196 let tcps (ns,_,mb) = (ns',ns',mb)
186 where ns' = do 197 where ns' = do
187 n <- ns 198 n <- ns
188 [ NodeInfo n (fromIntegral 443) , NodeInfo n (fromIntegral 80) , NodeInfo n (UDP.nodePort n) ] 199 [ NodeInfo n (fromIntegral 443) , NodeInfo n (fromIntegral 80) , NodeInfo n (UDP.nodePort n) ]
189 return $ tcps <$> r 200 fmap join $ forM r $ \(ns,gw) -> do
201 let ts = tcps ns
202 {-
203 if nodeId gw == nodeId dst
204 then return $ Just ts
205 else do
206 forkIO $ void $ tcpPing (tcpClient tcp) dst
207 return $ Just ts
208 -}
209 forM_ ((\(xs,_,_) -> xs) ts) (forkIO . void . tcpPing (tcpClient tcp))
210 return $ Just ts
211-}
190 212
191getUDPNodes :: TCPClient err () Nonce8 -> NodeId -> UDP.NodeInfo -> IO (Maybe ([UDP.NodeInfo], [UDP.NodeInfo], Maybe ())) 213getUDPNodes :: TCPClient err () Nonce8 -> NodeId -> UDP.NodeInfo -> IO (Maybe ([UDP.NodeInfo], [UDP.NodeInfo], Maybe ()))
192getUDPNodes tcp seeking dst = do 214getUDPNodes tcp seeking dst = fmap fst <$> getUDPNodes' tcp seeking dst
193 mgateway <- atomically $ tcpGetGateway tcp dst 215
216getUDPNodes' :: TCPClient err () Nonce8 -> NodeId -> UDP.NodeInfo -> IO (Maybe (([UDP.NodeInfo], [UDP.NodeInfo], Maybe ()), NodeInfo))
217getUDPNodes' tcp seeking dst0 = do
218 mgateway <- atomically $ tcpGetGateway tcp dst0
194 fmap join $ forM mgateway $ \gateway -> do 219 fmap join $ forM mgateway $ \gateway -> do
195 (b,c,n24) <- atomically $ do 220 (b,c,n24) <- atomically $ do
196 b <- transportNewKey (tcpCrypto tcp) 221 b <- transportNewKey (tcpCrypto tcp)
197 c <- transportNewKey (tcpCrypto tcp) 222 c <- transportNewKey (tcpCrypto tcp)
198 n24 <- transportNewNonce (tcpCrypto tcp) 223 n24 <- transportNewNonce (tcpCrypto tcp)
199 return (b,c,n24) 224 return (b,c,n24)
225 let (dst,gateway') = if UDP.nodeId dst0 == nodeId gateway
226 then ( dst0 { UDP.nodeIP = fromJust $ fromSockAddr localhost4 }
227 , gateway { udpNodeInfo = (udpNodeInfo gateway)
228 { UDP.nodeIP = fromJust $ fromSockAddr localhost4 }})
229 else (dst0,gateway)
200 wrap2 <- lookupNonceFunction (tcpCrypto tcp) b (UDP.id2key $ UDP.nodeId dst) 230 wrap2 <- lookupNonceFunction (tcpCrypto tcp) b (UDP.id2key $ UDP.nodeId dst)
201 wrap1 <- lookupNonceFunction (tcpCrypto tcp) c (UDP.id2key $ nodeId gateway) 231 wrap1 <- lookupNonceFunction (tcpCrypto tcp) c (UDP.id2key $ nodeId gateway)
202 wrap0 <- lookupNonceFunction (tcpCrypto tcp) (transportSecret $ tcpCrypto tcp) (UDP.id2key $ UDP.nodeId dst) 232 wrap0 <- lookupNonceFunction (tcpCrypto tcp) (transportSecret $ tcpCrypto tcp) (UDP.id2key $ UDP.nodeId dst)
@@ -205,7 +235,7 @@ getUDPNodes tcp seeking dst = do
205 , method = () -- meth 235 , method = () -- meth
206 , wrapQuery = \n8 src gateway x -> 236 , wrapQuery = \n8 src gateway x ->
207 OnionPacket n24 $ Addressed (UDP.nodeAddr dst) 237 OnionPacket n24 $ Addressed (UDP.nodeAddr dst)
208 $ wrapOnionPure b (wrap2 n24) (nodeAddr gateway) 238 $ wrapOnionPure b (wrap2 n24) (nodeAddr gateway')
209 $ wrapOnionPure c (wrap1 n24) (UDP.nodeAddr dst) 239 $ wrapOnionPure c (wrap1 n24) (UDP.nodeAddr dst)
210 $ NotForwarded $ encryptPayload (wrap0 n24) 240 $ NotForwarded $ encryptPayload (wrap0 n24)
211 $ OnionAnnounce Asymm 241 $ OnionAnnounce Asymm
@@ -221,7 +251,7 @@ getUDPNodes tcp seeking dst = do
221 r <- sendQuery (tcpClient tcp) meth (AnnounceRequest zeros32 seeking UDP.zeroID) gateway 251 r <- sendQuery (tcpClient tcp) meth (AnnounceRequest zeros32 seeking UDP.zeroID) gateway
222 forM r $ \response -> do 252 forM r $ \response -> do
223 let (ns,_,mb) = either (const ([],[],Nothing)) (unwrapAnnounceResponse Nothing dst) $ response 253 let (ns,_,mb) = either (const ([],[],Nothing)) (unwrapAnnounceResponse Nothing dst) $ response
224 return (ns,ns, const () <$> mb) 254 return ( (ns,ns, const () <$> mb), gateway )
225 255
226 256
227handleOOB :: PublicKey -> ByteString -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket)) 257handleOOB :: PublicKey -> ByteString -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket))
@@ -243,7 +273,9 @@ tcpPing client dst = sendQuery client meth () dst
243 , method = () 273 , method = ()
244 } 274 }
245 275
246newClient :: TransportCrypto -> IO (Client String () Nonce8 NodeInfo RelayPacket) 276type RelayClient = Client String () Nonce8 NodeInfo RelayPacket
277
278newClient :: TransportCrypto -> IO RelayClient
247newClient crypto = do 279newClient crypto = do
248 net <- toxTCP crypto 280 net <- toxTCP crypto
249 drg <- drgNew 281 drg <- drgNew