summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker/RPC.hs
blob: c5aaeb03d4d73adb2b61f30e3bffb4a81fafa64b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
module Network.BitTorrent.Tracker.RPC
       ( module Network.BitTorrent.Tracker.RPC.Message
       , TrackerRPC (..)
       ) where

import Network.BitTorrent.Tracker.RPC.Message
import Network.BitTorrent.Tracker.RPC.HTTP as HTTP
import Network.BitTorrent.Tracker.RPC.UDP  as UDP

-- | Set of tracker RPCs.
class Tracker s where
  connect  :: URI -> IO s
  announce :: s -> AnnounceQuery -> IO AnnounceInfo
  scrape   :: s -> ScrapeQuery   -> IO Scrape

instance Tracker HTTP.Tracker where
  connect  = return . HTTP.Tracker
  announce = HTTP.announce
  scrape   = undefined

instance Tracker UDP.Tracker where
  connect  = initialTracker
  announce = announce
  scrape   = undefined

data BitTracker = HTTPTr HTTPTracker
                | UDPTr UDPTracker

instance Tracker BitTracker where
  connect uri @ URI {..}
    | uriScheme == "udp:"  = UDPTr  <$> connect uri
    | uriScheme == "http:" = HTTPTr <$> connect uri
    |       otherwise      = throwIO $ userError msg
    where
      msg = "unknown tracker protocol scheme: " ++ show uriScheme

  announce (HTTPTr t) = Tracker.announce t
  announce (UDPTr  t) = Tracker.announce t

  scrape (HTTPTr t) = scrape t
  scrape (UDPTr  t) = scrape t