diff options
Diffstat (limited to 'src/Network/Address.hs')
-rw-r--r-- | src/Network/Address.hs | 86 |
1 files changed, 28 insertions, 58 deletions
diff --git a/src/Network/Address.hs b/src/Network/Address.hs index d34b0431..9ecd89a3 100644 --- a/src/Network/Address.hs +++ b/src/Network/Address.hs | |||
@@ -71,7 +71,6 @@ module Network.Address | |||
71 | , NodeInfo (..) | 71 | , NodeInfo (..) |
72 | , mapAddress | 72 | , mapAddress |
73 | , traverseAddress | 73 | , traverseAddress |
74 | , rank | ||
75 | 74 | ||
76 | -- * Fingerprint | 75 | -- * Fingerprint |
77 | -- $fingerprint | 76 | -- $fingerprint |
@@ -83,7 +82,7 @@ module Network.Address | |||
83 | -- * Utils | 82 | -- * Utils |
84 | , libUserAgent | 83 | , libUserAgent |
85 | , sockAddrPort | 84 | , sockAddrPort |
86 | , withPort | 85 | , setPort |
87 | , getBindAddress | 86 | , getBindAddress |
88 | ) where | 87 | ) where |
89 | 88 | ||
@@ -148,17 +147,11 @@ sockAddrPort (SockAddrInet6 p _ _ _) = Just p | |||
148 | sockAddrPort _ = Nothing | 147 | sockAddrPort _ = Nothing |
149 | {-# INLINE sockAddrPort #-} | 148 | {-# INLINE sockAddrPort #-} |
150 | 149 | ||
151 | withPort :: SockAddr -> PortNumber -> SockAddr | ||
152 | withPort (SockAddrInet _ ip ) port = SockAddrInet port ip | ||
153 | withPort (SockAddrInet6 _ flow ip scope) port = SockAddrInet6 port flow ip scope | ||
154 | withPort addr _ = addr | ||
155 | {-# INLINE withPort #-} | ||
156 | |||
157 | instance Address a => Address (NodeAddr a) where | 150 | instance Address a => Address (NodeAddr a) where |
158 | toSockAddr NodeAddr {..} = setPort nodePort $ toSockAddr nodeHost | 151 | toSockAddr NodeAddr {..} = setPort nodePort $ toSockAddr nodeHost |
159 | fromSockAddr sa = NodeAddr <$> fromSockAddr sa <*> sockAddrPort sa | 152 | fromSockAddr sa = NodeAddr <$> fromSockAddr sa <*> sockAddrPort sa |
160 | 153 | ||
161 | instance Address a => Address (PeerAddr a) where | 154 | instance Address PeerAddr where |
162 | toSockAddr PeerAddr {..} = setPort peerPort $ toSockAddr peerHost | 155 | toSockAddr PeerAddr {..} = setPort peerPort $ toSockAddr peerHost |
163 | fromSockAddr sa = PeerAddr Nothing <$> fromSockAddr sa <*> sockAddrPort sa | 156 | fromSockAddr sa = PeerAddr Nothing <$> fromSockAddr sa <*> sockAddrPort sa |
164 | 157 | ||
@@ -412,23 +405,18 @@ instance BEncode IPv6 where | |||
412 | {-# INLINE fromBEncode #-} | 405 | {-# INLINE fromBEncode #-} |
413 | #endif | 406 | #endif |
414 | 407 | ||
415 | {----------------------------------------------------------------------- | ||
416 | -- Peer addr | ||
417 | -----------------------------------------------------------------------} | ||
418 | -- TODO check semantic of ord and eq instances | ||
419 | |||
420 | -- | Peer address info normally extracted from peer list or peer | 408 | -- | Peer address info normally extracted from peer list or peer |
421 | -- compact list encoding. | 409 | -- compact list encoding. |
422 | data PeerAddr a = PeerAddr | 410 | data PeerAddr = PeerAddr |
423 | { peerId :: !(Maybe PeerId) | 411 | { peerId :: !(Maybe PeerId) |
424 | 412 | ||
425 | -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved | 413 | -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved |
426 | -- 'HostName'. | 414 | -- 'HostName'. |
427 | , peerHost :: !a | 415 | , peerHost :: !IP |
428 | 416 | ||
429 | -- | The port the peer listenning for incoming P2P sessions. | 417 | -- | The port the peer listenning for incoming P2P sessions. |
430 | , peerPort :: {-# UNPACK #-} !PortNumber | 418 | , peerPort :: {-# UNPACK #-} !PortNumber |
431 | } deriving (Show, Eq, Ord, Typeable, Functor) | 419 | } deriving (Show, Eq, Ord, Typeable) |
432 | 420 | ||
433 | #ifdef VERSION_bencoding | 421 | #ifdef VERSION_bencoding |
434 | peer_ip_key, peer_id_key, peer_port_key :: BKey | 422 | peer_ip_key, peer_id_key, peer_port_key :: BKey |
@@ -437,7 +425,7 @@ peer_id_key = "peer id" | |||
437 | peer_port_key = "port" | 425 | peer_port_key = "port" |
438 | 426 | ||
439 | -- | The tracker's 'announce response' compatible encoding. | 427 | -- | The tracker's 'announce response' compatible encoding. |
440 | instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where | 428 | instance BEncode PeerAddr where |
441 | toBEncode PeerAddr {..} = toDict $ | 429 | toBEncode PeerAddr {..} = toDict $ |
442 | peer_ip_key .=! peerHost | 430 | peer_ip_key .=! peerHost |
443 | .: peer_id_key .=? peerId | 431 | .: peer_id_key .=? peerId |
@@ -457,37 +445,39 @@ instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where | |||
457 | -- | 445 | -- |
458 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | 446 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> |
459 | -- | 447 | -- |
460 | -- TODO: test byte order | 448 | -- WARNING: Input must be exactly 6 or 18 bytes so that we can identify IP version. |
461 | instance (Serialize a) => Serialize (PeerAddr a) where | 449 | -- |
450 | instance Serialize PeerAddr where | ||
462 | put PeerAddr {..} = put peerHost >> put peerPort | 451 | put PeerAddr {..} = put peerHost >> put peerPort |
463 | get = PeerAddr Nothing <$> get <*> get | 452 | get = do |
453 | cnt <- remaining | ||
454 | PeerAddr Nothing <$> isolate (cnt - 2) get <*> get | ||
464 | 455 | ||
465 | -- | @127.0.0.1:6881@ | 456 | -- | @127.0.0.1:6881@ |
466 | instance Default (PeerAddr IPv4) where | 457 | instance Default PeerAddr where |
467 | def = "127.0.0.1:6881" | 458 | def = "127.0.0.1:6881" |
468 | 459 | ||
469 | -- | @127.0.0.1:6881@ | ||
470 | instance Default (PeerAddr IP) where | ||
471 | def = IPv4 <$> def | ||
472 | |||
473 | -- | Example: | 460 | -- | Example: |
474 | -- | 461 | -- |
475 | -- @peerPort \"127.0.0.1:6881\" == 6881@ | 462 | -- @peerPort \"127.0.0.1:6881\" == 6881@ |
476 | -- | 463 | -- |
477 | instance IsString (PeerAddr IPv4) where | 464 | instance IsString PeerAddr where |
478 | fromString str | 465 | fromString str |
479 | | [hostAddrStr, portStr] <- splitWhen (== ':') str | 466 | | [hostAddrStr, portStr] <- splitWhen (== ':') str |
480 | , Just hostAddr <- readMaybe hostAddrStr | 467 | , Just hostAddr <- readMaybe hostAddrStr |
481 | , Just portNum <- toEnum <$> readMaybe portStr | 468 | , Just portNum <- toEnum <$> readMaybe portStr |
482 | = PeerAddr Nothing hostAddr portNum | 469 | = PeerAddr Nothing (IPv4 hostAddr) portNum |
483 | | otherwise = error $ "fromString: unable to parse (PeerAddr IPv4): " ++ str | 470 | | [((ip,port),"")] <- readsIPv6_port str = |
471 | PeerAddr Nothing (IPv6 ip) port | ||
472 | | otherwise = error $ "fromString: unable to parse IP: " ++ str | ||
484 | 473 | ||
485 | instance Read (PeerAddr IPv4) where | 474 | instance Read PeerAddr where |
486 | readsPrec i = RP.readP_to_S $ do | 475 | readsPrec i = RP.readP_to_S $ do |
487 | ipv4 <- RP.readS_to_P (readsPrec i) | 476 | ip <- IPv4 <$> ( RP.readS_to_P (readsPrec i) ) |
477 | <|> IPv6 <$> ( RP.char '[' *> (RP.readS_to_P reads) <* RP.char ']' ) | ||
488 | _ <- RP.char ':' | 478 | _ <- RP.char ':' |
489 | port <- toEnum <$> RP.readS_to_P (readsPrec i) | 479 | port <- toEnum <$> RP.readS_to_P (readsPrec i) |
490 | return $ PeerAddr Nothing ipv4 port | 480 | return $ PeerAddr Nothing ip port |
491 | 481 | ||
492 | readsIPv6_port :: String -> [((IPv6, PortNumber), String)] | 482 | readsIPv6_port :: String -> [((IPv6, PortNumber), String)] |
493 | readsIPv6_port = RP.readP_to_S $ do | 483 | readsIPv6_port = RP.readP_to_S $ do |
@@ -496,27 +486,16 @@ readsIPv6_port = RP.readP_to_S $ do | |||
496 | port <- toEnum <$> read <$> (RP.many1 $ RP.satisfy isDigit) <* RP.eof | 486 | port <- toEnum <$> read <$> (RP.many1 $ RP.satisfy isDigit) <* RP.eof |
497 | return (ip,port) | 487 | return (ip,port) |
498 | 488 | ||
499 | instance IsString (PeerAddr IPv6) where | ||
500 | fromString str | ||
501 | | [((ip,port),"")] <- readsIPv6_port str = | ||
502 | PeerAddr Nothing ip port | ||
503 | | otherwise = error $ "fromString: unable to parse (PeerAddr IPv6): " ++ str | ||
504 | |||
505 | instance IsString (PeerAddr IP) where | ||
506 | fromString str | ||
507 | | '[' `L.elem` str = IPv6 <$> fromString str | ||
508 | | otherwise = IPv4 <$> fromString str | ||
509 | 489 | ||
510 | -- | fingerprint + "at" + dotted.host.inet.addr:port | 490 | -- | fingerprint + "at" + dotted.host.inet.addr:port |
511 | -- TODO: instances for IPv6, HostName | 491 | instance Pretty PeerAddr where |
512 | instance Pretty a => Pretty (PeerAddr a) where | ||
513 | pPrint PeerAddr {..} | 492 | pPrint PeerAddr {..} |
514 | | Just pid <- peerId = pPrint (fingerprint pid) <+> "at" <+> paddr | 493 | | Just pid <- peerId = pPrint (fingerprint pid) <+> "at" <+> paddr |
515 | | otherwise = paddr | 494 | | otherwise = paddr |
516 | where | 495 | where |
517 | paddr = pPrint peerHost <> ":" <> text (show peerPort) | 496 | paddr = pPrint peerHost <> ":" <> text (show peerPort) |
518 | 497 | ||
519 | instance Hashable a => Hashable (PeerAddr a) where | 498 | instance Hashable PeerAddr where |
520 | hashWithSalt s PeerAddr {..} = | 499 | hashWithSalt s PeerAddr {..} = |
521 | s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort | 500 | s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort |
522 | 501 | ||
@@ -524,10 +503,7 @@ instance Hashable a => Hashable (PeerAddr a) where | |||
524 | defaultPorts :: [PortNumber] | 503 | defaultPorts :: [PortNumber] |
525 | defaultPorts = [6881..6889] | 504 | defaultPorts = [6881..6889] |
526 | 505 | ||
527 | _resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i | 506 | _peerSockAddr :: PeerAddr -> (Family, SockAddr) |
528 | _resolvePeerAddr = undefined | ||
529 | |||
530 | _peerSockAddr :: PeerAddr IP -> (Family, SockAddr) | ||
531 | _peerSockAddr PeerAddr {..} = | 507 | _peerSockAddr PeerAddr {..} = |
532 | case peerHost of | 508 | case peerHost of |
533 | IPv4 ipv4 -> | 509 | IPv4 ipv4 -> |
@@ -535,11 +511,11 @@ _peerSockAddr PeerAddr {..} = | |||
535 | IPv6 ipv6 -> | 511 | IPv6 ipv6 -> |
536 | (AF_INET6, SockAddrInet6 peerPort 0 (toHostAddress6 ipv6) 0) | 512 | (AF_INET6, SockAddrInet6 peerPort 0 (toHostAddress6 ipv6) 0) |
537 | 513 | ||
538 | peerSockAddr :: PeerAddr IP -> SockAddr | 514 | peerSockAddr :: PeerAddr -> SockAddr |
539 | peerSockAddr = snd . _peerSockAddr | 515 | peerSockAddr = snd . _peerSockAddr |
540 | 516 | ||
541 | -- | Create a socket connected to the address specified in a peerAddr | 517 | -- | Create a socket connected to the address specified in a peerAddr |
542 | peerSocket :: SocketType -> PeerAddr IP -> IO Socket | 518 | peerSocket :: SocketType -> PeerAddr -> IO Socket |
543 | peerSocket socketType pa = do | 519 | peerSocket socketType pa = do |
544 | let (family, addr) = _peerSockAddr pa | 520 | let (family, addr) = _peerSockAddr pa |
545 | sock <- socket family socketType defaultProtocol | 521 | sock <- socket family socketType defaultProtocol |
@@ -607,7 +583,7 @@ instance BEncode a => BEncode (NodeAddr a) where | |||
607 | {-# INLINE fromBEncode #-} | 583 | {-# INLINE fromBEncode #-} |
608 | #endif | 584 | #endif |
609 | 585 | ||
610 | fromPeerAddr :: PeerAddr a -> NodeAddr a | 586 | fromPeerAddr :: PeerAddr -> NodeAddr IP |
611 | fromPeerAddr PeerAddr {..} = NodeAddr | 587 | fromPeerAddr PeerAddr {..} = NodeAddr |
612 | { nodeHost = peerHost | 588 | { nodeHost = peerHost |
613 | , nodePort = peerPort | 589 | , nodePort = peerPort |
@@ -615,12 +591,6 @@ fromPeerAddr PeerAddr {..} = NodeAddr | |||
615 | 591 | ||
616 | ------------------------------------------------------------------------ | 592 | ------------------------------------------------------------------------ |
617 | 593 | ||
618 | -- | Order by closeness: nearest nodes first. | ||
619 | rank :: ( Ord (NodeId dht) | ||
620 | , Bits (NodeId dht) | ||
621 | ) => (x -> NodeId dht) -> NodeId dht -> [x] -> [x] | ||
622 | rank f nid = L.sortBy (comparing (RPC.distance nid . f)) | ||
623 | |||
624 | {----------------------------------------------------------------------- | 594 | {----------------------------------------------------------------------- |
625 | -- Fingerprint | 595 | -- Fingerprint |
626 | -----------------------------------------------------------------------} | 596 | -----------------------------------------------------------------------} |