2 files changed, 39 insertions, 10 deletions

diff --git a/src/Network/BitTorrent/Tracker/HTTP.hs b/src/Network/BitTorrent/Tracker/HTTP.hs
index 4fef5e56..8d3a6412 100644
--- a/src/Network/BitTorrent/Tracker/HTTP.hs
+++ b/src/Network/BitTorrent/Tracker/HTTP.hs
@@ -33,6 +33,17 @@ import Network.HTTP
 import Data.Torrent.Metainfo hiding (announce)
 import Network.BitTorrent.Tracker.Protocol
 
+
+data HTTPTracker = HTTPTracker URI
+
+instance Tracker URI where
+  announce = askTracker
+  scrape_  uri ihs = do
+    e <- scrape uri ihs
+    case e of
+      Left str  -> error str
+      Right si  -> return si
+
 {-----------------------------------------------------------------------
   Announce
 -----------------------------------------------------------------------}
@@ -42,8 +53,8 @@ encodeRequest announce req = URL.urlEncode req
                     `addToURI`      announce
                     `addHashToURI`  reqInfoHash req
 
-mkHTTPRequest :: URI -> Request ByteString
-mkHTTPRequest uri = Request uri GET [] ""
+mkGET :: URI -> Request ByteString
+mkGET uri = Request uri GET [] ""
 
 -- TODO rename to something like "announceBlahBlah"
 
@@ -53,7 +64,7 @@ mkHTTPRequest uri = Request uri GET [] ""
 --
 askTracker :: URI -> AnnounceQuery -> IO AnnounceInfo
 askTracker announce req = do
-    let r = mkHTTPRequest (encodeRequest announce req)
+    let r = mkGET (encodeRequest announce req)
 
     rawResp  <- simpleHTTP r
     respBody <- getResponseBody rawResp
@@ -69,16 +80,13 @@ askTracker announce req = do
 -- conjunction with 'Stopped'.
 leaveTracker :: URI -> AnnounceQuery -> IO ()
 leaveTracker announce req = do
-  let r = mkHTTPRequest (encodeRequest announce req)
+  let r = mkGET (encodeRequest announce req)
   void $ simpleHTTP r >>= getResponseBody
 
 {-----------------------------------------------------------------------
   Scrape
 -----------------------------------------------------------------------}
 
--- | Scrape info about a set of torrents.
-type Scrape = Map InfoHash ScrapeInfo
-
 -- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL'
 --   gives 'Nothing' then tracker do not support scraping. The info hash
 --   list is used to restrict the tracker's report to that particular
diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs
index 4e1262ed..b67b856d 100644
--- a/src/Network/BitTorrent/Tracker/Protocol.hs
+++ b/src/Network/BitTorrent/Tracker/Protocol.hs
@@ -23,9 +23,22 @@
 {-# LANGUAGE TemplateHaskell            #-}
 {-# OPTIONS -fno-warn-orphans           #-}
 module Network.BitTorrent.Tracker.Protocol
-       ( Event(..), AnnounceQuery(..), AnnounceInfo(..)
-       , defaultNumWant , defaultPorts
-       , ScrapeQuery, ScrapeInfo(..)
+       ( -- * Announce
+         Event(..)
+       , AnnounceQuery(..)
+       , AnnounceInfo(..)
+
+         -- ** Defaults
+       , defaultNumWant
+       , defaultPorts
+
+         -- * Scrape
+       , ScrapeQuery
+       , ScrapeInfo(..)
+       , Scrape
+
+         -- * TODO
+       , Tracker(..)
        )
        where
 
@@ -325,6 +338,9 @@ data ScrapeInfo = ScrapeInfo {
 
 $(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo)
 
+-- | Scrape info about a set of torrents.
+type Scrape = Map InfoHash ScrapeInfo
+
 instance BEncodable ScrapeInfo where
   toBEncode ScrapeInfo {..} = fromAssocs
     [ "complete"   -->  siComplete
@@ -357,3 +373,8 @@ instance Serialize ScrapeInfo where
       , siIncomplete = fromIntegral leechers
       , siName       = Nothing
       }
+
+-- | Set of tracker RPCs.
+class Tracker s where
+  announce :: s -> AnnounceQuery -> IO AnnounceInfo
+  scrape_  :: s -> ScrapeQuery   -> IO Scrape