diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent/Tracker/RPC.hs | 64 |
1 files changed, 33 insertions, 31 deletions
diff --git a/src/Network/BitTorrent/Tracker/RPC.hs b/src/Network/BitTorrent/Tracker/RPC.hs index c5aaeb03..04dbec1b 100644 --- a/src/Network/BitTorrent/Tracker/RPC.hs +++ b/src/Network/BitTorrent/Tracker/RPC.hs | |||
@@ -1,41 +1,43 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
1 | module Network.BitTorrent.Tracker.RPC | 8 | module Network.BitTorrent.Tracker.RPC |
2 | ( module Network.BitTorrent.Tracker.RPC.Message | 9 | ( Tracker |
3 | , TrackerRPC (..) | 10 | , Network.BitTorrent.Tracker.RPC.connect |
11 | , Network.BitTorrent.Tracker.RPC.announce | ||
12 | , Network.BitTorrent.Tracker.RPC.scrape | ||
4 | ) where | 13 | ) where |
5 | 14 | ||
6 | import Network.BitTorrent.Tracker.RPC.Message | 15 | import Control.Applicative |
16 | import Control.Exception | ||
17 | import Control.Monad.Trans.Resource | ||
18 | import Network.URI | ||
19 | |||
20 | import Network.BitTorrent.Tracker.Message | ||
7 | import Network.BitTorrent.Tracker.RPC.HTTP as HTTP | 21 | import Network.BitTorrent.Tracker.RPC.HTTP as HTTP |
8 | import Network.BitTorrent.Tracker.RPC.UDP as UDP | 22 | import Network.BitTorrent.Tracker.RPC.UDP as UDP |
9 | 23 | ||
10 | -- | Set of tracker RPCs. | ||
11 | class Tracker s where | ||
12 | connect :: URI -> IO s | ||
13 | announce :: s -> AnnounceQuery -> IO AnnounceInfo | ||
14 | scrape :: s -> ScrapeQuery -> IO Scrape | ||
15 | |||
16 | instance Tracker HTTP.Tracker where | ||
17 | connect = return . HTTP.Tracker | ||
18 | announce = HTTP.announce | ||
19 | scrape = undefined | ||
20 | |||
21 | instance Tracker UDP.Tracker where | ||
22 | connect = initialTracker | ||
23 | announce = announce | ||
24 | scrape = undefined | ||
25 | 24 | ||
26 | data BitTracker = HTTPTr HTTPTracker | 25 | data Tracker |
27 | | UDPTr UDPTracker | 26 | = HTracker Connection |
27 | | UTracker UDPTracker | ||
28 | 28 | ||
29 | instance Tracker BitTracker where | 29 | connect :: URI -> IO Tracker |
30 | connect uri @ URI {..} | 30 | connect uri @ URI {..} |
31 | | uriScheme == "udp:" = UDPTr <$> connect uri | 31 | | uriScheme == "http:" = HTracker <$> runResourceT (HTTP.connect uri) |
32 | | uriScheme == "http:" = HTTPTr <$> connect uri | 32 | | uriScheme == "udp:" = UTracker <$> UDP.connect uri |
33 | | otherwise = throwIO $ userError msg | 33 | | otherwise = throwIO $ userError msg |
34 | where | 34 | where |
35 | msg = "unknown tracker protocol scheme: " ++ show uriScheme | 35 | msg = "unknown tracker protocol scheme: " ++ show uriScheme |
36 | 36 | ||
37 | announce (HTTPTr t) = Tracker.announce t | 37 | announce :: AnnounceQuery -> Tracker -> IO AnnounceInfo |
38 | announce (UDPTr t) = Tracker.announce t | 38 | announce q (HTracker t) = runResourceT $ HTTP.announce q t |
39 | announce q (UTracker t) = UDP.announce q t | ||
39 | 40 | ||
40 | scrape (HTTPTr t) = scrape t | 41 | scrape :: ScrapeQuery -> Tracker -> IO ScrapeInfo |
41 | scrape (UDPTr t) = scrape t | 42 | scrape q (HTracker t) = runResourceT $ HTTP.scrape q t |
43 | scrape q (UTracker t) = UDP.scrape q t | ||