summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Tracker/Message.hs236
1 files changed, 120 insertions, 116 deletions
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index 17871133..de12a1fa 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -73,7 +73,7 @@ module Network.BitTorrent.Tracker.Message
73 , scrapeType 73 , scrapeType
74 , parseFailureStatus 74 , parseFailureStatus
75 75
76 -- * Extra 76 -- ** Extra
77 , queryToSimpleQuery 77 , queryToSimpleQuery
78 ) 78 )
79 where 79 where
@@ -309,6 +309,11 @@ paramName ParamNoPeerId = "no_peer_id"
309class FromParam a where 309class FromParam a where
310 fromParam :: BS.ByteString -> Maybe a 310 fromParam :: BS.ByteString -> Maybe a
311 311
312instance FromParam Bool where
313 fromParam "0" = Just False
314 fromParam "1" = Just True
315 fromParam _ = Nothing
316
312instance FromParam InfoHash where 317instance FromParam InfoHash where
313 fromParam = either (const Nothing) pure . safeConvert 318 fromParam = either (const Nothing) pure . safeConvert
314 319
@@ -375,83 +380,8 @@ parseAnnounceQuery params = AnnounceQuery
375 <*> optParam ParamNumWant params 380 <*> optParam ParamNumWant params
376 <*> optParam ParamEvent params 381 <*> optParam ParamEvent params
377 382
378-- | Extensions for HTTP tracker protocol.
379data AnnounceQueryExt = AnnounceQueryExt
380 { -- | If specified, "compact" parameter is used to advise the
381 -- tracker to send peer id list as:
382 --
383 -- * bencoded list (extCompact = Just False);
384 -- * or more compact binary string (extCompact = Just True).
385 --
386 -- The later is prefered since compact peer list will reduce the
387 -- size of tracker responses. Hovewer, if tracker do not support
388 -- this extension then it can return peer list in either form.
389 --
390 -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
391 --
392 extCompact :: !(Maybe Bool)
393
394 -- | If specified, "no_peer_id" parameter is used advise tracker
395 -- to either send or not to send peer id in tracker response.
396 -- Tracker may not support this extension as well.
397 --
398 -- For more info see:
399 -- <http://permalink.gmane.org/gmane.network.bit-torrent.general/4030>
400 --
401 , extNoPeerId :: !(Maybe Bool)
402 } deriving (Show, Eq, Typeable)
403
404instance Default AnnounceQueryExt where
405 def = AnnounceQueryExt Nothing Nothing
406
407instance QueryLike AnnounceQueryExt where
408 toQuery AnnounceQueryExt {..} =
409 [ ("compact", toQueryFlag <$> extCompact) -- TODO use 'paramName'
410 , ("no_peer_id", toQueryFlag <$> extNoPeerId)
411 ]
412 where
413 toQueryFlag False = "0"
414 toQueryFlag True = "1"
415
416instance FromParam Bool where
417 fromParam "0" = Just False
418 fromParam "1" = Just True
419 fromParam _ = Nothing
420
421-- | Parse announce query extended part from query string.
422parseAnnounceQueryExt :: SimpleQuery -> AnnounceQueryExt
423parseAnnounceQueryExt params = either (const def) id $
424 AnnounceQueryExt
425 <$> optParam ParamCompact params
426 <*> optParam ParamNoPeerId params
427
428-- | Render announce query extended part to query string.
429renderAnnounceQueryExt :: AnnounceQueryExt -> SimpleQuery
430renderAnnounceQueryExt = queryToSimpleQuery . toQuery
431
432-- | HTTP tracker request with extensions.
433data AnnounceRequest = AnnounceRequest
434 { announceQuery :: AnnounceQuery -- ^ Request query params.
435 , announceAdvises :: AnnounceQueryExt -- ^ Optional advises to the tracker.
436 } deriving (Show, Eq, Typeable)
437
438instance QueryLike AnnounceRequest where
439 toQuery AnnounceRequest{..} =
440 toQuery announceAdvises <>
441 toQuery announceQuery
442
443-- | Parse announce request from query string.
444parseAnnounceRequest :: SimpleQuery -> ParseResult AnnounceRequest
445parseAnnounceRequest params = AnnounceRequest
446 <$> parseAnnounceQuery params
447 <*> pure (parseAnnounceQueryExt params)
448
449-- | Render announce request to query string.
450renderAnnounceRequest :: AnnounceRequest -> SimpleQuery
451renderAnnounceRequest = queryToSimpleQuery . toQuery
452
453{----------------------------------------------------------------------- 383{-----------------------------------------------------------------------
454-- Announce response 384-- Announce Info
455-----------------------------------------------------------------------} 385-----------------------------------------------------------------------}
456-- TODO check if announceinterval/complete/incomplete is positive ints 386-- TODO check if announceinterval/complete/incomplete is positive ints
457 387
@@ -632,45 +562,6 @@ defaultMaxNumWant = 200
632defaultReannounceInterval :: Int 562defaultReannounceInterval :: Int
633defaultReannounceInterval = 30 * 60 563defaultReannounceInterval = 30 * 60
634 564
635type PathPiece = BS.ByteString
636
637defaultAnnouncePath :: PathPiece
638defaultAnnouncePath = "announce"
639
640defaultScrapePath :: PathPiece
641defaultScrapePath = "scrape"
642
643missingOffset :: Int
644missingOffset = 101
645
646invalidOffset :: Int
647invalidOffset = 150
648
649parseFailureCode :: ParamParseFailure -> Int
650parseFailureCode (Missing param ) = missingOffset + fromEnum param
651parseFailureCode (Invalid param _) = invalidOffset + fromEnum param
652
653parseFailureMessage :: ParamParseFailure -> BS.ByteString
654parseFailureMessage e = BS.concat $ case e of
655 Missing p -> ["Missing parameter: ", paramName p]
656 Invalid p v -> ["Invalid parameter: ", paramName p, " = ", v]
657
658-- | HTTP response /content type/ for announce info.
659announceType :: ByteString
660announceType = "text/plain"
661
662-- | HTTP response /content type/ for scrape info.
663scrapeType :: ByteString
664scrapeType = "text/plain"
665
666-- | Get HTTP response status from a announce params parse failure.
667--
668-- For more info see:
669-- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Response_Codes>
670--
671parseFailureStatus :: ParamParseFailure -> Status
672parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage
673
674{----------------------------------------------------------------------- 565{-----------------------------------------------------------------------
675 Scrape message 566 Scrape message
676-----------------------------------------------------------------------} 567-----------------------------------------------------------------------}
@@ -758,3 +649,116 @@ instance Serialize ScrapeEntry where
758 649
759-- | Scrape info about a set of torrents. 650-- | Scrape info about a set of torrents.
760type ScrapeInfo = [(InfoHash, ScrapeEntry)] 651type ScrapeInfo = [(InfoHash, ScrapeEntry)]
652
653{-----------------------------------------------------------------------
654-- HTTP specific
655-----------------------------------------------------------------------}
656
657-- | Extensions for HTTP tracker protocol.
658data AnnounceQueryExt = AnnounceQueryExt
659 { -- | If specified, "compact" parameter is used to advise the
660 -- tracker to send peer id list as:
661 --
662 -- * bencoded list (extCompact = Just False);
663 -- * or more compact binary string (extCompact = Just True).
664 --
665 -- The later is prefered since compact peer list will reduce the
666 -- size of tracker responses. Hovewer, if tracker do not support
667 -- this extension then it can return peer list in either form.
668 --
669 -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
670 --
671 extCompact :: !(Maybe Bool)
672
673 -- | If specified, "no_peer_id" parameter is used advise tracker
674 -- to either send or not to send peer id in tracker response.
675 -- Tracker may not support this extension as well.
676 --
677 -- For more info see:
678 -- <http://permalink.gmane.org/gmane.network.bit-torrent.general/4030>
679 --
680 , extNoPeerId :: !(Maybe Bool)
681 } deriving (Show, Eq, Typeable)
682
683instance Default AnnounceQueryExt where
684 def = AnnounceQueryExt Nothing Nothing
685
686instance QueryLike AnnounceQueryExt where
687 toQuery AnnounceQueryExt {..} =
688 [ ("compact", toQueryFlag <$> extCompact) -- TODO use 'paramName'
689 , ("no_peer_id", toQueryFlag <$> extNoPeerId)
690 ]
691 where
692 toQueryFlag False = "0"
693 toQueryFlag True = "1"
694
695-- | Parse announce query extended part from query string.
696parseAnnounceQueryExt :: SimpleQuery -> AnnounceQueryExt
697parseAnnounceQueryExt params = either (const def) id $
698 AnnounceQueryExt
699 <$> optParam ParamCompact params
700 <*> optParam ParamNoPeerId params
701
702-- | Render announce query extended part to query string.
703renderAnnounceQueryExt :: AnnounceQueryExt -> SimpleQuery
704renderAnnounceQueryExt = queryToSimpleQuery . toQuery
705
706-- | HTTP tracker request with extensions.
707data AnnounceRequest = AnnounceRequest
708 { announceQuery :: AnnounceQuery -- ^ Request query params.
709 , announceAdvises :: AnnounceQueryExt -- ^ Optional advises to the tracker.
710 } deriving (Show, Eq, Typeable)
711
712instance QueryLike AnnounceRequest where
713 toQuery AnnounceRequest{..} =
714 toQuery announceAdvises <>
715 toQuery announceQuery
716
717-- | Parse announce request from query string.
718parseAnnounceRequest :: SimpleQuery -> ParseResult AnnounceRequest
719parseAnnounceRequest params = AnnounceRequest
720 <$> parseAnnounceQuery params
721 <*> pure (parseAnnounceQueryExt params)
722
723-- | Render announce request to query string.
724renderAnnounceRequest :: AnnounceRequest -> SimpleQuery
725renderAnnounceRequest = queryToSimpleQuery . toQuery
726
727type PathPiece = BS.ByteString
728
729defaultAnnouncePath :: PathPiece
730defaultAnnouncePath = "announce"
731
732defaultScrapePath :: PathPiece
733defaultScrapePath = "scrape"
734
735missingOffset :: Int
736missingOffset = 101
737
738invalidOffset :: Int
739invalidOffset = 150
740
741parseFailureCode :: ParamParseFailure -> Int
742parseFailureCode (Missing param ) = missingOffset + fromEnum param
743parseFailureCode (Invalid param _) = invalidOffset + fromEnum param
744
745parseFailureMessage :: ParamParseFailure -> BS.ByteString
746parseFailureMessage e = BS.concat $ case e of
747 Missing p -> ["Missing parameter: ", paramName p]
748 Invalid p v -> ["Invalid parameter: ", paramName p, " = ", v]
749
750-- | HTTP response /content type/ for announce info.
751announceType :: ByteString
752announceType = "text/plain"
753
754-- | HTTP response /content type/ for scrape info.
755scrapeType :: ByteString
756scrapeType = "text/plain"
757
758-- | Get HTTP response status from a announce params parse failure.
759--
760-- For more info see:
761-- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Response_Codes>
762--
763parseFailureStatus :: ParamParseFailure -> Status
764parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage