diff options
Diffstat (limited to 'dht/src/Data/Tox/Relay.hs')
-rw-r--r-- | dht/src/Data/Tox/Relay.hs | 22 |
1 files changed, 19 insertions, 3 deletions
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 | |||
16 | import Data.Functor.Contravariant | 16 | import Data.Functor.Contravariant |
17 | import Data.Hashable | 17 | import Data.Hashable |
18 | import qualified Data.HashMap.Strict as HashMap | 18 | import qualified Data.HashMap.Strict as HashMap |
19 | import Data.List | ||
19 | import Data.Monoid | 20 | import Data.Monoid |
21 | import Data.Ord | ||
20 | import Data.Serialize | 22 | import Data.Serialize |
21 | import qualified Data.Vector as Vector | 23 | import qualified Data.Vector as Vector |
22 | import Data.Word | 24 | import Data.Word |
@@ -217,13 +219,27 @@ instance ToJSON NodeInfo where | |||
217 | tbl | 219 | tbl |
218 | x -> x -- Shouldn't happen. | 220 | x -> x -- Shouldn't happen. |
219 | 221 | ||
222 | tcpPortScore :: Word16 -> Word16 | ||
223 | tcpPortScore 443 = 0 | ||
224 | tcpPortScore 80 = 0 | ||
225 | tcpPortScore 3389 = 1 | ||
226 | tcpPortScore _ = 2 | ||
227 | |||
220 | instance FromJSON NodeInfo where | 228 | instance FromJSON NodeInfo where |
221 | parseJSON json = do | 229 | parseJSON json = do |
222 | udp <- parseJSON json | 230 | -- Instead of using ordinary parseJSON to parse the udp node, |
231 | -- we are using a variation that prefers IPv4 over IPv6. | ||
232 | -- The rationale is that must lans without UDP will be using | ||
233 | -- IPv4. | ||
234 | udp <- UDP.nodeInfoFromJSON True json | ||
223 | port <- case json of | 235 | port <- case json of |
224 | JSON.Object v -> do | 236 | JSON.Object v -> do |
225 | portnum:_ <- v JSON..: "tcp_ports" | 237 | ps <- v JSON..: "tcp_ports" |
226 | return (fromIntegral (portnum :: Word16)) | 238 | if Prelude.null (ps :: [Word16]) |
239 | then fail "TCP.NodeInfo: missing tcp port" | ||
240 | else do | ||
241 | let portnum = minimumBy (comparing tcpPortScore) ps | ||
242 | return (fromIntegral portnum) | ||
227 | _ -> fail "TCP.NodeInfo: Expected JSON object." | 243 | _ -> fail "TCP.NodeInfo: Expected JSON object." |
228 | return $ NodeInfo udp port | 244 | return $ NodeInfo udp port |
229 | 245 | ||