src/Tracker.hs

   1 module Tracker where
   2
   3 import qualified Data.ByteString.Char8 as BC
   4 import qualified Data.Map as M
   5 import qualified Data.List as List
   6 import qualified Network.HTTP as HTTP
   7 import qualified Network.HTTP.Base as HB
   8 import qualified Bencode as Benc
   9 import qualified Crypto.Hash.SHA1 as SHA1
  10 import qualified Data.ByteString.Base16 as B16
  11 import qualified Utils as U
  12 import Data.Char
  13
  14
  15 type Url = String
  16
  17
  18 -- | urlEncodeHash
  19 --
  20 -- >>> urlEncodeHash $ BC.pack "123456789abcdef123456789abcdef123456789a"
  21 -- "%124Vx%9a%bc%de%f1%23Eg%89%ab%cd%ef%124Vx%9a"
  22 urlEncodeHash :: BC.ByteString -> String
  23 urlEncodeHash bs = concatMap (encode . BC.unpack) (U.splitN 2 bs)
  24   where encode b@[c1, c2] = let c =  chr (read ("0x" ++ b))
  25                                   in
  26                                    escape c c1 c2
  27         encode _ = ""
  28         escape i c1 c2 | i `elem` nonSpecialChars = [i]
  29                        | otherwise = "%" ++ [c1] ++ [c2]
  30           where nonSpecialChars = ['A'..'Z'] ++
  31                                   ['a'..'z'] ++
  32                                   ['0'..'9'] ++
  33                                   "-_.~"
  34
  35 infoHash :: M.Map Benc.BVal Benc.BVal -> BC.ByteString
  36 infoHash m = let info = m M.! Benc.Bstr (BC.pack "info")
  37              in (B16.encode . SHA1.hash . BC.pack . Benc.encode) info
  38
  39 prepareRequest :: Benc.BVal -> String -> Integer -> String
  40 prepareRequest (Benc.Bdict d) peer_id len =
  41   let p = [("info_hash", urlEncodeHash (infoHash d)),
  42            ("peer_id", HB.urlEncode peer_id),
  43            ("port", "6881"),
  44            ("uploaded", "0"),
  45            ("downloaded", "0"),
  46            ("left", show len),
  47            ("compact", "1"),
  48            ("event", "started")]
  49   in
  50    List.intercalate "&" [f ++ "=" ++ s | (f,s) <- p]
  51
  52 connect :: Url -> String -> IO String
  53 connect baseurl qstr = let url = baseurl ++ "?" ++ qstr
  54                        in HTTP.simpleHTTP (HTTP.getRequest url) >>=
  55                           HTTP.getResponseBody