From baff7fbe8a491ce743b3fe2eef0e00ee37ee5c98 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Sat, 30 Nov 2013 15:36:21 +0400 Subject: Use http-conduit instead of HTTP package --- src/Network/BitTorrent/Tracker/RPC/HTTP.hs | 90 ++++++++++++++------------- src/Network/BitTorrent/Tracker/RPC/Message.hs | 17 +++-- src/Network/BitTorrent/Tracker/RPC/UDP.hs | 8 +-- 3 files changed, 62 insertions(+), 53 deletions(-) (limited to 'src/Network') diff --git a/src/Network/BitTorrent/Tracker/RPC/HTTP.hs b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs index 0eef2b7e..81208590 100644 --- a/src/Network/BitTorrent/Tracker/RPC/HTTP.hs +++ b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs @@ -15,6 +15,9 @@ -- module Network.BitTorrent.Tracker.RPC.HTTP ( Connection + , putConnection + + -- * RPC , connect , announce , scrape @@ -22,6 +25,7 @@ module Network.BitTorrent.Tracker.RPC.HTTP import Control.Applicative import Control.Exception +import Control.Monad.Trans.Resource import Data.BEncode as BE import Data.ByteString as B import Data.ByteString.Char8 as BC @@ -31,6 +35,8 @@ import Data.Map as M import Data.Monoid import Network.URI import Network.HTTP.Conduit +import Network.HTTP.Conduit.Internal +import Network.HTTP.Types.URI import Data.Torrent.InfoHash import Network.BitTorrent.Tracker.RPC.Message @@ -38,38 +44,43 @@ import Network.BitTorrent.Tracker.RPC.Message data Connection = Connection { announceURI :: URI - } deriving Show + , manager :: Manager + , connProxy :: Maybe Proxy + } + +putConnection :: Connection -> IO () +putConnection = undefined connect :: URI -> IO Connection -connect = return . Connection +connect = undefined + +setSimpleQuery :: SimpleQuery -> Request m -> Request m +setSimpleQuery q r = r + { queryString = undefined renderSimpleQuery False q + } + +trackerHTTP :: BEncode a => SimpleQuery -> Connection -> ResourceT IO a +trackerHTTP q Connection {..} = do + request <- setSimpleQuery q <$> setUri def announceURI + response <- httpLbs request { proxy = connProxy } manager + case BE.decode $ BL.toStrict $ responseBody response of + Left msg -> error "TODO" + Right info -> return info -- | Send request and receive response from the tracker specified in --- announce list. This function throws 'IOException' if it couldn't --- send request or receive response or decode response. +-- announce list. -- -announce :: AnnounceQuery -> Connection -> IO (Result AnnounceInfo) -announce req = do - let uri = undefined - resp <- BL.toStrict <$> simpleHttp uri - return $ BE.decode resp - -scrape :: ScrapeQuery -> Connection -> IO (Result Scrape) -scrape = undefined +announce :: AnnounceQuery -> Connection -> ResourceT IO AnnounceInfo +announce q = trackerHTTP (renderAnnounceQuery q) -{- -- | 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 --- torrents. Note that scrapping of multiple torrents may not be --- supported. (Even if scrapping convention is supported) +-- gives 'Nothing' then tracker do not support scraping. -- -scrapeURL :: URI -> [InfoHash] -> Maybe URI -scrapeURL uri ihs = do - newPath <- replace (BC.pack (uriPath uri)) - let newURI = uri { uriPath = BC.unpack newPath } - return (L.foldl addHashToURI newURI ihs) - where - replace :: ByteString -> Maybe ByteString +scrapeURL :: URI -> Maybe URI +scrapeURL uri = do + newPath <- replace (BC.pack (uriPath uri)) + return uri { uriPath = BC.unpack newPath } + where replace p | ps <- BC.splitWith (== '/') p , "announce" `B.isPrefixOf` L.last ps @@ -77,30 +88,21 @@ scrapeURL uri ihs = do in Just (B.intercalate "/" (L.init ps ++ [newSuff])) | otherwise = Nothing - -- | For each 'InfoHash' of torrents request scrape info from the tracker. -- However if the info hash list is 'null', the tracker should list -- all available torrents. --- Note that the 'URI' should be /announce/ URI, not /scrape/ URI. -- -scrapeHTTP :: HTTPTracker -- ^ Announce 'URI'. - -> [InfoHash] -- ^ Torrents to be scrapped. - -> IO Scrape -- ^ 'ScrapeInfo' for each torrent. -scrapeHTTP HTTPTracker {..} ihs - | Just uri <- scrapeURL announceURI ihs = do - rawResp <- simpleHTTP (Request uri GET [] "") - respBody <- getResponseBody rawResp - case decode (BC.pack respBody) of - Left e -> throwIO $ userError $ e ++ " in scrape response" - Right r -> return r - - | otherwise = throwIO $ userError "Tracker do not support scraping" +scrape :: ScrapeQuery -> Connection -> ResourceT IO ScrapeInfo +scrape q conn @ Connection {..} = do + case scrapeURL announceURI of + Nothing -> error "Tracker do not support scraping" + Just uri -> trackerHTTP (renderScrapeQuery q) conn { announceURI = uri } -- | More particular version of 'scrape', just for one torrent. -- -scrapeOne :: Tracker t => t -> InfoHash -> IO ScrapeInfo -scrapeOne uri ih = scrape uri [ih] >>= maybe err return . M.lookup ih - where - err = throwIO $ userError "unable to find info hash in response dict" - --} \ No newline at end of file +scrapeOne :: InfoHash -> Connection -> ResourceT IO ScrapeEntry +scrapeOne ih uri = do + xs <- scrape [ih] uri + case L.lookup ih xs of + Nothing -> error "unable to find info hash in response dict" + Just a -> return a diff --git a/src/Network/BitTorrent/Tracker/RPC/Message.hs b/src/Network/BitTorrent/Tracker/RPC/Message.hs index 74a3842f..e91d223e 100644 --- a/src/Network/BitTorrent/Tracker/RPC/Message.hs +++ b/src/Network/BitTorrent/Tracker/RPC/Message.hs @@ -25,21 +25,26 @@ {-# OPTIONS -fno-warn-orphans #-} module Network.BitTorrent.Tracker.RPC.Message ( -- * Announce - -- ** Request + -- ** Query Event(..) , AnnounceQuery(..) , renderAnnounceQuery , ParamParseFailure , parseAnnounceQuery - -- ** Response + -- ** Info , PeerList (..) , AnnounceInfo(..) , defaultNumWant , parseFailureStatus -- * Scrape + -- ** Query , ScrapeQuery + , renderScrapeQuery + , parseScrapeQuery + + -- ** Info , ScrapeEntry (..) , ScrapeInfo ) @@ -218,8 +223,6 @@ instance QueryLike AnnounceQuery where , ("event" , toQueryValue reqEvent) ] ---renderAnnounceQueryBuilder :: AnnounceQuery -> BS.Builder ---renderAnnounceQueryBuilder = undefined -- | Encode announce query and add it to the base tracker URL. renderAnnounceQuery :: AnnounceQuery -> SimpleQuery @@ -481,6 +484,12 @@ parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage type ScrapeQuery = [InfoHash] +renderScrapeQuery :: ScrapeQuery -> SimpleQuery +renderScrapeQuery = undefined + +parseScrapeQuery :: SimpleQuery -> ScrapeQuery +parseScrapeQuery = undefined + -- | Overall information about particular torrent. data ScrapeEntry = ScrapeEntry { -- | Number of seeders - peers with the entire file. diff --git a/src/Network/BitTorrent/Tracker/RPC/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs index bb5fe7e3..16e80c87 100644 --- a/src/Network/BitTorrent/Tracker/RPC/UDP.hs +++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs @@ -15,13 +15,13 @@ {-# LANGUAGE TypeFamilies #-} module Network.BitTorrent.Tracker.RPC.UDP ( UDPTracker + , putTracker + + -- * RPC , connect , announce , scrape , retransmission - - -- * Debug - , putTracker ) where import Control.Applicative @@ -246,8 +246,6 @@ call addr arg = bracket open close rpc throwIO $ userError "address mismatch" return res --- TODO retransmissions --- TODO blocking data UDPTracker = UDPTracker { trackerURI :: URI , trackerConnection :: IORef Connection -- cgit v1.2.3