Prefer IPv4 when parsing TCP nodes JSON.

2 files changed, 21 insertions, 3 deletions

diff --git a/dht/src/Data/Tox/Msg.hs b/dht/src/Data/Tox/Msg.hs
index 66ec6eb1..8819faa7 100644
--- a/dht/src/Data/Tox/Msg.hs
+++ b/dht/src/Data/Tox/Msg.hs
@@ -97,6 +97,7 @@ deriving instance (Show (Pkt a))
 
 type CryptoMessage = DSum Pkt Identity
 
+msgID :: DSum Pkt Identity -> SomeMsg
 msgID (Pkt mid :=> Identity _) = M mid
 
 -- TODO
@@ -227,6 +228,7 @@ fromEnum8 = fromIntegral . fromEnum
 
 data LossyOrLossless = Lossless | Lossy deriving (Eq,Ord,Enum,Show,Bounded)
 
+someLossyness :: SomeMsg -> LossyOrLossless
 someLossyness (M m) = lossyness m
 
 lossyness :: KnownNat n => Msg n t -> LossyOrLossless
diff --git a/dht/src/Data/Tox/Relay.hs b/dht/src/Data/Tox/Relay.hs
index c563db8d..f28a1685 100644
--- a/dht/src/Data/Tox/Relay.hs
+++ b/dht/src/Data/Tox/Relay.hs
@@ -16,7 +16,9 @@ import Data.Data
 import Data.Functor.Contravariant
 import Data.Hashable
 import qualified Data.HashMap.Strict as HashMap
+import Data.List
 import Data.Monoid
+import Data.Ord
 import Data.Serialize
 import qualified Data.Vector as Vector
 import Data.Word
@@ -217,13 +219,27 @@ instance ToJSON NodeInfo where
                                                         tbl
         x               -> x -- Shouldn't happen.
 
+tcpPortScore :: Word16 -> Word16
+tcpPortScore 443  = 0
+tcpPortScore 80   = 0
+tcpPortScore 3389 = 1
+tcpPortScore _    = 2
+
 instance FromJSON NodeInfo where
     parseJSON json = do
-        udp <- parseJSON json
+        -- Instead of using ordinary parseJSON to parse the udp node,
+        -- we are using a variation that prefers IPv4 over IPv6.
+        -- The rationale is that must lans without UDP will be using
+        -- IPv4.
+        udp <- UDP.nodeInfoFromJSON True json
         port <- case json of
             JSON.Object v -> do
-                portnum:_ <- v JSON..: "tcp_ports"
-                return  (fromIntegral (portnum :: Word16))
+                ps <- v JSON..: "tcp_ports"
+                if Prelude.null (ps :: [Word16])
+                    then fail "TCP.NodeInfo: missing tcp port"
+                    else do
+                        let portnum = minimumBy (comparing tcpPortScore) ps
+                        return  (fromIntegral portnum)
             _ -> fail "TCP.NodeInfo: Expected JSON object."
         return $ NodeInfo udp port