blob: 77f042d5c7982326d04abd6bfbfa7e23da87edaf (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
-- |
-- Copyright : (c) Sam Truzjan 2013
-- License : BSD3
-- Maintainer : pxqr.sta@gmail.com
-- Stability : experimental
-- Portability : portable
--
-- 'PeerAddr' is used to represent peer address. Currently it's
-- just peer IP and peer port but this might change in future.
--
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS -fno-warn-orphans #-} -- for PortNumber instances
module Network.BitTorrent.Core.PeerAddr
( -- * Peer address
PeerAddr(..)
, defaultPorts
, peerSockAddr
) where
import Control.Applicative
import Data.Aeson (ToJSON, FromJSON)
import Data.Aeson.TH
import Data.BEncode as BS
import Data.Bits
import Data.Char
import Data.List as L
import Data.Serialize as S
import Data.Typeable
import Data.Word
import Network.Socket
import Text.PrettyPrint
import Text.PrettyPrint.Class
import Network.BitTorrent.Core.PeerId
deriving instance ToJSON PortNumber
deriving instance FromJSON PortNumber
instance BEncode PortNumber where
toBEncode = toBEncode . fromEnum
fromBEncode b = toEnum <$> fromBEncode b
instance Serialize PortNumber where
get = fromIntegral <$> getWord16be
{-# INLINE get #-}
put = putWord16be . fromIntegral
{-# INLINE put #-}
-- TODO check semantic of ord and eq instances
-- TODO use SockAddr instead of peerIP and peerPort
-- | Peer address info normally extracted from peer list or peer
-- compact list encoding.
data PeerAddr = PeerAddr {
peerId :: !(Maybe PeerId)
, peerIP :: {-# UNPACK #-} !HostAddress
, peerPort :: {-# UNPACK #-} !PortNumber
} deriving (Show, Eq, Ord, Typeable)
$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''PeerAddr)
-- | The tracker "announce query" compatible encoding.
instance BEncode PeerAddr where
toBEncode (PeerAddr pid pip pport) = toDict $
"peer id" .=? pid
.: "ip" .=! pip
.: "port" .=! pport
.: endDict
fromBEncode = fromDict $ do
PeerAddr <$>? "peer id"
<*>! "ip"
<*>! "port"
-- | The tracker "compact peer list" compatible encoding. The
-- 'peerId' is always 'Nothing'.
--
-- For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
--
instance Serialize PeerAddr where
put PeerAddr {..} = put peerId >> put peerPort
{-# INLINE put #-}
get = PeerAddr Nothing <$> get <*> get
{-# INLINE get #-}
instance Pretty PeerAddr where
pretty p @ PeerAddr {..}
| Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr
| otherwise = paddr
where
paddr = text (show (peerSockAddr p))
-- | Ports typically reserved for bittorrent P2P listener.
defaultPorts :: [PortNumber]
defaultPorts = [6881..6889]
-- TODO make platform independent, clarify htonl
-- | Convert peer info from tracker response to socket address. Used
-- for establish connection between peers.
--
peerSockAddr :: PeerAddr -> SockAddr
peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP)
where
htonl :: Word32 -> Word32
htonl d =
((d .&. 0xff) `shiftL` 24) .|.
(((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|.
(((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|.
((d `shiftR` 24) .&. 0xff)
g :: PortNumber -> PortNumber
g = id
|
