----------------------------------------------------------------------------- -- | -- Module : Conjure.Protocol.THP -- Copyright : (c) Lemmih 2005-2006 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : experimental -- Portability : non-portable -- -- ----------------------------------------------------------------------------- module Conjure.Protocol.THP ( queryTracker , Response (..) , PeerInfo (..) , Event (..) ) where import Conjure.Types import Conjure.Protocol.THP.Types import Conjure.Protocol.THP.Parser import Network.HTTP ( urlEncode, simpleHTTP , Request(..), RequestMethod(..) , rspBody, rspCode ) import BEncode.BEncode ( bRead ) import BEncode.BParser ( runParser ) import qualified Data.ByteString.Char8 as BS -- import Data.ByteString (ByteString) import Data.List ( intersperse ) import Network.URI ( uriQuery ) import Network ( PortNumber ) showEvent :: Event -> String showEvent Started = "started" showEvent Stopped = "stopped" showEvent Completed = "completed" -- | Encode a query in the way that webapps are so fond of makeQuery :: [(String, String)] -- ^ @parameter@-@value@ pairs -> String -- ^ Resulting @URL@ makeQuery params = '?':concat (intersperse "&" $ map f params) where f (name, val) = name ++ "=" ++ urlEncode val -- | Query the tracker (TODO: factor some of these together when the -- appropriate abstractions are ready queryTracker :: Torrent -- ^ The 'Torrent' we are asking about -> PeerId -- ^ Peerid -> Maybe String -- ^ Optional @ip@ parameter -> PortNumber -- ^ The listening @port@ -> Integer -- ^ Amount @uploaded@ sinse Starter event. -> Integer -- ^ Amount @downloaded@ since Starter event. -> Integer -- ^ Amount @left@ (not filesize minus @downloaded@!) -> Maybe Event -> IO Response -- ^ The response from the tracker queryTracker torrent peerId ip port uploaded downloaded' left event = do Right rsp <- simpleHTTP (Request { rqMethod = GET, rqURI = newURI, rqHeaders = [], rqBody = "" }) let body = rspBody rsp if (case rspCode rsp of (2,_,_) -> False; _ -> True) then return $ Error $ head $ lines $ show rsp else do case bRead (BS.pack body) of Nothing -> return $ Error $ "Response not BEncoded. " ++ show body Just be -> case runParser parseResponse be of Left err -> return $ Error $ err ++ "\n" ++ show be Right rs -> return rs where baseURI = tAnnounce torrent newURI = baseURI { uriQuery = query } query = makeQuery $ optParam "ip" id ip $ optParam "event" showEvent event $ [("info_hash", BS.unpack $ tInfoHash torrent), ("peer_id", BS.unpack $ unPeerId peerId), ("port", show port), ("uploaded", show uploaded), ("downloaded", show downloaded'), ("left", show left)] optParam name ppVal mbVal = maybe id (\param lst -> (name, ppVal param):lst) mbVal