summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker/RPC/Message.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Tracker/RPC/Message.hs')
-rw-r--r--src/Network/BitTorrent/Tracker/RPC/Message.hs85
1 files changed, 61 insertions, 24 deletions
diff --git a/src/Network/BitTorrent/Tracker/RPC/Message.hs b/src/Network/BitTorrent/Tracker/RPC/Message.hs
index 3900ff64..f13f7e97 100644
--- a/src/Network/BitTorrent/Tracker/RPC/Message.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/Message.hs
@@ -234,13 +234,14 @@ instance QueryLike AnnounceQuery where
234 , ("event" , toQueryValue reqEvent) 234 , ("event" , toQueryValue reqEvent)
235 ] 235 ]
236 236
237-- | Filter @param=value@ pairs with the unset value.
237queryToSimpleQuery :: Query -> SimpleQuery 238queryToSimpleQuery :: Query -> SimpleQuery
238queryToSimpleQuery = catMaybes . L.map f 239queryToSimpleQuery = catMaybes . L.map f
239 where 240 where
240 f (_, Nothing) = Nothing 241 f (_, Nothing) = Nothing
241 f (a, Just b ) = Just (a, b) 242 f (a, Just b ) = Just (a, b)
242 243
243-- | Encode announce query and add it to the base tracker URL. 244-- | Encode announce query to query string.
244renderAnnounceQuery :: AnnounceQuery -> SimpleQuery 245renderAnnounceQuery :: AnnounceQuery -> SimpleQuery
245renderAnnounceQuery = queryToSimpleQuery . toQuery 246renderAnnounceQuery = queryToSimpleQuery . toQuery
246 247
@@ -293,35 +294,40 @@ instance FromParam Event where
293 (x, xs) <- BC.uncons bs 294 (x, xs) <- BC.uncons bs
294 readMaybe $ BC.unpack $ BC.cons (Char.toUpper x) xs 295 readMaybe $ BC.unpack $ BC.cons (Char.toUpper x) xs
295 296
297-- | 'ParamParseFailure' represent errors can occur while parsing HTTP
298-- tracker requests. In case of failure, this can be used to provide
299-- more informative 'statusCode' and 'statusMessage' in tracker
300-- responses.
301--
296data ParamParseFailure 302data ParamParseFailure
297 = Missing QueryParam -- ^ param not found in query string; 303 = Missing QueryParam -- ^ param not found in query string;
298 | Invalid QueryParam BS.ByteString -- ^ param present but not valid. 304 | Invalid QueryParam BS.ByteString -- ^ param present but not valid.
299 deriving (Show, Eq) 305 deriving (Show, Eq)
300 306
301type Result = Either ParamParseFailure 307type ParseResult = Either ParamParseFailure
302 308
303withError :: ParamParseFailure -> Maybe a -> Result a 309withError :: ParamParseFailure -> Maybe a -> ParseResult a
304withError e = maybe (Left e) Right 310withError e = maybe (Left e) Right
305 311
306reqParam :: FromParam a => QueryParam -> SimpleQuery -> Result a 312reqParam :: FromParam a => QueryParam -> SimpleQuery -> ParseResult a
307reqParam param xs = do 313reqParam param xs = do
308 val <- withError (Missing param) $ L.lookup (paramName param) xs 314 val <- withError (Missing param) $ L.lookup (paramName param) xs
309 withError (Invalid param val) (fromParam val) 315 withError (Invalid param val) (fromParam val)
310 316
311optParam :: FromParam a => QueryParam -> SimpleQuery -> Result (Maybe a) 317optParam :: FromParam a => QueryParam -> SimpleQuery -> ParseResult (Maybe a)
312optParam param ps 318optParam param ps
313 | Just x <- L.lookup (paramName param) ps 319 | Just x <- L.lookup (paramName param) ps
314 = pure <$> withError (Invalid param x) (fromParam x) 320 = pure <$> withError (Invalid param x) (fromParam x)
315 | otherwise = pure Nothing 321 | otherwise = pure Nothing
316 322
317parseProgress :: SimpleQuery -> Result Progress 323parseProgress :: SimpleQuery -> ParseResult Progress
318parseProgress params = Progress 324parseProgress params = Progress
319 <$> reqParam ParamDownloaded params 325 <$> reqParam ParamDownloaded params
320 <*> reqParam ParamLeft params 326 <*> reqParam ParamLeft params
321 <*> reqParam ParamUploaded params 327 <*> reqParam ParamUploaded params
322 328
323-- | Parse announce request from a query string. 329-- | Parse announce request from a query string.
324parseAnnounceQuery :: SimpleQuery -> Either ParamParseFailure AnnounceQuery 330parseAnnounceQuery :: SimpleQuery -> ParseResult AnnounceQuery
325parseAnnounceQuery params = AnnounceQuery 331parseAnnounceQuery params = AnnounceQuery
326 <$> reqParam ParamInfoHash params 332 <$> reqParam ParamInfoHash params
327 <*> reqParam ParamPeerId params 333 <*> reqParam ParamPeerId params
@@ -331,25 +337,51 @@ parseAnnounceQuery params = AnnounceQuery
331 <*> optParam ParamNumWant params 337 <*> optParam ParamNumWant params
332 <*> optParam ParamEvent params 338 <*> optParam ParamEvent params
333 339
340-- | Extensions for HTTP tracker protocol.
334data AnnounceQueryExt = AnnounceQueryExt 341data AnnounceQueryExt = AnnounceQueryExt
335 { extCompact :: Maybe Bool -- | "compact" param 342 { -- | If specified, "compact" parameter is used to advise the
336 , extNoPeerId :: Maybe Bool -- | "no_peer_id" param 343 -- tracker to send peer id list as:
344 --
345 -- * bencoded list (extCompact = Just False);
346 -- * or more compact binary string (extCompact = Just True).
347 --
348 -- The later is prefered since compact peer list will reduce the
349 -- size of tracker responses. Hovewer, if tracker do not support
350 -- this extension then it can return peer list in either form.
351 --
352 -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
353 --
354 extCompact :: !(Maybe Bool)
355
356 -- | If specified, "no_peer_id" parameter is used advise tracker
357 -- to either send or not to send peer id in tracker response.
358 -- Tracker may not support this extension as well.
359 --
360 -- For more info see:
361 -- <http://permalink.gmane.org/gmane.network.bit-torrent.general/4030>
362 --
363 , extNoPeerId :: !(Maybe Bool)
337 } deriving (Show, Eq, Typeable) 364 } deriving (Show, Eq, Typeable)
338 365
366-- | Parse announce query extended part from query string.
339parseAnnounceQueryExt :: SimpleQuery -> AnnounceQueryExt 367parseAnnounceQueryExt :: SimpleQuery -> AnnounceQueryExt
340parseAnnounceQueryExt = undefined 368parseAnnounceQueryExt = undefined
341 369
370-- | Render announce query extended part to query string.
342renderAnnounceQueryExt :: AnnounceQueryExt -> SimpleQuery 371renderAnnounceQueryExt :: AnnounceQueryExt -> SimpleQuery
343renderAnnounceQueryExt = undefined 372renderAnnounceQueryExt = undefined
344 373
374-- | HTTP tracker request with extensions.
345data AnnounceRequest = AnnounceRequest 375data AnnounceRequest = AnnounceRequest
346 { announceQuery :: AnnounceQuery 376 { announceQuery :: AnnounceQuery -- ^ Request query params.
347 , announceAdvises :: AnnounceQueryExt 377 , announceAdvises :: AnnounceQueryExt -- ^ Optional advises to the tracker.
348 } deriving (Show, Eq, Typeable) 378 } deriving (Show, Eq, Typeable)
349 379
350parseAnnounceRequest :: SimpleQuery -> Either ParamParseFailure AnnounceRequest 380-- | Parse announce request from query string.
381parseAnnounceRequest :: SimpleQuery -> ParseResult AnnounceRequest
351parseAnnounceRequest = undefined 382parseAnnounceRequest = undefined
352 383
384-- | Render announce request to query string.
353renderAnnounceRequest :: AnnounceRequest -> SimpleQuery 385renderAnnounceRequest :: AnnounceRequest -> SimpleQuery
354renderAnnounceRequest = undefined 386renderAnnounceRequest = undefined
355 387
@@ -479,35 +511,35 @@ instance Serialize AnnounceInfo where
479defaultNumWant :: Int 511defaultNumWant :: Int
480defaultNumWant = 50 512defaultNumWant = 50
481 513
514-- | Reasonable upper bound of numwant parameter.
482defaultMaxNumWant :: Int 515defaultMaxNumWant :: Int
483defaultMaxNumWant = 200 516defaultMaxNumWant = 200
484 517
518-- | Widely used reannounce interval. Note: tracker clients should not
519-- use this value!
485defaultReannounceInterval :: Int 520defaultReannounceInterval :: Int
486defaultReannounceInterval = 30 * 60 521defaultReannounceInterval = 30 * 60
487 522
488
489missingOffset :: Int 523missingOffset :: Int
490missingOffset = 101 524missingOffset = 101
491 525
492invalidOffset :: Int 526invalidOffset :: Int
493invalidOffset = 150 527invalidOffset = 150
494 528
495-- | Get HTTP response error code from a announce params parse
496-- failure.
497--
498-- For more info see:
499-- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Response_Codes>
500--
501parseFailureCode :: ParamParseFailure -> Int 529parseFailureCode :: ParamParseFailure -> Int
502parseFailureCode (Missing param ) = missingOffset + fromEnum param 530parseFailureCode (Missing param ) = missingOffset + fromEnum param
503parseFailureCode (Invalid param _) = invalidOffset + fromEnum param 531parseFailureCode (Invalid param _) = invalidOffset + fromEnum param
504 532
505-- | Human readable message
506parseFailureMessage :: ParamParseFailure -> BS.ByteString 533parseFailureMessage :: ParamParseFailure -> BS.ByteString
507parseFailureMessage e = BS.concat $ case e of 534parseFailureMessage e = BS.concat $ case e of
508 Missing p -> ["Missing parameter: ", paramName p] 535 Missing p -> ["Missing parameter: ", paramName p]
509 Invalid p v -> ["Invalid parameter: ", paramName p, " = ", v] 536 Invalid p v -> ["Invalid parameter: ", paramName p, " = ", v]
510 537
538-- | Get HTTP response status from a announce params parse failure.
539--
540-- For more info see:
541-- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Response_Codes>
542--
511parseFailureStatus :: ParamParseFailure -> Status 543parseFailureStatus :: ParamParseFailure -> Status
512parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage 544parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage
513 545
@@ -515,6 +547,9 @@ parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage
515 Scrape message 547 Scrape message
516-----------------------------------------------------------------------} 548-----------------------------------------------------------------------}
517 549
550-- | Scrape query used to specify a set of torrent to scrape.
551-- If list is empty then tracker should return scrape info about each
552-- torrent.
518type ScrapeQuery = [InfoHash] 553type ScrapeQuery = [InfoHash]
519 554
520-- TODO 555-- TODO
@@ -536,15 +571,17 @@ scrapeParam = "info_hash"
536isScrapeParam :: BS.ByteString -> Bool 571isScrapeParam :: BS.ByteString -> Bool
537isScrapeParam = (==) scrapeParam 572isScrapeParam = (==) scrapeParam
538 573
574-- | Parse scrape query to query string.
575parseScrapeQuery :: SimpleQuery -> ScrapeQuery
576parseScrapeQuery
577 = catMaybes . L.map (fromParam . snd) . L.filter (isScrapeParam . fst)
578
579-- | Render scrape query to query string.
539renderScrapeQuery :: ScrapeQuery -> SimpleQuery 580renderScrapeQuery :: ScrapeQuery -> SimpleQuery
540renderScrapeQuery = queryToSimpleQuery . L.map mkPair 581renderScrapeQuery = queryToSimpleQuery . L.map mkPair
541 where 582 where
542 mkPair ih = (scrapeParam, toQueryValue ih) 583 mkPair ih = (scrapeParam, toQueryValue ih)
543 584
544parseScrapeQuery :: SimpleQuery -> ScrapeQuery
545parseScrapeQuery
546 = catMaybes . L.map (fromParam . snd) . L.filter (isScrapeParam . fst)
547
548-- | Overall information about particular torrent. 585-- | Overall information about particular torrent.
549data ScrapeEntry = ScrapeEntry { 586data ScrapeEntry = ScrapeEntry {
550 -- | Number of seeders - peers with the entire file. 587 -- | Number of seeders - peers with the entire file.