diff options
Diffstat (limited to 'src/Network/BitTorrent/Core/PeerAddr.hs')
-rw-r--r-- | src/Network/BitTorrent/Core/PeerAddr.hs | 312 |
1 files changed, 0 insertions, 312 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs deleted file mode 100644 index e9ad7c96..00000000 --- a/src/Network/BitTorrent/Core/PeerAddr.hs +++ /dev/null | |||
@@ -1,312 +0,0 @@ | |||
1 | -- | | ||
2 | -- Module : Network.BitTorrent.Core.PeerAddr | ||
3 | -- Copyright : (c) Sam Truzjan 2013 | ||
4 | -- (c) Daniel Gröber 2013 | ||
5 | -- License : BSD3 | ||
6 | -- Maintainer : pxqr.sta@gmail.com | ||
7 | -- Stability : provisional | ||
8 | -- Portability : portable | ||
9 | -- | ||
10 | -- 'PeerAddr' is used to represent peer address. Currently it's | ||
11 | -- just peer IP and peer port but this might change in future. | ||
12 | -- | ||
13 | {-# LANGUAGE TemplateHaskell #-} | ||
14 | {-# LANGUAGE StandaloneDeriving #-} | ||
15 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
16 | {-# LANGUAGE DeriveDataTypeable #-} | ||
17 | {-# LANGUAGE FlexibleInstances #-} | ||
18 | {-# LANGUAGE DeriveFunctor #-} | ||
19 | {-# LANGUAGE ViewPatterns #-} | ||
20 | {-# OPTIONS -fno-warn-orphans #-} -- for PortNumber instances | ||
21 | module Network.BitTorrent.Core.PeerAddr | ||
22 | ( -- * Peer address | ||
23 | PeerAddr(..) | ||
24 | , defaultPorts | ||
25 | , peerSockAddr | ||
26 | , peerSocket | ||
27 | |||
28 | -- * Peer storage | ||
29 | ) where | ||
30 | |||
31 | import Control.Applicative | ||
32 | import Control.Monad | ||
33 | import Data.BEncode as BS | ||
34 | import Data.BEncode.BDict (BKey) | ||
35 | import Data.ByteString.Char8 as BS8 | ||
36 | import Data.Char | ||
37 | import Data.Default | ||
38 | import Data.Hashable | ||
39 | import Data.IP | ||
40 | import Data.List as L | ||
41 | import Data.List.Split | ||
42 | import Data.Monoid | ||
43 | import Data.Serialize as S | ||
44 | import Data.String | ||
45 | import Data.Typeable | ||
46 | import Data.Word | ||
47 | import Network.Socket | ||
48 | import Text.PrettyPrint as PP hiding ((<>)) | ||
49 | import Text.PrettyPrint.Class | ||
50 | import Text.Read (readMaybe) | ||
51 | import qualified Text.ParserCombinators.ReadP as RP | ||
52 | |||
53 | --import Data.Torrent | ||
54 | import Network.BitTorrent.Core.PeerId | ||
55 | |||
56 | |||
57 | {----------------------------------------------------------------------- | ||
58 | -- Port number | ||
59 | -----------------------------------------------------------------------} | ||
60 | |||
61 | instance BEncode PortNumber where | ||
62 | toBEncode = toBEncode . fromEnum | ||
63 | fromBEncode = fromBEncode >=> portNumber | ||
64 | where | ||
65 | portNumber :: Integer -> BS.Result PortNumber | ||
66 | portNumber n | ||
67 | | 0 <= n && n <= fromIntegral (maxBound :: Word16) | ||
68 | = pure $ fromIntegral n | ||
69 | | otherwise = decodingError $ "PortNumber: " ++ show n | ||
70 | |||
71 | instance Serialize PortNumber where | ||
72 | get = fromIntegral <$> getWord16be | ||
73 | {-# INLINE get #-} | ||
74 | put = putWord16be . fromIntegral | ||
75 | {-# INLINE put #-} | ||
76 | |||
77 | instance Hashable PortNumber where | ||
78 | hashWithSalt s = hashWithSalt s . fromEnum | ||
79 | {-# INLINE hashWithSalt #-} | ||
80 | |||
81 | instance Pretty PortNumber where | ||
82 | pretty = PP.int . fromEnum | ||
83 | {-# INLINE pretty #-} | ||
84 | |||
85 | {----------------------------------------------------------------------- | ||
86 | -- IP addr | ||
87 | -----------------------------------------------------------------------} | ||
88 | |||
89 | class IPAddress i where | ||
90 | toHostAddr :: i -> Either HostAddress HostAddress6 | ||
91 | |||
92 | instance IPAddress IPv4 where | ||
93 | toHostAddr = Left . toHostAddress | ||
94 | {-# INLINE toHostAddr #-} | ||
95 | |||
96 | instance IPAddress IPv6 where | ||
97 | toHostAddr = Right . toHostAddress6 | ||
98 | {-# INLINE toHostAddr #-} | ||
99 | |||
100 | instance IPAddress IP where | ||
101 | toHostAddr (IPv4 ip) = toHostAddr ip | ||
102 | toHostAddr (IPv6 ip) = toHostAddr ip | ||
103 | {-# INLINE toHostAddr #-} | ||
104 | |||
105 | deriving instance Typeable IP | ||
106 | deriving instance Typeable IPv4 | ||
107 | deriving instance Typeable IPv6 | ||
108 | |||
109 | ipToBEncode :: Show i => i -> BValue | ||
110 | ipToBEncode ip = BString $ BS8.pack $ show ip | ||
111 | {-# INLINE ipToBEncode #-} | ||
112 | |||
113 | ipFromBEncode :: Read a => BValue -> BS.Result a | ||
114 | ipFromBEncode (BString (BS8.unpack -> ipStr)) | ||
115 | | Just ip <- readMaybe (ipStr) = pure ip | ||
116 | | otherwise = decodingError $ "IP: " ++ ipStr | ||
117 | ipFromBEncode _ = decodingError $ "IP: addr should be a bstring" | ||
118 | |||
119 | instance BEncode IP where | ||
120 | toBEncode = ipToBEncode | ||
121 | {-# INLINE toBEncode #-} | ||
122 | fromBEncode = ipFromBEncode | ||
123 | {-# INLINE fromBEncode #-} | ||
124 | |||
125 | instance BEncode IPv4 where | ||
126 | toBEncode = ipToBEncode | ||
127 | {-# INLINE toBEncode #-} | ||
128 | fromBEncode = ipFromBEncode | ||
129 | {-# INLINE fromBEncode #-} | ||
130 | |||
131 | instance BEncode IPv6 where | ||
132 | toBEncode = ipToBEncode | ||
133 | {-# INLINE toBEncode #-} | ||
134 | fromBEncode = ipFromBEncode | ||
135 | {-# INLINE fromBEncode #-} | ||
136 | |||
137 | -- | When 'get'ing an IP it must be 'isolate'd to the appropriate | ||
138 | -- number of bytes since we have no other way of telling which | ||
139 | -- address type we are trying to parse | ||
140 | instance Serialize IP where | ||
141 | put (IPv4 ip) = put ip | ||
142 | put (IPv6 ip) = put ip | ||
143 | |||
144 | get = do | ||
145 | n <- remaining | ||
146 | case n of | ||
147 | 4 -> IPv4 <$> get | ||
148 | 16 -> IPv6 <$> get | ||
149 | _ -> fail "Wrong number of bytes remaining to parse IP" | ||
150 | |||
151 | instance Serialize IPv4 where | ||
152 | put = putWord32host . toHostAddress | ||
153 | get = fromHostAddress <$> getWord32host | ||
154 | |||
155 | instance Serialize IPv6 where | ||
156 | put ip = put $ toHostAddress6 ip | ||
157 | get = fromHostAddress6 <$> get | ||
158 | |||
159 | instance Pretty IPv4 where | ||
160 | pretty = PP.text . show | ||
161 | {-# INLINE pretty #-} | ||
162 | |||
163 | instance Pretty IPv6 where | ||
164 | pretty = PP.text . show | ||
165 | {-# INLINE pretty #-} | ||
166 | |||
167 | instance Pretty IP where | ||
168 | pretty = PP.text . show | ||
169 | {-# INLINE pretty #-} | ||
170 | |||
171 | instance Hashable IPv4 where | ||
172 | hashWithSalt = hashUsing toHostAddress | ||
173 | {-# INLINE hashWithSalt #-} | ||
174 | |||
175 | instance Hashable IPv6 where | ||
176 | hashWithSalt s a = hashWithSalt s (toHostAddress6 a) | ||
177 | |||
178 | instance Hashable IP where | ||
179 | hashWithSalt s (IPv4 h) = hashWithSalt s h | ||
180 | hashWithSalt s (IPv6 h) = hashWithSalt s h | ||
181 | |||
182 | {----------------------------------------------------------------------- | ||
183 | -- Peer addr | ||
184 | -----------------------------------------------------------------------} | ||
185 | -- TODO check semantic of ord and eq instances | ||
186 | |||
187 | -- | Peer address info normally extracted from peer list or peer | ||
188 | -- compact list encoding. | ||
189 | data PeerAddr a = PeerAddr | ||
190 | { peerId :: !(Maybe PeerId) | ||
191 | |||
192 | -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved | ||
193 | -- 'HostName'. | ||
194 | , peerHost :: !a | ||
195 | |||
196 | -- | The port the peer listenning for incoming P2P sessions. | ||
197 | , peerPort :: {-# UNPACK #-} !PortNumber | ||
198 | } deriving (Show, Eq, Ord, Typeable, Functor) | ||
199 | |||
200 | peer_ip_key, peer_id_key, peer_port_key :: BKey | ||
201 | peer_ip_key = "ip" | ||
202 | peer_id_key = "peer id" | ||
203 | peer_port_key = "port" | ||
204 | |||
205 | -- | The tracker's 'announce response' compatible encoding. | ||
206 | instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where | ||
207 | toBEncode PeerAddr {..} = toDict $ | ||
208 | peer_ip_key .=! peerHost | ||
209 | .: peer_id_key .=? peerId | ||
210 | .: peer_port_key .=! peerPort | ||
211 | .: endDict | ||
212 | |||
213 | fromBEncode = fromDict $ do | ||
214 | peerAddr <$>! peer_ip_key | ||
215 | <*>? peer_id_key | ||
216 | <*>! peer_port_key | ||
217 | where | ||
218 | peerAddr = flip PeerAddr | ||
219 | |||
220 | -- | The tracker's 'compact peer list' compatible encoding. The | ||
221 | -- 'peerId' is always 'Nothing'. | ||
222 | -- | ||
223 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | ||
224 | -- | ||
225 | -- TODO: test byte order | ||
226 | instance (Serialize a) => Serialize (PeerAddr a) where | ||
227 | put PeerAddr {..} = put peerHost >> put peerPort | ||
228 | get = PeerAddr Nothing <$> get <*> get | ||
229 | |||
230 | -- | @127.0.0.1:6881@ | ||
231 | instance Default (PeerAddr IPv4) where | ||
232 | def = "127.0.0.1:6881" | ||
233 | |||
234 | -- | @127.0.0.1:6881@ | ||
235 | instance Default (PeerAddr IP) where | ||
236 | def = IPv4 <$> def | ||
237 | |||
238 | -- | Example: | ||
239 | -- | ||
240 | -- @peerPort \"127.0.0.1:6881\" == 6881@ | ||
241 | -- | ||
242 | instance IsString (PeerAddr IPv4) where | ||
243 | fromString str | ||
244 | | [hostAddrStr, portStr] <- splitWhen (== ':') str | ||
245 | , Just hostAddr <- readMaybe hostAddrStr | ||
246 | , Just portNum <- toEnum <$> readMaybe portStr | ||
247 | = PeerAddr Nothing hostAddr portNum | ||
248 | | otherwise = error $ "fromString: unable to parse (PeerAddr IPv4): " ++ str | ||
249 | |||
250 | instance Read (PeerAddr IPv4) where | ||
251 | readsPrec i = RP.readP_to_S $ do | ||
252 | ipv4 <- RP.readS_to_P (readsPrec i) | ||
253 | _ <- RP.char ':' | ||
254 | port <- toEnum <$> RP.readS_to_P (readsPrec i) | ||
255 | return $ PeerAddr Nothing ipv4 port | ||
256 | |||
257 | readsIPv6_port :: String -> [((IPv6, PortNumber), String)] | ||
258 | readsIPv6_port = RP.readP_to_S $ do | ||
259 | ip <- RP.char '[' *> (RP.readS_to_P reads) <* RP.char ']' | ||
260 | _ <- RP.char ':' | ||
261 | port <- toEnum <$> read <$> (RP.many1 $ RP.satisfy isDigit) <* RP.eof | ||
262 | return (ip,port) | ||
263 | |||
264 | instance IsString (PeerAddr IPv6) where | ||
265 | fromString str | ||
266 | | [((ip,port),"")] <- readsIPv6_port str = | ||
267 | PeerAddr Nothing ip port | ||
268 | | otherwise = error $ "fromString: unable to parse (PeerAddr IPv6): " ++ str | ||
269 | |||
270 | instance IsString (PeerAddr IP) where | ||
271 | fromString str | ||
272 | | '[' `L.elem` str = IPv6 <$> fromString str | ||
273 | | otherwise = IPv4 <$> fromString str | ||
274 | |||
275 | -- | fingerprint + "at" + dotted.host.inet.addr:port | ||
276 | -- TODO: instances for IPv6, HostName | ||
277 | instance Pretty a => Pretty (PeerAddr a) where | ||
278 | pretty PeerAddr {..} | ||
279 | | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr | ||
280 | | otherwise = paddr | ||
281 | where | ||
282 | paddr = pretty peerHost <> ":" <> text (show peerPort) | ||
283 | |||
284 | instance Hashable a => Hashable (PeerAddr a) where | ||
285 | hashWithSalt s PeerAddr {..} = | ||
286 | s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort | ||
287 | |||
288 | -- | Ports typically reserved for bittorrent P2P listener. | ||
289 | defaultPorts :: [PortNumber] | ||
290 | defaultPorts = [6881..6889] | ||
291 | |||
292 | _resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i | ||
293 | _resolvePeerAddr = undefined | ||
294 | |||
295 | _peerSockAddr :: PeerAddr IP -> (Family, SockAddr) | ||
296 | _peerSockAddr PeerAddr {..} = | ||
297 | case peerHost of | ||
298 | IPv4 ipv4 -> | ||
299 | (AF_INET, SockAddrInet peerPort (toHostAddress ipv4)) | ||
300 | IPv6 ipv6 -> | ||
301 | (AF_INET6, SockAddrInet6 peerPort 0 (toHostAddress6 ipv6) 0) | ||
302 | |||
303 | peerSockAddr :: PeerAddr IP -> SockAddr | ||
304 | peerSockAddr = snd . _peerSockAddr | ||
305 | |||
306 | -- | Create a socket connected to the address specified in a peerAddr | ||
307 | peerSocket :: SocketType -> PeerAddr IP -> IO Socket | ||
308 | peerSocket socketType pa = do | ||
309 | let (family, addr) = _peerSockAddr pa | ||
310 | sock <- socket family socketType defaultProtocol | ||
311 | connect sock addr | ||
312 | return sock | ||