diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker/Message.hs')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Message.hs | 45 |
1 files changed, 24 insertions, 21 deletions
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs index de12a1fa..edafdaba 100644 --- a/src/Network/BitTorrent/Tracker/Message.hs +++ b/src/Network/BitTorrent/Tracker/Message.hs | |||
@@ -59,11 +59,12 @@ module Network.BitTorrent.Tracker.Message | |||
59 | , defaultAnnouncePath | 59 | , defaultAnnouncePath |
60 | , defaultScrapePath | 60 | , defaultScrapePath |
61 | 61 | ||
62 | -- ** Request | 62 | -- ** Preferences |
63 | , AnnounceQueryExt (..) | 63 | , AnnouncePrefs (..) |
64 | , renderAnnounceQueryExt | 64 | , renderAnnouncePrefs |
65 | , parseAnnounceQueryExt | 65 | , parseAnnouncePrefs |
66 | 66 | ||
67 | -- ** Request | ||
67 | , AnnounceRequest (..) | 68 | , AnnounceRequest (..) |
68 | , parseAnnounceRequest | 69 | , parseAnnounceRequest |
69 | , renderAnnounceRequest | 70 | , renderAnnounceRequest |
@@ -654,8 +655,10 @@ type ScrapeInfo = [(InfoHash, ScrapeEntry)] | |||
654 | -- HTTP specific | 655 | -- HTTP specific |
655 | -----------------------------------------------------------------------} | 656 | -----------------------------------------------------------------------} |
656 | 657 | ||
657 | -- | Extensions for HTTP tracker protocol. | 658 | -- | Some HTTP trackers allow to choose prefered representation of the |
658 | data AnnounceQueryExt = AnnounceQueryExt | 659 | -- 'AnnounceInfo'. It's optional for trackers to honor any of this |
660 | -- options. | ||
661 | data AnnouncePrefs = AnnouncePrefs | ||
659 | { -- | If specified, "compact" parameter is used to advise the | 662 | { -- | If specified, "compact" parameter is used to advise the |
660 | -- tracker to send peer id list as: | 663 | -- tracker to send peer id list as: |
661 | -- | 664 | -- |
@@ -680,11 +683,11 @@ data AnnounceQueryExt = AnnounceQueryExt | |||
680 | , extNoPeerId :: !(Maybe Bool) | 683 | , extNoPeerId :: !(Maybe Bool) |
681 | } deriving (Show, Eq, Typeable) | 684 | } deriving (Show, Eq, Typeable) |
682 | 685 | ||
683 | instance Default AnnounceQueryExt where | 686 | instance Default AnnouncePrefs where |
684 | def = AnnounceQueryExt Nothing Nothing | 687 | def = AnnouncePrefs Nothing Nothing |
685 | 688 | ||
686 | instance QueryLike AnnounceQueryExt where | 689 | instance QueryLike AnnouncePrefs where |
687 | toQuery AnnounceQueryExt {..} = | 690 | toQuery AnnouncePrefs {..} = |
688 | [ ("compact", toQueryFlag <$> extCompact) -- TODO use 'paramName' | 691 | [ ("compact", toQueryFlag <$> extCompact) -- TODO use 'paramName' |
689 | , ("no_peer_id", toQueryFlag <$> extNoPeerId) | 692 | , ("no_peer_id", toQueryFlag <$> extNoPeerId) |
690 | ] | 693 | ] |
@@ -693,32 +696,32 @@ instance QueryLike AnnounceQueryExt where | |||
693 | toQueryFlag True = "1" | 696 | toQueryFlag True = "1" |
694 | 697 | ||
695 | -- | Parse announce query extended part from query string. | 698 | -- | Parse announce query extended part from query string. |
696 | parseAnnounceQueryExt :: SimpleQuery -> AnnounceQueryExt | 699 | parseAnnouncePrefs :: SimpleQuery -> AnnouncePrefs |
697 | parseAnnounceQueryExt params = either (const def) id $ | 700 | parseAnnouncePrefs params = either (const def) id $ |
698 | AnnounceQueryExt | 701 | AnnouncePrefs |
699 | <$> optParam ParamCompact params | 702 | <$> optParam ParamCompact params |
700 | <*> optParam ParamNoPeerId params | 703 | <*> optParam ParamNoPeerId params |
701 | 704 | ||
702 | -- | Render announce query extended part to query string. | 705 | -- | Render announce preferences to query string. |
703 | renderAnnounceQueryExt :: AnnounceQueryExt -> SimpleQuery | 706 | renderAnnouncePrefs :: AnnouncePrefs -> SimpleQuery |
704 | renderAnnounceQueryExt = queryToSimpleQuery . toQuery | 707 | renderAnnouncePrefs = queryToSimpleQuery . toQuery |
705 | 708 | ||
706 | -- | HTTP tracker request with extensions. | 709 | -- | HTTP tracker request with preferences. |
707 | data AnnounceRequest = AnnounceRequest | 710 | data AnnounceRequest = AnnounceRequest |
708 | { announceQuery :: AnnounceQuery -- ^ Request query params. | 711 | { announceQuery :: AnnounceQuery -- ^ Request query params. |
709 | , announceAdvises :: AnnounceQueryExt -- ^ Optional advises to the tracker. | 712 | , announcePrefs :: AnnouncePrefs -- ^ Optional advises to the tracker. |
710 | } deriving (Show, Eq, Typeable) | 713 | } deriving (Show, Eq, Typeable) |
711 | 714 | ||
712 | instance QueryLike AnnounceRequest where | 715 | instance QueryLike AnnounceRequest where |
713 | toQuery AnnounceRequest{..} = | 716 | toQuery AnnounceRequest{..} = |
714 | toQuery announceAdvises <> | 717 | toQuery announcePrefs <> |
715 | toQuery announceQuery | 718 | toQuery announceQuery |
716 | 719 | ||
717 | -- | Parse announce request from query string. | 720 | -- | Parse announce request from query string. |
718 | parseAnnounceRequest :: SimpleQuery -> ParseResult AnnounceRequest | 721 | parseAnnounceRequest :: SimpleQuery -> ParseResult AnnounceRequest |
719 | parseAnnounceRequest params = AnnounceRequest | 722 | parseAnnounceRequest params = AnnounceRequest |
720 | <$> parseAnnounceQuery params | 723 | <$> parseAnnounceQuery params |
721 | <*> pure (parseAnnounceQueryExt params) | 724 | <*> pure (parseAnnouncePrefs params) |
722 | 725 | ||
723 | -- | Render announce request to query string. | 726 | -- | Render announce request to query string. |
724 | renderAnnounceRequest :: AnnounceRequest -> SimpleQuery | 727 | renderAnnounceRequest :: AnnounceRequest -> SimpleQuery |