diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-30 13:06:09 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-30 13:06:09 +0400 |
commit | 5573c240b4c2e87cf2deb55939591edd0851f8b8 (patch) | |
tree | 4c51ad9d979ad1c1b34e9083cfbe67c5a3650aa2 /src/Network/BitTorrent/Tracker/RPC | |
parent | 7f54308b57615bc61c0727538af2b5a54366eadb (diff) |
Add basic spec for UDP tracker RPC
Diffstat (limited to 'src/Network/BitTorrent/Tracker/RPC')
-rw-r--r-- | src/Network/BitTorrent/Tracker/RPC/Message.hs | 2 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/RPC/UDP.hs | 18 |
2 files changed, 11 insertions, 9 deletions
diff --git a/src/Network/BitTorrent/Tracker/RPC/Message.hs b/src/Network/BitTorrent/Tracker/RPC/Message.hs index 18c1a4c7..a0691f37 100644 --- a/src/Network/BitTorrent/Tracker/RPC/Message.hs +++ b/src/Network/BitTorrent/Tracker/RPC/Message.hs | |||
@@ -482,6 +482,7 @@ parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage | |||
482 | 482 | ||
483 | type ScrapeQuery = [InfoHash] | 483 | type ScrapeQuery = [InfoHash] |
484 | 484 | ||
485 | -- TODO rename to ScrapeEntry | ||
485 | -- | Overall information about particular torrent. | 486 | -- | Overall information about particular torrent. |
486 | data ScrapeInfo = ScrapeInfo { | 487 | data ScrapeInfo = ScrapeInfo { |
487 | -- | Number of seeders - peers with the entire file. | 488 | -- | Number of seeders - peers with the entire file. |
@@ -501,6 +502,7 @@ data ScrapeInfo = ScrapeInfo { | |||
501 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) | 502 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) |
502 | 503 | ||
503 | -- TODO hash map | 504 | -- TODO hash map |
505 | -- TODO rename to ScrapeInfo | ||
504 | -- | Scrape info about a set of torrents. | 506 | -- | Scrape info about a set of torrents. |
505 | type Scrape = Map InfoHash ScrapeInfo | 507 | type Scrape = Map InfoHash ScrapeInfo |
506 | 508 | ||
diff --git a/src/Network/BitTorrent/Tracker/RPC/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs index beff6b4f..0336db8d 100644 --- a/src/Network/BitTorrent/Tracker/RPC/UDP.hs +++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs | |||
@@ -39,7 +39,7 @@ import Data.Text.Encoding | |||
39 | import Data.Time | 39 | import Data.Time |
40 | import Data.Word | 40 | import Data.Word |
41 | import Text.Read (readMaybe) | 41 | import Text.Read (readMaybe) |
42 | import Network.Socket hiding (Connected) | 42 | import Network.Socket hiding (Connected, connect) |
43 | import Network.Socket.ByteString as BS | 43 | import Network.Socket.ByteString as BS |
44 | import Network.URI | 44 | import Network.URI |
45 | import System.Entropy | 45 | import System.Entropy |
@@ -290,8 +290,8 @@ connectUDP tracker = do | |||
290 | Failed msg -> throwIO $ userError $ T.unpack msg | 290 | Failed msg -> throwIO $ userError $ T.unpack msg |
291 | _ -> throwIO $ userError "message type mismatch" | 291 | _ -> throwIO $ userError "message type mismatch" |
292 | 292 | ||
293 | initialTracker :: URI -> IO UDPTracker | 293 | connect :: URI -> IO UDPTracker |
294 | initialTracker uri = do | 294 | connect uri = do |
295 | tracker <- UDPTracker uri <$> (newIORef =<< initialConnection) | 295 | tracker <- UDPTracker uri <$> (newIORef =<< initialConnection) |
296 | connId <- connectUDP tracker | 296 | connId <- connectUDP tracker |
297 | updateConnection connId tracker | 297 | updateConnection connId tracker |
@@ -305,20 +305,20 @@ freshConnection tracker @ UDPTracker {..} = do | |||
305 | connId <- connectUDP tracker | 305 | connId <- connectUDP tracker |
306 | updateConnection connId tracker | 306 | updateConnection connId tracker |
307 | 307 | ||
308 | announce :: UDPTracker -> AnnounceQuery -> IO AnnounceInfo | 308 | announce :: AnnounceQuery -> UDPTracker -> IO AnnounceInfo |
309 | announce tracker ann = do | 309 | announce ann tracker = do |
310 | freshConnection tracker | 310 | freshConnection tracker |
311 | resp <- transaction tracker (Announce ann) | 311 | resp <- transaction tracker (Announce ann) |
312 | case resp of | 312 | case resp of |
313 | Announced info -> return info | 313 | Announced info -> return info |
314 | _ -> fail "announce: response type mismatch" | 314 | _ -> fail "announce: response type mismatch" |
315 | 315 | ||
316 | scrape :: UDPTracker -> ScrapeQuery -> IO Scrape | 316 | scrape :: ScrapeQuery -> UDPTracker -> IO Scrape |
317 | scrape tracker scr = do | 317 | scrape ihs tracker = do |
318 | freshConnection tracker | 318 | freshConnection tracker |
319 | resp <- transaction tracker (Scrape scr) | 319 | resp <- transaction tracker (Scrape ihs) |
320 | case resp of | 320 | case resp of |
321 | Scraped info -> return $ M.fromList $ L.zip scr info | 321 | Scraped info -> return $ M.fromList $ L.zip ihs info |
322 | _ -> fail "scrape: response type mismatch" | 322 | _ -> fail "scrape: response type mismatch" |
323 | 323 | ||
324 | {----------------------------------------------------------------------- | 324 | {----------------------------------------------------------------------- |