diff options
author | joe <joe@jerkface.net> | 2018-06-08 23:34:14 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2018-06-08 23:34:14 -0400 |
commit | 2625c8b7a66c0245d1eacbe0076f04df6ae8acd8 (patch) | |
tree | 89e4d9c7bc56c649d8ca8363234c81eb5fb02a70 /bittorrent | |
parent | f02276f5240cf985ec3c4c3eaa5d1f5bc3daf4e6 (diff) |
bittorrent: Easier constructor for TrackerList.
Diffstat (limited to 'bittorrent')
-rw-r--r-- | bittorrent/src/Network/BitTorrent/Tracker.hs | 1 | ||||
-rw-r--r-- | bittorrent/src/Network/BitTorrent/Tracker/List.hs | 4 | ||||
-rw-r--r-- | bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs | 2 |
3 files changed, 6 insertions, 1 deletions
diff --git a/bittorrent/src/Network/BitTorrent/Tracker.hs b/bittorrent/src/Network/BitTorrent/Tracker.hs index 6db67559..1191f921 100644 --- a/bittorrent/src/Network/BitTorrent/Tracker.hs +++ b/bittorrent/src/Network/BitTorrent/Tracker.hs | |||
@@ -23,6 +23,7 @@ module Network.BitTorrent.Tracker | |||
23 | , trackerList | 23 | , trackerList |
24 | , Session | 24 | , Session |
25 | , Event (..) | 25 | , Event (..) |
26 | , trackers | ||
26 | , newSession | 27 | , newSession |
27 | , closeSession | 28 | , closeSession |
28 | , withSession | 29 | , withSession |
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/List.hs b/bittorrent/src/Network/BitTorrent/Tracker/List.hs index 0eb11641..1507b4be 100644 --- a/bittorrent/src/Network/BitTorrent/Tracker/List.hs +++ b/bittorrent/src/Network/BitTorrent/Tracker/List.hs | |||
@@ -16,6 +16,7 @@ module Network.BitTorrent.Tracker.List | |||
16 | , TrackerList | 16 | , TrackerList |
17 | 17 | ||
18 | -- * Construction | 18 | -- * Construction |
19 | , trackers | ||
19 | , trackerList | 20 | , trackerList |
20 | , shuffleTiers | 21 | , shuffleTiers |
21 | , mapWithURI | 22 | , mapWithURI |
@@ -116,6 +117,9 @@ fixList mxss mx = do | |||
116 | let xss' = L.filter (not . L.null) xss | 117 | let xss' = L.filter (not . L.null) xss |
117 | return $ maybe xss' (addBackup xss') mx | 118 | return $ maybe xss' (addBackup xss') mx |
118 | 119 | ||
120 | trackers :: [URI] -> TrackerList () | ||
121 | trackers uris = TierList $ map (\uri -> [(uri,())]) uris | ||
122 | |||
119 | -- | Extract set of trackers from torrent file. The 'tAnnounce' key is | 123 | -- | Extract set of trackers from torrent file. The 'tAnnounce' key is |
120 | -- only ignored if the 'tAnnounceList' key is present. | 124 | -- only ignored if the 'tAnnounceList' key is present. |
121 | trackerList :: Torrent -> TrackerList () | 125 | trackerList :: Torrent -> TrackerList () |
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs b/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs index 44b123a3..6f7a53bf 100644 --- a/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs +++ b/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs | |||
@@ -129,7 +129,7 @@ fillRequest Options {..} q r = r | |||
129 | 129 | ||
130 | httpTracker :: BEncode a => Manager -> URI -> SimpleQuery -> IO a | 130 | httpTracker :: BEncode a => Manager -> URI -> SimpleQuery -> IO a |
131 | httpTracker Manager {..} uri q = packHttpException $ do | 131 | httpTracker Manager {..} uri q = packHttpException $ do |
132 | request <- fillRequest options q <$> setUri defaultRequest {- http-client instance for Request -} uri | 132 | request <- fillRequest options q <$> setUri defaultRequest uri |
133 | response <- runResourceT $ httpLbs request httpMgr | 133 | response <- runResourceT $ httpLbs request httpMgr |
134 | case BE.decode $ BL.toStrict $ responseBody response of | 134 | case BE.decode $ BL.toStrict $ responseBody response of |
135 | Left msg -> throwIO (ParserFailure msg) | 135 | Left msg -> throwIO (ParserFailure msg) |