diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Core/PeerAddr.hs | 7 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Message.hs | 41 |
2 files changed, 32 insertions, 16 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs index 73aa69fd..a4f45e74 100644 --- a/src/Network/BitTorrent/Core/PeerAddr.hs +++ b/src/Network/BitTorrent/Core/PeerAddr.hs | |||
@@ -16,7 +16,6 @@ | |||
16 | module Network.BitTorrent.Core.PeerAddr | 16 | module Network.BitTorrent.Core.PeerAddr |
17 | ( -- * Peer address | 17 | ( -- * Peer address |
18 | PeerAddr(..) | 18 | PeerAddr(..) |
19 | , getCompactPeerList | ||
20 | , peerSockAddr | 19 | , peerSockAddr |
21 | , connectToPeer | 20 | , connectToPeer |
22 | , ppPeer | 21 | , ppPeer |
@@ -80,16 +79,14 @@ instance BEncode PeerAddr where | |||
80 | 79 | ||
81 | -- | The tracker "compact peer list" compatible encoding. The | 80 | -- | The tracker "compact peer list" compatible encoding. The |
82 | -- 'peerId' is always 'Nothing'. | 81 | -- 'peerId' is always 'Nothing'. |
82 | -- | ||
83 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | ||
83 | instance Serialize PeerAddr where | 84 | instance Serialize PeerAddr where |
84 | put PeerAddr {..} = put peerID >> put peerPort | 85 | put PeerAddr {..} = put peerID >> put peerPort |
85 | {-# INLINE put #-} | 86 | {-# INLINE put #-} |
86 | get = PeerAddr Nothing <$> get <*> get | 87 | get = PeerAddr Nothing <$> get <*> get |
87 | {-# INLINE get #-} | 88 | {-# INLINE get #-} |
88 | 89 | ||
89 | -- | For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | ||
90 | getCompactPeerList :: S.Get [PeerAddr] | ||
91 | getCompactPeerList = many get | ||
92 | |||
93 | -- TODO make platform independent, clarify htonl | 90 | -- TODO make platform independent, clarify htonl |
94 | 91 | ||
95 | -- | Convert peer info from tracker response to socket address. Used | 92 | -- | Convert peer info from tracker response to socket address. Used |
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs index 469ca0ec..c46d5d58 100644 --- a/src/Network/BitTorrent/Tracker/Message.hs +++ b/src/Network/BitTorrent/Tracker/Message.hs | |||
@@ -27,6 +27,7 @@ module Network.BitTorrent.Tracker.Message | |||
27 | ( -- * Announce | 27 | ( -- * Announce |
28 | Event(..) | 28 | Event(..) |
29 | , AnnounceQuery(..) | 29 | , AnnounceQuery(..) |
30 | , PeerList (..) | ||
30 | , AnnounceInfo(..) | 31 | , AnnounceInfo(..) |
31 | 32 | ||
32 | -- ** Defaults | 33 | -- ** Defaults |
@@ -47,7 +48,7 @@ module Network.BitTorrent.Tracker.Message | |||
47 | import Control.Applicative | 48 | import Control.Applicative |
48 | import Control.Exception | 49 | import Control.Exception |
49 | import Control.Monad | 50 | import Control.Monad |
50 | import Data.Aeson (ToJSON, FromJSON) | 51 | import Data.Aeson (ToJSON(..), FromJSON(..)) |
51 | import Data.Aeson.TH | 52 | import Data.Aeson.TH |
52 | import Data.BEncode as BE | 53 | import Data.BEncode as BE |
53 | import Data.BEncode.BDict as BE | 54 | import Data.BEncode.BDict as BE |
@@ -215,13 +216,29 @@ instance Serialize AnnounceQuery where | |||
215 | -- Announce response | 216 | -- Announce response |
216 | -----------------------------------------------------------------------} | 217 | -----------------------------------------------------------------------} |
217 | 218 | ||
218 | newtype PeerList = PeerList { getPeerList :: [PeerAddr] } | 219 | data PeerList |
219 | deriving (Show, Eq, ToJSON, FromJSON, Typeable) | 220 | = PeerList { getPeerList :: [PeerAddr] } |
221 | | CompactPeerList { getPeerList :: [PeerAddr] } | ||
222 | deriving (Show, Eq, Typeable) | ||
223 | |||
224 | instance ToJSON PeerList where | ||
225 | toJSON = toJSON . getPeerList | ||
226 | |||
227 | instance FromJSON PeerList where | ||
228 | parseJSON v = PeerList <$> parseJSON v | ||
229 | |||
230 | putCompactPeerList :: S.Putter [PeerAddr] | ||
231 | putCompactPeerList = mapM_ put | ||
232 | |||
233 | getCompactPeerList :: S.Get [PeerAddr] | ||
234 | getCompactPeerList = many get | ||
220 | 235 | ||
221 | instance BEncode PeerList where | 236 | instance BEncode PeerList where |
222 | toBEncode (PeerList xs) = toBEncode xs | 237 | toBEncode (PeerList xs) = toBEncode xs |
223 | fromBEncode (BList l ) = PeerList <$> fromBEncode (BList l) | 238 | toBEncode (CompactPeerList xs) = toBEncode $ runPut (putCompactPeerList xs) |
224 | fromBEncode (BString s ) = PeerList <$> runGet getCompactPeerList s | 239 | |
240 | fromBEncode (BList l ) = PeerList <$> fromBEncode (BList l) | ||
241 | fromBEncode (BString s ) = CompactPeerList <$> runGet getCompactPeerList s | ||
225 | fromBEncode _ = decodingError "Peer list" | 242 | fromBEncode _ = decodingError "Peer list" |
226 | 243 | ||
227 | -- | The tracker response includes a peer list that helps the client | 244 | -- | The tracker response includes a peer list that helps the client |
@@ -237,13 +254,13 @@ data AnnounceInfo = | |||
237 | -- | Number of peers downloading the torrent. (leechers) | 254 | -- | Number of peers downloading the torrent. (leechers) |
238 | , respIncomplete :: !(Maybe Int) | 255 | , respIncomplete :: !(Maybe Int) |
239 | 256 | ||
240 | -- | Recommended interval to wait between requests. | 257 | -- | Recommended interval to wait between requests, in seconds. |
241 | , respInterval :: !Int | 258 | , respInterval :: !Int |
242 | 259 | ||
243 | -- | Minimal amount of time between requests. A peer /should/ | 260 | -- | Minimal amount of time between requests, in seconds. A |
244 | -- make timeout with at least 'respMinInterval' value, | 261 | -- peer /should/ make timeout with at least 'respMinInterval' |
245 | -- otherwise tracker might not respond. If not specified the | 262 | -- value, otherwise tracker might not respond. If not specified |
246 | -- same applies to 'respInterval'. | 263 | -- the same applies to 'respInterval'. |
247 | , respMinInterval :: !(Maybe Int) | 264 | , respMinInterval :: !(Maybe Int) |
248 | 265 | ||
249 | -- | Peers that must be contacted. | 266 | -- | Peers that must be contacted. |
@@ -322,6 +339,8 @@ defaultPorts = [6881..6889] | |||
322 | defaultNumWant :: Int | 339 | defaultNumWant :: Int |
323 | defaultNumWant = 50 | 340 | defaultNumWant = 50 |
324 | 341 | ||
342 | -- default value here: <https://wiki.theory.org/BitTorrent_Tracker_Protocol> | ||
343 | |||
325 | {----------------------------------------------------------------------- | 344 | {----------------------------------------------------------------------- |
326 | Scrape message | 345 | Scrape message |
327 | -----------------------------------------------------------------------} | 346 | -----------------------------------------------------------------------} |