diff options
-rw-r--r-- | src/Network/BitTorrent/Tracker/HTTP.hs | 2 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Message.hs | 90 |
2 files changed, 86 insertions, 6 deletions
diff --git a/src/Network/BitTorrent/Tracker/HTTP.hs b/src/Network/BitTorrent/Tracker/HTTP.hs index 2d49436d..b466b49e 100644 --- a/src/Network/BitTorrent/Tracker/HTTP.hs +++ b/src/Network/BitTorrent/Tracker/HTTP.hs | |||
@@ -69,7 +69,7 @@ mkGET uri = Request uri GET [] "" | |||
69 | -- | 69 | -- |
70 | announceHTTP :: HTTPTracker -> AnnounceQuery -> IO AnnounceInfo | 70 | announceHTTP :: HTTPTracker -> AnnounceQuery -> IO AnnounceInfo |
71 | announceHTTP HTTPTracker {..} req = do | 71 | announceHTTP HTTPTracker {..} req = do |
72 | let r = mkGET (encodeRequest announceURI req) | 72 | let r = mkGET (renderAnnounceQuery announceURI req) |
73 | 73 | ||
74 | rawResp <- simpleHTTP r | 74 | rawResp <- simpleHTTP r |
75 | respBody <- getResponseBody rawResp | 75 | respBody <- getResponseBody rawResp |
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs index 508ff4c5..22733a51 100644 --- a/src/Network/BitTorrent/Tracker/Message.hs +++ b/src/Network/BitTorrent/Tracker/Message.hs | |||
@@ -28,12 +28,15 @@ module Network.BitTorrent.Tracker.Message | |||
28 | -- ** Request | 28 | -- ** Request |
29 | Event(..) | 29 | Event(..) |
30 | , AnnounceQuery(..) | 30 | , AnnounceQuery(..) |
31 | , encodeRequest | 31 | , renderAnnounceQuery |
32 | , ParamParseFailure | ||
33 | , parseAnnounceQuery | ||
32 | 34 | ||
33 | -- ** Response | 35 | -- ** Response |
34 | , PeerList (..) | 36 | , PeerList (..) |
35 | , AnnounceInfo(..) | 37 | , AnnounceInfo(..) |
36 | , defaultNumWant | 38 | , defaultNumWant |
39 | , paramFailureCode | ||
37 | 40 | ||
38 | -- * Scrape | 41 | -- * Scrape |
39 | , ScrapeQuery | 42 | , ScrapeQuery |
@@ -209,10 +212,73 @@ instance Serialize AnnounceQuery where | |||
209 | , reqEvent = ev | 212 | , reqEvent = ev |
210 | } | 213 | } |
211 | 214 | ||
212 | encodeRequest :: URI -> AnnounceQuery -> URI | 215 | -- | Encoding announce query and add it to the base tracker URL. |
213 | encodeRequest announceURI req = URL.urlEncode req | 216 | renderAnnounceQuery :: URI -> AnnounceQuery -> URI |
214 | `addToURI` announceURI | 217 | renderAnnounceQuery announceURI req |
215 | `addHashToURI` reqInfoHash req | 218 | = URL.urlEncode req |
219 | `addToURI` announceURI | ||
220 | `addHashToURI` reqInfoHash req | ||
221 | |||
222 | data QueryParam | ||
223 | = ParamInfoHash | ||
224 | | ParamPeerId | ||
225 | | ParamPort | ||
226 | | ParamProgress | ||
227 | | ParamIP | ||
228 | | ParamNumWant | ||
229 | | ParamEvent | ||
230 | deriving (Show, Eq, Ord, Enum) | ||
231 | |||
232 | data ParamParseFailure | ||
233 | = Missing QueryParam -- ^ param not found in query string | ||
234 | | Invalid QueryParam -- ^ param present but not valid. | ||
235 | |||
236 | type ParamResult = Either ParamParseFailure | ||
237 | |||
238 | textToPeerId :: Text -> Maybe PeerId | ||
239 | textToPeerId = undefined | ||
240 | |||
241 | textToPortNumber :: Text -> Maybe PortNumber | ||
242 | textToPortNumber = undefined | ||
243 | |||
244 | textToHostAddress :: Text -> Maybe HostAddress | ||
245 | textToHostAddress = undefined | ||
246 | |||
247 | textToNumWant :: Text -> Maybe Int | ||
248 | textToNumWant = undefined | ||
249 | |||
250 | textToEvent :: Text -> Maybe Event | ||
251 | textToEvent = undefined | ||
252 | |||
253 | paramName :: QueryParam -> Text | ||
254 | paramName ParamInfoHash = "info_hash" | ||
255 | paramName ParamPeerId = "peer_id" | ||
256 | paramName ParamPort = "port" | ||
257 | |||
258 | -- | Parse announce request from a query string. | ||
259 | parseAnnounceQuery :: [(Text, Text)] -> Either ParamParseFailure AnnounceQuery | ||
260 | parseAnnounceQuery params = AnnounceQuery | ||
261 | <$> reqParam ParamInfoHash textToInfoHash params | ||
262 | <*> reqParam ParamPeerId textToPeerId params | ||
263 | <*> reqParam ParamPort textToPortNumber params | ||
264 | <*> progress params | ||
265 | <*> optParam ParamIP textToHostAddress params | ||
266 | <*> optParam ParamNumWant textToNumWant params | ||
267 | <*> optParam ParamEvent textToEvent params | ||
268 | where | ||
269 | withError e = maybe (Left e) Right | ||
270 | reqParam param p = withError (Missing param) . L.lookup (paramName param) | ||
271 | >=> withError (Invalid param) . p | ||
272 | |||
273 | optParam param p ps | ||
274 | | Just x <- L.lookup (paramName param) ps | ||
275 | = pure <$> withError (Invalid param) (p x) | ||
276 | | otherwise = pure Nothing | ||
277 | |||
278 | progress = undefined | ||
279 | ip = undefined | ||
280 | numwant = undefined | ||
281 | event = undefined | ||
216 | 282 | ||
217 | {----------------------------------------------------------------------- | 283 | {----------------------------------------------------------------------- |
218 | -- Announce response | 284 | -- Announce response |
@@ -336,6 +402,20 @@ instance Serialize AnnounceInfo where | |||
336 | defaultNumWant :: Int | 402 | defaultNumWant :: Int |
337 | defaultNumWant = 50 | 403 | defaultNumWant = 50 |
338 | 404 | ||
405 | missingOffset :: Int | ||
406 | missingOffset = 101 | ||
407 | |||
408 | invalidOffset :: Int | ||
409 | invalidOffset = 150 | ||
410 | |||
411 | -- | Get | ||
412 | -- | ||
413 | -- For more info see: | ||
414 | -- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Response_Codes> | ||
415 | paramFailureCode :: ParamParseFailure -> Int | ||
416 | paramFailureCode (Missing param) = missingOffset + fromEnum param | ||
417 | paramFailureCode (Invalid param) = invalidOffset + fromEnum param | ||
418 | |||
339 | {----------------------------------------------------------------------- | 419 | {----------------------------------------------------------------------- |
340 | Scrape message | 420 | Scrape message |
341 | -----------------------------------------------------------------------} | 421 | -----------------------------------------------------------------------} |