1 module FuncTorrent.Tracker
8 import Prelude hiding (lookup)
9 import Crypto.Hash.SHA1 (hash)
10 import Data.ByteString.Char8 (ByteString, unpack)
11 import Data.Char (chr)
12 import Data.List (intercalate)
13 import Data.Maybe (fromJust)
15 import Network.HTTP (simpleHTTP, defaultGETRequest_, getResponseBody)
16 import Network.HTTP.Base (urlEncode)
17 import Network.URI (parseURI)
18 import qualified Data.ByteString.Base16 as B16 (encode)
20 import FuncTorrent.Bencode (InfoDict, encode)
21 import FuncTorrent.Utils (splitN)
27 -- >>> urlEncodeHash $ pack "123456789abcdef123456789abcdef123456789a"
28 -- "%124Vx%9a%bc%de%f1%23Eg%89%ab%cd%ef%124Vx%9a"
29 urlEncodeHash :: ByteString -> String
30 urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
31 where encode' b@[c1, c2] = let c = chr (read ("0x" ++ b))
34 escape i c1 c2 | i `elem` nonSpecialChars = [i]
35 | otherwise = "%" ++ [c1] ++ [c2]
37 nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
39 infoHash :: InfoDict -> ByteString
40 infoHash m = hash . encode $ (m ! "info")
42 prepareRequest :: InfoDict -> String -> Integer -> String
43 prepareRequest d peer_id len =
44 let p = [("info_hash", urlEncodeHash ((B16.encode . infoHash) d)),
45 ("peer_id", urlEncode peer_id),
52 in intercalate "&" [f ++ "=" ++ s | (f,s) <- p]
54 connect :: Url -> String -> IO ByteString
55 connect baseurl qstr = simpleHTTP (defaultGETRequest_ url) >>= getResponseBody
56 where url = fromJust . parseURI $ (baseurl ++ "?" ++ qstr)