From 08eeeaa520b08858af9efafe8ad921dc6e7a46e1 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Fri, 13 Dec 2013 08:24:58 +0400
Subject: Expose tracker RPC module

---
 src/Network/BitTorrent/Tracker/RPC.hs | 64 ++++++++++++++++++-----------------
 1 file changed, 33 insertions(+), 31 deletions(-)

(limited to 'src/Network/BitTorrent')

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
-- 
cgit v1.2.3