Expose tracker RPC module

5 files changed, 45 insertions, 35 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index f1a4f545..e420beba 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -68,7 +68,7 @@ library
                        Network.BitTorrent.Exchange.Wire
 --                     Network.BitTorrent.Tracker
                        Network.BitTorrent.Tracker.Message
---                     Network.BitTorrent.Tracker.RPC
+                       Network.BitTorrent.Tracker.RPC
                        Network.BitTorrent.Tracker.RPC.HTTP
                        Network.BitTorrent.Tracker.RPC.UDP
                        Network.BitTorrent.Tracker.Wai
@@ -163,6 +163,7 @@ test-suite spec
                        Network.BitTorrent.Core.PeerIdSpec
                        Network.BitTorrent.Core.FingerprintSpec
                        Network.BitTorrent.Tracker.MessageSpec
+                       Network.BitTorrent.Tracker.RPCSpec
                        Network.BitTorrent.Tracker.RPC.HTTPSpec
                        Network.BitTorrent.Tracker.RPC.UDPSpec
                        Network.BitTorrent.Exchange.MessageSpec
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 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
 module Network.BitTorrent.Tracker.RPC
-       ( module Network.BitTorrent.Tracker.RPC.Message
-       , TrackerRPC (..)
+       ( Tracker
+       , Network.BitTorrent.Tracker.RPC.connect
+       , Network.BitTorrent.Tracker.RPC.announce
+       , Network.BitTorrent.Tracker.RPC.scrape
        ) where
 
-import Network.BitTorrent.Tracker.RPC.Message
+import Control.Applicative
+import Control.Exception
+import Control.Monad.Trans.Resource
+import Network.URI
+
+import Network.BitTorrent.Tracker.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
+data Tracker
+  = HTracker Connection
+  | UTracker 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
+connect :: URI -> IO Tracker
+connect uri @ URI {..}
+  | uriScheme == "http:" = HTracker <$> runResourceT (HTTP.connect uri)
+  | uriScheme == "udp:"  = UTracker <$> UDP.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
+announce :: AnnounceQuery -> Tracker -> IO AnnounceInfo
+announce q (HTracker t) = runResourceT $ HTTP.announce q t
+announce q (UTracker t) = UDP.announce q t
 
-  scrape (HTTPTr t) = scrape t
-  scrape (UDPTr  t) = scrape t
+scrape :: ScrapeQuery -> Tracker -> IO ScrapeInfo
+scrape q (HTracker t) = runResourceT $ HTTP.scrape q t
+scrape q (UTracker t) = UDP.scrape q t
diff --git a/tests/Network/BitTorrent/Exchange/BlockSpec.hs b/tests/Network/BitTorrent/Exchange/BlockSpec.hs
index 158a30b4..f4301452 100644
--- a/tests/Network/BitTorrent/Exchange/BlockSpec.hs
+++ b/tests/Network/BitTorrent/Exchange/BlockSpec.hs
@@ -1,5 +1,6 @@
 module Network.BitTorrent.Exchange.BlockSpec (spec) where
 import Control.Applicative
+import Data.Maybe
 import Test.Hspec
 import Test.QuickCheck
 
@@ -12,8 +13,14 @@ instance Arbitrary a => Arbitrary (Block a) where
 instance Arbitrary BlockIx where
   arbitrary = BlockIx <$> arbitrary <*> arbitrary <*> arbitrary
 
+instance Arbitrary Bucket where
+  arbitrary = error "arbitrary: block bucket"
+
+instance Show Bucket where
+  show = error "show: bucket"
+
 spec :: Spec
 spec = do
   describe "bucket" $ do
     it "render to piece when it is full" $ property $ \ bkt ->
-      if full bkt then isJust (toPiece bkt)
\ No newline at end of file
+      full bkt == isJust (toPiece bkt)
\ No newline at end of file
diff --git a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
index 6ff68cdf..37029b75 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
@@ -1,4 +1,4 @@
-module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec) where
+module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec, trackerURIs) where
 
 import Control.Monad
 import Control.Monad.Trans
diff --git a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
index 53babbb3..e46f15b6 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE RecordWildCards #-}
-module Network.BitTorrent.Tracker.RPC.UDPSpec (spec) where
+module Network.BitTorrent.Tracker.RPC.UDPSpec (spec, trackerURIs) where
 
 import Control.Monad
 import Data.Default