THP.hs

-----------------------------------------------------------------------------
-- |
-- 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