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