Share TCP Relays with remote via onion message.

6 files changed, 102 insertions, 11 deletions

diff --git a/dht/src/Network/Tox/DHT/Handlers.hs b/dht/src/Network/Tox/DHT/Handlers.hs
index e93f565b..323d5f5e 100644
--- a/dht/src/Network/Tox/DHT/Handlers.hs
+++ b/dht/src/Network/Tox/DHT/Handlers.hs
@@ -7,6 +7,7 @@ module Network.Tox.DHT.Handlers where
 
 import Debug.Trace
 import Network.Tox.DHT.Transport as DHTTransport
+import Network.Tox.TCP.NodeId as TCP (fromUDPNode, udpNodeInfo)
 import Network.QueryResponse as QR hiding (Client)
 import qualified Network.QueryResponse as QR (Client)
 import Crypto.Tox
@@ -257,6 +258,7 @@ getNodesH routing addr (GetNodes nid) = do
                                       Want_IP4 -> (ks,ks6)
                                       Want_Both -> error $ "BUG:unreachable at " ++ __FILE__ ++ ":" ++ show __LINE__
     return $ SendNodes
+           $ map fromUDPNode
            $ if null ns2 then ns1
                          else take 4 (take 3 ns1 ++ ns2)
  where
@@ -397,8 +399,9 @@ unsendNodes :: Message -> Maybe (Asymm (Nonce8,SendNodes))
 unsendNodes (DHTSendNodes asymm) = Just asymm
 unsendNodes _                    = Nothing
 
+-- XXX: map udpNodeInfo is probably not right
 unwrapNodes :: SendNodes -> ( [NodeInfo], [NodeInfo], Maybe () )
-unwrapNodes (SendNodes ns) = (ns,ns,Just ())
+unwrapNodes (SendNodes ns) = (map udpNodeInfo ns,map udpNodeInfo ns,Just ())
 
 getNodes :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ()))
 getNodes client cbvar nid addr = do
@@ -409,10 +412,10 @@ getNodes client cbvar nid addr = do
         forM_ ns $ \n -> do
             now <- getPOSIXTime
             atomically $ do
-                mcbs <- HashMap.lookup (nodeId n) <$> readTVar cbvar
+                mcbs <- HashMap.lookup (nodeId . udpNodeInfo $ n) <$> readTVar cbvar
                 forM_ mcbs $ \cbs -> do
                     forM_ cbs $ \cb -> do
-                        rumoredAddress cb now (nodeAddr addr) n
+                        rumoredAddress cb now (nodeAddr addr) (udpNodeInfo n)
     return $ fmap unwrapNodes $ join reply
 
 updateRouting :: Client -> Routing
diff --git a/dht/src/Network/Tox/DHT/Transport.hs b/dht/src/Network/Tox/DHT/Transport.hs
index b9b63165..7475b3b1 100644
--- a/dht/src/Network/Tox/DHT/Transport.hs
+++ b/dht/src/Network/Tox/DHT/Transport.hs
@@ -36,6 +36,7 @@ module Network.Tox.DHT.Transport
     ) where
 
 import Network.Tox.NodeId
+import qualified Network.Tox.TCP.NodeId as TCP
 import Crypto.Tox hiding (encrypt,decrypt)
 import qualified Crypto.Tox as ToxCrypto
 import Network.QueryResponse
@@ -315,7 +316,7 @@ newtype GetNodes = GetNodes NodeId
 instance Sized GetNodes where
     size = ConstSize 32 -- TODO This right?
 
-newtype SendNodes = SendNodes [NodeInfo]
+newtype SendNodes = SendNodes [TCP.NodeInfo]
     deriving (Eq,Ord,Show,Read)
 
 instance Sized SendNodes where
diff --git a/dht/src/Network/Tox/NodeId.hs b/dht/src/Network/Tox/NodeId.hs
index 6c82ce09..8567e77d 100644
--- a/dht/src/Network/Tox/NodeId.hs
+++ b/dht/src/Network/Tox/NodeId.hs
@@ -252,8 +252,8 @@ nodeInfoFromJSON prefer4 (JSON.Object v) = do
 getIP :: Word8 -> S.Get IP
 getIP 0x02 = IPv4 <$> S.get
 getIP 0x0a = IPv6 <$> S.get
-getIP 0x82 = IPv4 <$> S.get -- TODO: TCP
-getIP 0x8a = IPv6 <$> S.get -- TODO: TCP
+getIP 0x82 = IPv4 <$> S.get -- TODO: TCP TOX_TCP_INET
+getIP 0x8a = IPv6 <$> S.get -- TODO: TCP TOX_TCP_INET6
 getIP x    = fail ("unsupported address family ("++show x++")")
 
 instance Sized NodeInfo where
diff --git a/dht/src/Network/Tox/Onion/Handlers.hs b/dht/src/Network/Tox/Onion/Handlers.hs
index b35631a3..52dcf536 100644
--- a/dht/src/Network/Tox/Onion/Handlers.hs
+++ b/dht/src/Network/Tox/Onion/Handlers.hs
@@ -4,6 +4,7 @@
 module Network.Tox.Onion.Handlers where
 
 import Network.Kademlia.Search
+import Network.Tox.TCP.NodeId (udpNodeInfo)
 import Network.Tox.DHT.Transport
 import Network.Tox.DHT.Handlers hiding (Message,Client)
 import Network.Tox.Onion.Transport
@@ -251,7 +252,7 @@ announceSerializer getTimeout = MethodSerializer
     }
 
 unwrapAnnounceResponse :: Maybe NodeId -> NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32)
-unwrapAnnounceResponse alias ni (AnnounceResponse is_stored (SendNodes ns))
+unwrapAnnounceResponse alias ni (AnnounceResponse is_stored (SendNodes ns0)) | let ns = map udpNodeInfo ns0
     = case is_stored of
         NotStored n32    -> ( ns , []                                                        , Just n32)
         SendBackKey k    -> ( ns , [Rendezvous k ni]                                         , Nothing )
diff --git a/dht/src/Network/Tox/TCP.hs b/dht/src/Network/Tox/TCP.hs
index e80a22d1..1531dfb4 100644
--- a/dht/src/Network/Tox/TCP.hs
+++ b/dht/src/Network/Tox/TCP.hs
@@ -44,6 +44,7 @@ import Network.Kademlia.Routing
 import Network.Kademlia.Search hiding (sendQuery)
 import Network.QueryResponse
 import Network.QueryResponse.TCP
+import Network.Tox.TCP.NodeId ()
 import Network.Tox.DHT.Handlers (toxSpace)
 import Network.Tox.Onion.Transport hiding (encrypt,decrypt)
 import Network.Tox.Onion.Handlers (unwrapAnnounceResponse)
@@ -57,10 +58,6 @@ withSize f = case size of len -> f len
 
 type NodeId = UDP.NodeId
 
--- example:
--- KEyW2Bm.S-DpIGp72380BAfgintUWX1KX.6ZU.4m5Ex@80.99.99.99:33400{tcp:443}
-instance Show NodeInfo where
-    show (NodeInfo udp port) = show udp ++ "{tcp:"++show port++"}"
 
 nodeId :: NodeInfo -> NodeId
 nodeId ni = UDP.nodeId $ udpNodeInfo ni
diff --git a/dht/src/Network/Tox/TCP/NodeId.hs b/dht/src/Network/Tox/TCP/NodeId.hs
new file mode 100644
index 00000000..c218c88f
--- /dev/null
+++ b/dht/src/Network/Tox/TCP/NodeId.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE CPP #-}
+module Network.Tox.TCP.NodeId where
+
+import Crypto.Tox
+import qualified Network.Tox.NodeId as UDP
+
+import qualified Data.Aeson                   as JSON
+         ;import Data.Aeson                   (FromJSON (..), ToJSON (..))
+import Data.Functor.Contravariant
+import Data.Hashable
+import qualified Data.HashMap.Strict          as HashMap
+import qualified Data.Vector                  as Vector
+import Data.Word
+import Network.Socket
+import qualified Text.ParserCombinators.ReadP as RP
+import Data.Serialize as S
+
+#if MIN_VERSION_iproute(1,7,4)
+import Data.IP hiding (fromSockAddr)
+#else
+import Data.IP
+#endif
+
+data NodeInfo = NodeInfo
+    { udpNodeInfo :: UDP.NodeInfo
+    , tcpPort     :: PortNumber
+    }
+ deriving (Eq,Ord)
+
+instance Read NodeInfo where
+    readsPrec _ = RP.readP_to_S $ do
+        udp <- RP.readS_to_P reads
+        port <- RP.between (RP.char '{') (RP.char '}') $ do
+                    mapM_ RP.char ("tcp:" :: String)
+                    w16 <- RP.readS_to_P reads
+                    return $ fromIntegral (w16 :: Word16)
+        return $ NodeInfo udp port
+
+instance ToJSON NodeInfo where
+    toJSON (NodeInfo udp port) = case (toJSON udp) of
+        JSON.Object tbl -> JSON.Object $ HashMap.insert "tcp_ports"
+                                                        (JSON.Array $ Vector.fromList
+                                                            [JSON.Number (fromIntegral port)])
+                                                        tbl
+        x               -> x -- Shouldn't happen.
+
+-- example:
+-- KEyW2Bm.S-DpIGp72380BAfgintUWX1KX.6ZU.4m5Ex@80.99.99.99:33400{tcp:443}
+instance Show NodeInfo where
+    show (NodeInfo udp port) = show udp ++ "{tcp:"++show port++"}"
+
+instance Sized NodeInfo where
+    size = contramap udpNodeInfo size
+
+
+getIP :: Word8 -> S.Get (Bool, IP)
+getIP 0x02 = (,) False . IPv4 <$> S.get -- UDP 4
+getIP 0x0a = (,) False . IPv6 <$> S.get -- UDP 6
+getIP 0x82 = (,) True . IPv4 <$> S.get -- TCP 4
+getIP 0x8a = (,) True . IPv6 <$> S.get -- TCP 6
+getIP x    = fail ("unsupported address family ("++show x++")")
+
+instance S.Serialize NodeInfo where
+    get = do
+        addrfam <- S.get :: S.Get Word8
+        (istcp, ip) <- getIP addrfam
+        port <- S.get :: S.Get PortNumber
+        nid <- S.get
+        let (udpport, tcpport) = if istcp
+                                    then (0, port)
+                                    else (port, 0)
+        return $ NodeInfo (UDP.NodeInfo nid ip udpport) tcpport
+
+    put (NodeInfo (UDP.NodeInfo nid ip udpport) tcpport) = do
+        if tcpport==0
+            then do
+                case ip of
+                    IPv4 ip4 -> S.put (2 :: Word8) >> S.put ip4
+                    IPv6 ip6 -> S.put (10 :: Word8) >> S.put ip6
+                S.put udpport
+            else do
+                case ip of
+                    IPv4 ip4 -> S.put (0x82 :: Word8) >> S.put ip4
+                    IPv6 ip6 -> S.put (0x8a :: Word8) >> S.put ip6
+                S.put tcpport
+        S.put nid
+
+fromUDPNode :: UDP.NodeInfo -> NodeInfo
+fromUDPNode ni = NodeInfo ni 0