1 {-# LANGUAGE OverloadedStrings #-}
2 module FuncTorrent.Tracker
7 import Prelude hiding (lookup, splitAt)
9 import Data.ByteString (ByteString)
10 import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
11 import Data.Char (chr)
12 import Data.List (intercalate)
13 import Data.Map as M (lookup)
14 import Network (PortNumber)
15 import Network.HTTP.Base (urlEncode)
16 import qualified Data.ByteString.Base16 as B16 (encode)
18 import FuncTorrent.Bencode (BVal(..), decode)
19 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
20 import FuncTorrent.Network (get)
21 import FuncTorrent.Peer (Peer(..))
22 import FuncTorrent.Utils (splitN)
25 data TrackerResponse = TrackerResponse {
26 interval :: Maybe Integer
28 , complete :: Maybe Integer
29 , incomplete :: Maybe Integer
32 -- | Deserialize tracker response
33 mkTrackerResponse :: BVal -> Either ByteString TrackerResponse
34 mkTrackerResponse resp =
35 case lookup "failure reason" body of
36 Just (Bstr err) -> Left err
37 Just _ -> Left "Unknown failure"
39 let (Just (Bint i)) = lookup "interval" body
40 (Just (Bstr peersBS)) = lookup "peers" body
41 pl = map makePeer (splitN 6 peersBS)
42 in Right TrackerResponse {
46 , incomplete = Nothing
51 toInt :: String -> Integer
54 toPort :: ByteString -> Integer
55 toPort = read . ("0x" ++) . unpack . B16.encode
57 toIP :: ByteString -> String
58 toIP = Data.List.intercalate "." .
59 map (show . toInt . ("0x" ++) . unpack) .
62 makePeer :: ByteString -> Peer
63 makePeer peer = Peer "" (toIP ip') (toPort port')
64 where (ip', port') = splitAt 4 peer
66 -- | Connect to a tracker and get peer info
67 tracker :: PortNumber -> String -> Metainfo -> IO ByteString
68 tracker port peer_id m = do
69 get (head . announceList $ m) $ mkArgs port peer_id m
71 getTrackerResponse :: PortNumber -> String -> Metainfo -> IO (Either ByteString TrackerResponse)
72 getTrackerResponse port peerId m = do
73 resp <- tracker port peerId m
75 Right trackerInfo -> return $ mkTrackerResponse trackerInfo
76 Left e -> return $ Left (pack (show e))
78 --- | URL encode hash as per RFC1738
80 --- REVIEW: Why is this not written in terms of `Network.HTTP.Base.urlEncode` or
81 --- equivalent library function?
82 urlEncodeHash :: ByteString -> String
83 urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
84 where encode' b@[c1, c2] = let c = chr (read ("0x" ++ b))
87 escape i c1 c2 | i `elem` nonSpecialChars = [i]
88 | otherwise = "%" ++ [c1] ++ [c2]
90 nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
92 -- | Make arguments that should be posted to tracker.
93 -- This is a separate pure function for testability.
94 mkArgs :: PortNumber -> String -> Metainfo -> [(String, ByteString)]
95 mkArgs port peer_id m = [("info_hash", pack . urlEncodeHash . B16.encode . infoHash $ m),
96 ("peer_id", pack . urlEncode $ peer_id),
97 ("port", pack $ show port),
100 ("left", pack . show . lengthInBytes $ info m),
102 ("event", "started")]