diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Message.hs | 41 |
1 files changed, 30 insertions, 11 deletions
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 | -----------------------------------------------------------------------} |