diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-30 11:10:38 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-30 11:10:38 +0400 |
commit | 7f54308b57615bc61c0727538af2b5a54366eadb (patch) | |
tree | 8d47fb66163a8e9d114f1debf5711eca45500055 /src/Network/BitTorrent/Tracker/RPC/Message.hs | |
parent | d4ee859973b200d3f81ea56b2e40847ed8c93510 (diff) |
Redesign tracker subsustem
Diffstat (limited to 'src/Network/BitTorrent/Tracker/RPC/Message.hs')
-rw-r--r-- | src/Network/BitTorrent/Tracker/RPC/Message.hs | 539 |
1 files changed, 539 insertions, 0 deletions
diff --git a/src/Network/BitTorrent/Tracker/RPC/Message.hs b/src/Network/BitTorrent/Tracker/RPC/Message.hs new file mode 100644 index 00000000..18c1a4c7 --- /dev/null +++ b/src/Network/BitTorrent/Tracker/RPC/Message.hs | |||
@@ -0,0 +1,539 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- Every tracker should support announce query. This query is used | ||
9 | -- to discover peers within a swarm and have two-fold effect: | ||
10 | -- | ||
11 | -- * peer doing announce discover other peers using peer list from | ||
12 | -- the response to the announce query. | ||
13 | -- | ||
14 | -- * tracker store peer information and use it in the succeeding | ||
15 | -- requests made by other peers, until the peer info expires. | ||
16 | -- | ||
17 | -- By convention most trackers support another form of request — | ||
18 | -- scrape query — which queries the state of a given torrent (or | ||
19 | -- a list of torrents) that the tracker is managing. | ||
20 | -- | ||
21 | {-# LANGUAGE FlexibleInstances #-} | ||
22 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
23 | {-# LANGUAGE TemplateHaskell #-} | ||
24 | {-# LANGUAGE DeriveDataTypeable #-} | ||
25 | {-# OPTIONS -fno-warn-orphans #-} | ||
26 | module Network.BitTorrent.Tracker.RPC.Message | ||
27 | ( -- * Announce | ||
28 | -- ** Request | ||
29 | Event(..) | ||
30 | , AnnounceQuery(..) | ||
31 | , renderAnnounceQuery | ||
32 | , ParamParseFailure | ||
33 | , parseAnnounceQuery | ||
34 | |||
35 | -- ** Response | ||
36 | , PeerList (..) | ||
37 | , AnnounceInfo(..) | ||
38 | , defaultNumWant | ||
39 | , parseFailureStatus | ||
40 | |||
41 | -- * Scrape | ||
42 | , ScrapeQuery | ||
43 | , ScrapeInfo(..) | ||
44 | , Scrape | ||
45 | ) | ||
46 | where | ||
47 | |||
48 | import Control.Applicative | ||
49 | import Control.Monad | ||
50 | import Data.Aeson (ToJSON(..), FromJSON(..)) | ||
51 | import Data.Aeson.TH | ||
52 | import Data.BEncode as BE hiding (Result) | ||
53 | import Data.BEncode.BDict as BE | ||
54 | import Data.ByteString as BS | ||
55 | import Data.ByteString.Char8 as BC | ||
56 | import Data.Char as Char | ||
57 | import Data.Convertible | ||
58 | import Data.List as L | ||
59 | import Data.Map as M | ||
60 | import Data.Maybe | ||
61 | import Data.Serialize as S hiding (Result) | ||
62 | import Data.Text (Text) | ||
63 | import Data.Text.Encoding | ||
64 | import Data.Typeable | ||
65 | import Data.Word | ||
66 | import Network | ||
67 | import Network.HTTP.Types.QueryLike | ||
68 | import Network.HTTP.Types.URI hiding (urlEncode) | ||
69 | import Network.HTTP.Types.Status | ||
70 | import Network.Socket | ||
71 | import Text.Read (readMaybe) | ||
72 | |||
73 | import Data.Torrent.InfoHash | ||
74 | import Data.Torrent.Progress | ||
75 | import Network.BitTorrent.Core.PeerId | ||
76 | import Network.BitTorrent.Core.PeerAddr | ||
77 | |||
78 | |||
79 | {----------------------------------------------------------------------- | ||
80 | -- Events | ||
81 | -----------------------------------------------------------------------} | ||
82 | |||
83 | -- | Events used to specify which kind of announce query is performed. | ||
84 | data Event = Started | ||
85 | -- ^ For the first request: when a peer join the swarm. | ||
86 | | Stopped | ||
87 | -- ^ Sent when the peer is shutting down. | ||
88 | | Completed | ||
89 | -- ^ To be sent when the peer completes a download. | ||
90 | deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable) | ||
91 | |||
92 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''Event) | ||
93 | |||
94 | -- | HTTP tracker protocol compatible encoding. | ||
95 | instance QueryValueLike Event where | ||
96 | toQueryValue e = toQueryValue (Char.toLower x : xs) | ||
97 | where | ||
98 | (x : xs) = show e -- INVARIANT: this is always nonempty list | ||
99 | |||
100 | type EventId = Word32 | ||
101 | |||
102 | -- | UDP tracker encoding event codes. | ||
103 | eventId :: Event -> EventId | ||
104 | eventId Completed = 1 | ||
105 | eventId Started = 2 | ||
106 | eventId Stopped = 3 | ||
107 | |||
108 | -- TODO add Regular event | ||
109 | putEvent :: Putter (Maybe Event) | ||
110 | putEvent Nothing = putWord32be 0 | ||
111 | putEvent (Just e) = putWord32be (eventId e) | ||
112 | |||
113 | getEvent :: S.Get (Maybe Event) | ||
114 | getEvent = do | ||
115 | eid <- getWord32be | ||
116 | case eid of | ||
117 | 0 -> return Nothing | ||
118 | 1 -> return $ Just Completed | ||
119 | 2 -> return $ Just Started | ||
120 | 3 -> return $ Just Stopped | ||
121 | _ -> fail "unknown event id" | ||
122 | |||
123 | {----------------------------------------------------------------------- | ||
124 | Announce query | ||
125 | -----------------------------------------------------------------------} | ||
126 | |||
127 | -- | A tracker request is HTTP GET request; used to include metrics | ||
128 | -- from clients that help the tracker keep overall statistics about | ||
129 | -- the torrent. The most important, requests are used by the tracker | ||
130 | -- to keep track lists of active peer for a particular torrent. | ||
131 | -- | ||
132 | data AnnounceQuery = AnnounceQuery | ||
133 | { | ||
134 | -- | Hash of info part of the torrent usually obtained from | ||
135 | -- 'Torrent' or 'Magnet'. | ||
136 | reqInfoHash :: !InfoHash | ||
137 | |||
138 | -- | ID of the peer doing request. | ||
139 | , reqPeerId :: !PeerId | ||
140 | |||
141 | -- | Port to listen to for connections from other | ||
142 | -- peers. Tracker should respond with this port when | ||
143 | -- some /other/ peer request the tracker with the same info hash. | ||
144 | -- Normally, this port is choosed from 'defaultPorts'. | ||
145 | , reqPort :: !PortNumber | ||
146 | |||
147 | -- | Current progress of peer doing request. | ||
148 | , reqProgress :: !Progress | ||
149 | |||
150 | -- | The peer IP. Needed only when client communicated with | ||
151 | -- tracker throught a proxy. | ||
152 | , reqIP :: Maybe HostAddress | ||
153 | |||
154 | -- | Number of peers that the peers wants to receive from. See | ||
155 | -- note for 'defaultNumWant'. | ||
156 | , reqNumWant :: Maybe Int | ||
157 | |||
158 | -- | If not specified, the request is regular periodic request. | ||
159 | , reqEvent :: Maybe Event | ||
160 | } deriving (Show, Eq, Typeable) | ||
161 | |||
162 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceQuery) | ||
163 | |||
164 | -- | UDP tracker protocol compatible encoding. | ||
165 | instance Serialize AnnounceQuery where | ||
166 | put AnnounceQuery {..} = do | ||
167 | put reqInfoHash | ||
168 | put reqPeerId | ||
169 | put reqProgress | ||
170 | putEvent reqEvent | ||
171 | putWord32be $ fromMaybe 0 reqIP | ||
172 | putWord32be $ 0 -- TODO what the fuck is "key"? | ||
173 | putWord32be $ fromIntegral $ fromMaybe (-1) reqNumWant | ||
174 | |||
175 | put reqPort | ||
176 | |||
177 | get = do | ||
178 | ih <- get | ||
179 | pid <- get | ||
180 | |||
181 | progress <- get | ||
182 | |||
183 | ev <- getEvent | ||
184 | ip <- getWord32be | ||
185 | -- key <- getWord32be -- TODO | ||
186 | want <- getWord32be | ||
187 | |||
188 | port <- get | ||
189 | |||
190 | return $ AnnounceQuery { | ||
191 | reqInfoHash = ih | ||
192 | , reqPeerId = pid | ||
193 | , reqPort = port | ||
194 | , reqProgress = progress | ||
195 | , reqIP = if ip == 0 then Nothing else Just ip | ||
196 | , reqNumWant = if want == -1 then Nothing | ||
197 | else Just (fromIntegral want) | ||
198 | , reqEvent = ev | ||
199 | } | ||
200 | |||
201 | instance QueryValueLike PortNumber where | ||
202 | toQueryValue = toQueryValue . show . fromEnum | ||
203 | |||
204 | instance QueryValueLike Word32 where | ||
205 | toQueryValue = toQueryValue . show | ||
206 | |||
207 | instance QueryValueLike Int where | ||
208 | toQueryValue = toQueryValue . show | ||
209 | |||
210 | -- | HTTP tracker protocol compatible encoding. | ||
211 | instance QueryLike AnnounceQuery where | ||
212 | toQuery AnnounceQuery {..} = | ||
213 | toQuery reqProgress ++ | ||
214 | [ ("info_hash", toQueryValue reqInfoHash) | ||
215 | , ("peer_id" , toQueryValue reqPeerId) | ||
216 | , ("port" , toQueryValue reqPort) | ||
217 | , ("ip" , toQueryValue reqIP) | ||
218 | , ("numwant" , toQueryValue reqNumWant) | ||
219 | , ("event" , toQueryValue reqEvent) | ||
220 | ] | ||
221 | |||
222 | --renderAnnounceQueryBuilder :: AnnounceQuery -> BS.Builder | ||
223 | --renderAnnounceQueryBuilder = undefined | ||
224 | |||
225 | -- | Encode announce query and add it to the base tracker URL. | ||
226 | renderAnnounceQuery :: AnnounceQuery -> SimpleQuery | ||
227 | renderAnnounceQuery = filterMaybes . toQuery | ||
228 | where | ||
229 | filterMaybes :: [(a, Maybe b)] -> [(a, b)] | ||
230 | filterMaybes = catMaybes . L.map f | ||
231 | where | ||
232 | f (_, Nothing) = Nothing | ||
233 | f (a, Just b ) = Just (a, b) | ||
234 | |||
235 | data QueryParam | ||
236 | = ParamInfoHash | ||
237 | | ParamPeerId | ||
238 | | ParamPort | ||
239 | | ParamUploaded | ||
240 | | ParamLeft | ||
241 | | ParamDownloaded | ||
242 | | ParamIP | ||
243 | | ParamNumWant | ||
244 | | ParamEvent | ||
245 | deriving (Show, Eq, Ord, Enum) | ||
246 | |||
247 | paramName :: QueryParam -> BS.ByteString | ||
248 | paramName ParamInfoHash = "info_hash" | ||
249 | paramName ParamPeerId = "peer_id" | ||
250 | paramName ParamPort = "port" | ||
251 | paramName ParamUploaded = "uploaded" | ||
252 | paramName ParamLeft = "left" | ||
253 | paramName ParamDownloaded = "downloaded" | ||
254 | paramName ParamIP = "ip" | ||
255 | paramName ParamNumWant = "numwant" | ||
256 | paramName ParamEvent = "event" | ||
257 | |||
258 | class FromParam a where | ||
259 | fromParam :: BS.ByteString -> Maybe a | ||
260 | |||
261 | instance FromParam InfoHash where | ||
262 | fromParam = either (const Nothing) pure . safeConvert | ||
263 | |||
264 | instance FromParam PeerId where | ||
265 | fromParam = either (const Nothing) pure . safeConvert | ||
266 | |||
267 | instance FromParam Word32 where | ||
268 | fromParam = readMaybe . BC.unpack | ||
269 | |||
270 | instance FromParam Word64 where | ||
271 | fromParam = readMaybe . BC.unpack | ||
272 | |||
273 | instance FromParam Int where | ||
274 | fromParam = readMaybe . BC.unpack | ||
275 | |||
276 | instance FromParam PortNumber where | ||
277 | fromParam bs = fromIntegral <$> (fromParam bs :: Maybe Word32) | ||
278 | |||
279 | instance FromParam Event where | ||
280 | fromParam bs = do | ||
281 | (x, xs) <- BC.uncons bs | ||
282 | readMaybe $ BC.unpack $ BC.cons (Char.toUpper x) xs | ||
283 | |||
284 | data ParamParseFailure | ||
285 | = Missing QueryParam -- ^ param not found in query string; | ||
286 | | Invalid QueryParam BS.ByteString -- ^ param present but not valid. | ||
287 | deriving (Show, Eq) | ||
288 | |||
289 | type Result = Either ParamParseFailure | ||
290 | |||
291 | withError :: ParamParseFailure -> Maybe a -> Result a | ||
292 | withError e = maybe (Left e) Right | ||
293 | |||
294 | reqParam :: FromParam a => QueryParam -> SimpleQuery -> Result a | ||
295 | reqParam param xs = do | ||
296 | val <- withError (Missing param) $ L.lookup (paramName param) xs | ||
297 | withError (Invalid param val) (fromParam val) | ||
298 | |||
299 | optParam :: FromParam a => QueryParam -> SimpleQuery -> Result (Maybe a) | ||
300 | optParam param ps | ||
301 | | Just x <- L.lookup (paramName param) ps | ||
302 | = pure <$> withError (Invalid param x) (fromParam x) | ||
303 | | otherwise = pure Nothing | ||
304 | |||
305 | parseProgress :: SimpleQuery -> Result Progress | ||
306 | parseProgress params = Progress | ||
307 | <$> reqParam ParamDownloaded params | ||
308 | <*> reqParam ParamLeft params | ||
309 | <*> reqParam ParamUploaded params | ||
310 | |||
311 | -- | Parse announce request from a query string. | ||
312 | parseAnnounceQuery :: SimpleQuery -> Either ParamParseFailure AnnounceQuery | ||
313 | parseAnnounceQuery params = AnnounceQuery | ||
314 | <$> reqParam ParamInfoHash params | ||
315 | <*> reqParam ParamPeerId params | ||
316 | <*> reqParam ParamPort params | ||
317 | <*> parseProgress params | ||
318 | <*> optParam ParamIP params | ||
319 | <*> optParam ParamNumWant params | ||
320 | <*> optParam ParamEvent params | ||
321 | |||
322 | -- TODO add extension datatype | ||
323 | --type AnnounceRequest = () | ||
324 | |||
325 | {----------------------------------------------------------------------- | ||
326 | -- Announce response | ||
327 | -----------------------------------------------------------------------} | ||
328 | |||
329 | -- | Tracker can return peer list in either compact(BEP23) or not | ||
330 | -- compact form. | ||
331 | -- | ||
332 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | ||
333 | -- | ||
334 | data PeerList | ||
335 | = PeerList { getPeerList :: [PeerAddr] } | ||
336 | | CompactPeerList { getPeerList :: [PeerAddr] } | ||
337 | deriving (Show, Eq, Typeable) | ||
338 | |||
339 | instance ToJSON PeerList where | ||
340 | toJSON = toJSON . getPeerList | ||
341 | |||
342 | instance FromJSON PeerList where | ||
343 | parseJSON v = PeerList <$> parseJSON v | ||
344 | |||
345 | putCompactPeerList :: S.Putter [PeerAddr] | ||
346 | putCompactPeerList = mapM_ put | ||
347 | |||
348 | getCompactPeerList :: S.Get [PeerAddr] | ||
349 | getCompactPeerList = many get | ||
350 | |||
351 | instance BEncode PeerList where | ||
352 | toBEncode (PeerList xs) = toBEncode xs | ||
353 | toBEncode (CompactPeerList xs) = toBEncode $ runPut (putCompactPeerList xs) | ||
354 | |||
355 | fromBEncode (BList l ) = PeerList <$> fromBEncode (BList l) | ||
356 | fromBEncode (BString s ) = CompactPeerList <$> runGet getCompactPeerList s | ||
357 | fromBEncode _ = decodingError "Peer list" | ||
358 | |||
359 | -- | The tracker response includes a peer list that helps the client | ||
360 | -- participate in the torrent. The most important is 'respPeer' list | ||
361 | -- used to join the swarm. | ||
362 | -- | ||
363 | data AnnounceInfo = | ||
364 | Failure !Text -- ^ Failure reason in human readable form. | ||
365 | | AnnounceInfo { | ||
366 | -- | Number of peers completed the torrent. (seeders) | ||
367 | respComplete :: !(Maybe Int) | ||
368 | |||
369 | -- | Number of peers downloading the torrent. (leechers) | ||
370 | , respIncomplete :: !(Maybe Int) | ||
371 | |||
372 | -- | Recommended interval to wait between requests, in seconds. | ||
373 | , respInterval :: !Int | ||
374 | |||
375 | -- | Minimal amount of time between requests, in seconds. A | ||
376 | -- peer /should/ make timeout with at least 'respMinInterval' | ||
377 | -- value, otherwise tracker might not respond. If not specified | ||
378 | -- the same applies to 'respInterval'. | ||
379 | , respMinInterval :: !(Maybe Int) | ||
380 | |||
381 | -- | Peers that must be contacted. | ||
382 | , respPeers :: !PeerList | ||
383 | |||
384 | -- | Human readable warning. | ||
385 | , respWarning :: !(Maybe Text) | ||
386 | } deriving (Show, Typeable) | ||
387 | |||
388 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceInfo) | ||
389 | |||
390 | -- | HTTP tracker protocol compatible encoding. | ||
391 | instance BEncode AnnounceInfo where | ||
392 | toBEncode (Failure t) = toDict $ | ||
393 | "failure reason" .=! t | ||
394 | .: endDict | ||
395 | |||
396 | toBEncode AnnounceInfo {..} = toDict $ | ||
397 | "complete" .=? respComplete | ||
398 | .: "incomplete" .=? respIncomplete | ||
399 | .: "interval" .=! respInterval | ||
400 | .: "min interval" .=? respMinInterval | ||
401 | .: "peers" .=! respPeers | ||
402 | .: "warning message" .=? respWarning | ||
403 | .: endDict | ||
404 | |||
405 | fromBEncode (BDict d) | ||
406 | | Just t <- BE.lookup "failure reason" d = Failure <$> fromBEncode t | ||
407 | | otherwise = (`fromDict` (BDict d)) $ do | ||
408 | AnnounceInfo | ||
409 | <$>? "complete" | ||
410 | <*>? "incomplete" | ||
411 | <*>! "interval" | ||
412 | <*>? "min interval" | ||
413 | <*>! "peers" | ||
414 | <*>? "warning message" | ||
415 | fromBEncode _ = decodingError "Announce info" | ||
416 | |||
417 | -- | UDP tracker protocol compatible encoding. | ||
418 | instance Serialize AnnounceInfo where | ||
419 | put (Failure msg) = put $ encodeUtf8 msg | ||
420 | put AnnounceInfo {..} = do | ||
421 | putWord32be $ fromIntegral respInterval | ||
422 | putWord32be $ fromIntegral $ fromMaybe 0 respIncomplete | ||
423 | putWord32be $ fromIntegral $ fromMaybe 0 respComplete | ||
424 | forM_ (getPeerList respPeers) put | ||
425 | |||
426 | get = do | ||
427 | interval <- getWord32be | ||
428 | leechers <- getWord32be | ||
429 | seeders <- getWord32be | ||
430 | peers <- many get | ||
431 | |||
432 | return $ AnnounceInfo { | ||
433 | respWarning = Nothing | ||
434 | , respInterval = fromIntegral interval | ||
435 | , respMinInterval = Nothing | ||
436 | , respIncomplete = Just $ fromIntegral leechers | ||
437 | , respComplete = Just $ fromIntegral seeders | ||
438 | , respPeers = PeerList peers | ||
439 | } | ||
440 | |||
441 | -- | Above 25, new peers are highly unlikely to increase download | ||
442 | -- speed. Even 30 peers is /plenty/, the official client version 3 | ||
443 | -- in fact only actively forms new connections if it has less than | ||
444 | -- 30 peers and will refuse connections if it has 55. | ||
445 | -- | ||
446 | -- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Basic_Tracker_Announce_Request> | ||
447 | -- | ||
448 | defaultNumWant :: Int | ||
449 | defaultNumWant = 50 | ||
450 | |||
451 | missingOffset :: Int | ||
452 | missingOffset = 101 | ||
453 | |||
454 | invalidOffset :: Int | ||
455 | invalidOffset = 150 | ||
456 | |||
457 | -- | Get HTTP response error code from a announce params parse | ||
458 | -- failure. | ||
459 | -- | ||
460 | -- For more info see: | ||
461 | -- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Response_Codes> | ||
462 | -- | ||
463 | parseFailureCode :: ParamParseFailure -> Int | ||
464 | parseFailureCode (Missing param ) = missingOffset + fromEnum param | ||
465 | parseFailureCode (Invalid param _) = invalidOffset + fromEnum param | ||
466 | |||
467 | -- | Human readable message | ||
468 | parseFailureMessage :: ParamParseFailure -> BS.ByteString | ||
469 | parseFailureMessage e = BS.concat $ case e of | ||
470 | Missing p -> ["Missing parameter: ", paramName p] | ||
471 | Invalid p v -> ["Invalid parameter: ", paramName p, " = ", v] | ||
472 | |||
473 | parseFailureStatus :: ParamParseFailure -> Status | ||
474 | parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage | ||
475 | |||
476 | --type AnnounceResponse = Either Status AnnounceInfo -- TODO | ||
477 | --type TrackerResponse = () -- TODO | ||
478 | |||
479 | {----------------------------------------------------------------------- | ||
480 | Scrape message | ||
481 | -----------------------------------------------------------------------} | ||
482 | |||
483 | type ScrapeQuery = [InfoHash] | ||
484 | |||
485 | -- | Overall information about particular torrent. | ||
486 | data ScrapeInfo = ScrapeInfo { | ||
487 | -- | Number of seeders - peers with the entire file. | ||
488 | siComplete :: {-# UNPACK #-} !Int | ||
489 | |||
490 | -- | Total number of times the tracker has registered a completion. | ||
491 | , siDownloaded :: {-# UNPACK #-} !Int | ||
492 | |||
493 | -- | Number of leechers. | ||
494 | , siIncomplete :: {-# UNPACK #-} !Int | ||
495 | |||
496 | -- | Name of the torrent file, as specified by the "name" | ||
497 | -- file in the info section of the .torrent file. | ||
498 | , siName :: !(Maybe Text) | ||
499 | } deriving (Show, Eq, Typeable) | ||
500 | |||
501 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) | ||
502 | |||
503 | -- TODO hash map | ||
504 | -- | Scrape info about a set of torrents. | ||
505 | type Scrape = Map InfoHash ScrapeInfo | ||
506 | |||
507 | -- | HTTP tracker protocol compatible encoding. | ||
508 | instance BEncode ScrapeInfo where | ||
509 | toBEncode ScrapeInfo {..} = toDict $ | ||
510 | "complete" .=! siComplete | ||
511 | .: "downloaded" .=! siDownloaded | ||
512 | .: "incomplete" .=! siIncomplete | ||
513 | .: "name" .=? siName | ||
514 | .: endDict | ||
515 | |||
516 | fromBEncode = fromDict $ do | ||
517 | ScrapeInfo <$>! "complete" | ||
518 | <*>! "downloaded" | ||
519 | <*>! "incomplete" | ||
520 | <*>? "name" | ||
521 | |||
522 | -- | UDP tracker protocol compatible encoding. | ||
523 | instance Serialize ScrapeInfo where | ||
524 | put ScrapeInfo {..} = do | ||
525 | putWord32be $ fromIntegral siComplete | ||
526 | putWord32be $ fromIntegral siDownloaded | ||
527 | putWord32be $ fromIntegral siIncomplete | ||
528 | |||
529 | get = do | ||
530 | seeders <- getWord32be | ||
531 | downTimes <- getWord32be | ||
532 | leechers <- getWord32be | ||
533 | |||
534 | return $ ScrapeInfo { | ||
535 | siComplete = fromIntegral seeders | ||
536 | , siDownloaded = fromIntegral downTimes | ||
537 | , siIncomplete = fromIntegral leechers | ||
538 | , siName = Nothing | ||
539 | } | ||