blob: 71c92a15e40b16645fc9828145bcd2d955cc581e (
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
|
-- |
-- 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.BEncode.BDict (BKey)
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)
peer_id_key, peer_ip_key, peer_port_key :: BKey
peer_id_key = "peer id"
peer_ip_key = "ip"
peer_port_key = "port"
-- FIXME do we need to byteswap peerIP in bencode instance?
-- | The tracker announce response compatible encoding.
instance BEncode PeerAddr where
toBEncode PeerAddr {..} = toDict $
peer_id_key .=? peerId
.: peer_ip_key .=! peerIP
.: peer_port_key .=! peerPort
.: endDict
fromBEncode = fromDict $ do
PeerAddr <$>? peer_id_key
<*>! peer_ip_key
<*>! peer_port_key
-- | 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 {..} = putWord32host peerId >> putWord peerPort
{-# INLINE put #-}
get = PeerAddr Nothing <$> getWord32host <*> 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]
-- | Convert peer info from tracker response to socket address. Used
-- for establish connection between peers.
--
peerSockAddr :: PeerAddr -> SockAddr
peerSockAddr = SockAddrInet <$> peerPort <*> peerIP
|
