summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Core/PeerAddr.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Core/PeerAddr.hs')
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs41
1 files changed, 20 insertions, 21 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index 6c6056c9..88239d0b 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -21,11 +21,6 @@ module Network.BitTorrent.Core.PeerAddr
21 PeerAddr(..) 21 PeerAddr(..)
22 , defaultPorts 22 , defaultPorts
23 , peerSockAddr 23 , peerSockAddr
24
25 -- * IP
26 , mergeIPLists
27 , splitIPList
28 , IPAddress ()
29 ) where 24 ) where
30 25
31import Control.Applicative 26import Control.Applicative
@@ -36,8 +31,6 @@ import Data.BEncode.BDict (BKey)
36import Data.ByteString.Char8 as BS8 31import Data.ByteString.Char8 as BS8
37import Data.Char 32import Data.Char
38import Data.Default 33import Data.Default
39import Data.Either
40import Data.Foldable
41import Data.IP 34import Data.IP
42import Data.List as L 35import Data.List as L
43import Data.List.Split 36import Data.List.Split
@@ -86,13 +79,16 @@ class IPAddress i where
86 79
87instance IPAddress IPv4 where 80instance IPAddress IPv4 where
88 toHostAddr = Left . toHostAddress 81 toHostAddr = Left . toHostAddress
82 {-# INLINE toHostAddr #-}
89 83
90instance IPAddress IPv6 where 84instance IPAddress IPv6 where
91 toHostAddr = Right . toHostAddress6 85 toHostAddr = Right . toHostAddress6
86 {-# INLINE toHostAddr #-}
92 87
93instance IPAddress IP where 88instance IPAddress IP where
94 toHostAddr (IPv4 ip) = toHostAddr ip 89 toHostAddr (IPv4 ip) = toHostAddr ip
95 toHostAddr (IPv6 ip) = toHostAddr ip 90 toHostAddr (IPv6 ip) = toHostAddr ip
91 {-# INLINE toHostAddr #-}
96 92
97deriving instance Typeable IP 93deriving instance Typeable IP
98deriving instance Typeable IPv4 94deriving instance Typeable IPv4
@@ -100,6 +96,7 @@ deriving instance Typeable IPv6
100 96
101ipToBEncode :: Show i => i -> BValue 97ipToBEncode :: Show i => i -> BValue
102ipToBEncode ip = BString $ BS8.pack $ show ip 98ipToBEncode ip = BString $ BS8.pack $ show ip
99{-# INLINE ipToBEncode #-}
103 100
104ipFromBEncode :: Read a => BValue -> BS.Result a 101ipFromBEncode :: Read a => BValue -> BS.Result a
105ipFromBEncode (BString (BS8.unpack -> ipStr)) 102ipFromBEncode (BString (BS8.unpack -> ipStr))
@@ -107,17 +104,25 @@ ipFromBEncode (BString (BS8.unpack -> ipStr))
107 | otherwise = decodingError $ "IP: " ++ ipStr 104 | otherwise = decodingError $ "IP: " ++ ipStr
108ipFromBEncode _ = decodingError $ "IP: addr should be a bstring" 105ipFromBEncode _ = decodingError $ "IP: addr should be a bstring"
109 106
107instance Ord IP where
108
110instance BEncode IP where 109instance BEncode IP where
111 toBEncode = ipToBEncode 110 toBEncode = ipToBEncode
111 {-# INLINE toBEncode #-}
112 fromBEncode = ipFromBEncode 112 fromBEncode = ipFromBEncode
113 {-# INLINE fromBEncode #-}
113 114
114instance BEncode IPv4 where 115instance BEncode IPv4 where
115 toBEncode = ipToBEncode 116 toBEncode = ipToBEncode
117 {-# INLINE toBEncode #-}
116 fromBEncode = ipFromBEncode 118 fromBEncode = ipFromBEncode
119 {-# INLINE fromBEncode #-}
117 120
118instance BEncode IPv6 where 121instance BEncode IPv6 where
119 toBEncode = ipToBEncode 122 toBEncode = ipToBEncode
123 {-# INLINE toBEncode #-}
120 fromBEncode = ipFromBEncode 124 fromBEncode = ipFromBEncode
125 {-# INLINE fromBEncode #-}
121 126
122instance Serialize IPv4 where 127instance Serialize IPv4 where
123 put = putWord32host . toHostAddress 128 put = putWord32host . toHostAddress
@@ -136,9 +141,14 @@ instance Serialize IPv6 where
136-- compact list encoding. 141-- compact list encoding.
137data PeerAddr a = PeerAddr 142data PeerAddr a = PeerAddr
138 { peerId :: !(Maybe PeerId) 143 { peerId :: !(Maybe PeerId)
144
145 -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved
146 -- 'HostName'.
139 , peerHost :: !a 147 , peerHost :: !a
148
149 -- | The port the peer listenning for incoming P2P sessions.
140 , peerPort :: {-# UNPACK #-} !PortNumber 150 , peerPort :: {-# UNPACK #-} !PortNumber
141 } deriving (Show, Eq, Typeable, Functor) 151 } deriving (Show, Eq, Ord, Typeable, Functor)
142 152
143peer_ip_key, peer_id_key, peer_port_key :: BKey 153peer_ip_key, peer_id_key, peer_port_key :: BKey
144peer_ip_key = "ip" 154peer_ip_key = "ip"
@@ -160,17 +170,6 @@ instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where
160 where 170 where
161 peerAddr = flip PeerAddr 171 peerAddr = flip PeerAddr
162 172
163mergeIPLists :: [PeerAddr IPv4] -> Maybe [PeerAddr IPv6] -> [PeerAddr IP]
164mergeIPLists v4 v6 = (fmap IPv4 `L.map` v4)
165 ++ (fmap IPv6 `L.map` Data.Foldable.concat v6)
166
167splitIPList :: [PeerAddr IP] -> ([PeerAddr IPv4],[PeerAddr IPv6])
168splitIPList xs = partitionEithers $ toEither <$> xs
169 where
170 toEither :: PeerAddr IP -> Either (PeerAddr IPv4) (PeerAddr IPv6)
171 toEither pa@(PeerAddr _ (IPv4 _) _) = Left (ipv4 <$> pa)
172 toEither pa@(PeerAddr _ (IPv6 _) _) = Right (ipv6 <$> pa)
173
174-- | The tracker's 'compact peer list' compatible encoding. The 173-- | The tracker's 'compact peer list' compatible encoding. The
175-- 'peerId' is always 'Nothing'. 174-- 'peerId' is always 'Nothing'.
176-- 175--
@@ -231,8 +230,8 @@ defaultPorts = [6881..6889]
231_resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i 230_resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i
232_resolvePeerAddr = undefined 231_resolvePeerAddr = undefined
233 232
234-- | Convert peer info from tracker response to socket address. Used 233-- | Convert peer info from tracker or DHT announce query response to
235-- for establish connection between peers. 234-- socket address. Usually used to intiate connection between peers.
236-- 235--
237peerSockAddr :: PeerAddr IP -> SockAddr 236peerSockAddr :: PeerAddr IP -> SockAddr
238peerSockAddr PeerAddr {..} = 237peerSockAddr PeerAddr {..} =