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.hs312
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
21module Network.BitTorrent.Core.PeerAddr
22 ( -- * Peer address
23 PeerAddr(..)
24 , defaultPorts
25 , peerSockAddr
26 , peerSocket
27
28 -- * Peer storage
29 ) where
30
31import Control.Applicative
32import Control.Monad
33import Data.BEncode as BS
34import Data.BEncode.BDict (BKey)
35import Data.ByteString.Char8 as BS8
36import Data.Char
37import Data.Default
38import Data.Hashable
39import Data.IP
40import Data.List as L
41import Data.List.Split
42import Data.Monoid
43import Data.Serialize as S
44import Data.String
45import Data.Typeable
46import Data.Word
47import Network.Socket
48import Text.PrettyPrint as PP hiding ((<>))
49import Text.PrettyPrint.Class
50import Text.Read (readMaybe)
51import qualified Text.ParserCombinators.ReadP as RP
52
53--import Data.Torrent
54import Network.BitTorrent.Core.PeerId
55
56
57{-----------------------------------------------------------------------
58-- Port number
59-----------------------------------------------------------------------}
60
61instance 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
71instance Serialize PortNumber where
72 get = fromIntegral <$> getWord16be
73 {-# INLINE get #-}
74 put = putWord16be . fromIntegral
75 {-# INLINE put #-}
76
77instance Hashable PortNumber where
78 hashWithSalt s = hashWithSalt s . fromEnum
79 {-# INLINE hashWithSalt #-}
80
81instance Pretty PortNumber where
82 pretty = PP.int . fromEnum
83 {-# INLINE pretty #-}
84
85{-----------------------------------------------------------------------
86-- IP addr
87-----------------------------------------------------------------------}
88
89class IPAddress i where
90 toHostAddr :: i -> Either HostAddress HostAddress6
91
92instance IPAddress IPv4 where
93 toHostAddr = Left . toHostAddress
94 {-# INLINE toHostAddr #-}
95
96instance IPAddress IPv6 where
97 toHostAddr = Right . toHostAddress6
98 {-# INLINE toHostAddr #-}
99
100instance IPAddress IP where
101 toHostAddr (IPv4 ip) = toHostAddr ip
102 toHostAddr (IPv6 ip) = toHostAddr ip
103 {-# INLINE toHostAddr #-}
104
105deriving instance Typeable IP
106deriving instance Typeable IPv4
107deriving instance Typeable IPv6
108
109ipToBEncode :: Show i => i -> BValue
110ipToBEncode ip = BString $ BS8.pack $ show ip
111{-# INLINE ipToBEncode #-}
112
113ipFromBEncode :: Read a => BValue -> BS.Result a
114ipFromBEncode (BString (BS8.unpack -> ipStr))
115 | Just ip <- readMaybe (ipStr) = pure ip
116 | otherwise = decodingError $ "IP: " ++ ipStr
117ipFromBEncode _ = decodingError $ "IP: addr should be a bstring"
118
119instance BEncode IP where
120 toBEncode = ipToBEncode
121 {-# INLINE toBEncode #-}
122 fromBEncode = ipFromBEncode
123 {-# INLINE fromBEncode #-}
124
125instance BEncode IPv4 where
126 toBEncode = ipToBEncode
127 {-# INLINE toBEncode #-}
128 fromBEncode = ipFromBEncode
129 {-# INLINE fromBEncode #-}
130
131instance 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
140instance 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
151instance Serialize IPv4 where
152 put = putWord32host . toHostAddress
153 get = fromHostAddress <$> getWord32host
154
155instance Serialize IPv6 where
156 put ip = put $ toHostAddress6 ip
157 get = fromHostAddress6 <$> get
158
159instance Pretty IPv4 where
160 pretty = PP.text . show
161 {-# INLINE pretty #-}
162
163instance Pretty IPv6 where
164 pretty = PP.text . show
165 {-# INLINE pretty #-}
166
167instance Pretty IP where
168 pretty = PP.text . show
169 {-# INLINE pretty #-}
170
171instance Hashable IPv4 where
172 hashWithSalt = hashUsing toHostAddress
173 {-# INLINE hashWithSalt #-}
174
175instance Hashable IPv6 where
176 hashWithSalt s a = hashWithSalt s (toHostAddress6 a)
177
178instance 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.
189data 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
200peer_ip_key, peer_id_key, peer_port_key :: BKey
201peer_ip_key = "ip"
202peer_id_key = "peer id"
203peer_port_key = "port"
204
205-- | The tracker's 'announce response' compatible encoding.
206instance (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
226instance (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@
231instance Default (PeerAddr IPv4) where
232 def = "127.0.0.1:6881"
233
234-- | @127.0.0.1:6881@
235instance Default (PeerAddr IP) where
236 def = IPv4 <$> def
237
238-- | Example:
239--
240-- @peerPort \"127.0.0.1:6881\" == 6881@
241--
242instance 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
250instance 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
257readsIPv6_port :: String -> [((IPv6, PortNumber), String)]
258readsIPv6_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
264instance 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
270instance 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
277instance 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
284instance 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.
289defaultPorts :: [PortNumber]
290defaultPorts = [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
303peerSockAddr :: PeerAddr IP -> SockAddr
304peerSockAddr = snd . _peerSockAddr
305
306-- | Create a socket connected to the address specified in a peerAddr
307peerSocket :: SocketType -> PeerAddr IP -> IO Socket
308peerSocket socketType pa = do
309 let (family, addr) = _peerSockAddr pa
310 sock <- socket family socketType defaultProtocol
311 connect sock addr
312 return sock