1 files changed, 89 insertions, 0 deletions

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