1 {-# LANGUAGE OverloadedStrings #-}
2 module FuncTorrent.Tracker
10 import Prelude hiding (lookup, splitAt)
12 import Data.ByteString (ByteString)
13 import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
14 import Data.Char (chr)
15 import Data.List (intercalate)
16 import Data.Map as M (lookup)
17 import Network.HTTP.Base (urlEncode)
18 import qualified Data.ByteString.Base16 as B16 (encode)
20 import FuncTorrent.Bencode (BVal(..))
21 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
22 import FuncTorrent.Network (get)
23 import FuncTorrent.Peer (Peer(..))
24 import FuncTorrent.Utils (splitN)
27 data TrackerResponse = TrackerResponse {
28 interval :: Maybe Integer
30 , complete :: Maybe Integer
31 , incomplete :: Maybe Integer
34 -- | Deserialize tracker response
35 mkTrackerResponse :: BVal -> Either ByteString TrackerResponse
36 mkTrackerResponse resp =
37 case lookup "failure reason" body of
38 Just (Bstr err) -> Left err
39 Just _ -> Left "Unknown failure"
41 let (Just (Bint i)) = lookup "interval" body
42 (Just (Bstr peersBS)) = lookup "peers" body
43 pl = map makePeer (splitN 6 peersBS)
44 in Right TrackerResponse {
48 , incomplete = Nothing
53 toInt :: String -> Integer
56 toPort :: ByteString -> Integer
57 toPort = read . ("0x" ++) . unpack . B16.encode
59 toIP :: ByteString -> String
60 toIP = Data.List.intercalate "." .
61 map (show . toInt . ("0x" ++) . unpack) .
64 makePeer :: ByteString -> Peer
65 makePeer peer = Peer (toIP ip') (toPort port')
66 where (ip', port') = splitAt 4 peer
68 -- | Connect to a tracker and get peer info
69 tracker :: Metainfo -> String -> IO ByteString
70 tracker m peer_id = get (head . announceList $ m) $ mkArgs m peer_id
72 --- | URL encode hash as per RFC1738
74 --- REVIEW: Why is this not written in terms of `Network.HTTP.Base.urlEncode` or
75 --- equivalent library function?
76 urlEncodeHash :: ByteString -> String
77 urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
78 where encode' b@[c1, c2] = let c = chr (read ("0x" ++ b))
81 escape i c1 c2 | i `elem` nonSpecialChars = [i]
82 | otherwise = "%" ++ [c1] ++ [c2]
84 nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
86 -- | Make arguments that should be posted to tracker.
87 -- This is a separate pure function for testability.
88 mkArgs :: Metainfo -> String -> [(String, ByteString)]
89 mkArgs m peer_id = [("info_hash", pack . urlEncodeHash . B16.encode . infoHash $ m),
90 ("peer_id", pack . urlEncode $ peer_id),
94 ("left", pack . show . lengthInBytes $ info m),