1 {-# LANGUAGE OverloadedStrings #-}
2 module FuncTorrent.Tracker
9 import Prelude hiding (lookup, splitAt)
11 import Data.ByteString (ByteString)
12 import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
13 import Data.Char (chr)
14 import Data.List (intercalate)
15 import Data.Map as M (lookup)
16 import Network.HTTP.Base (urlEncode)
17 import qualified Data.ByteString.Base16 as B16 (encode)
19 import FuncTorrent.Bencode (BVal(..), decode)
20 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
21 import FuncTorrent.Network (get)
22 import FuncTorrent.Peer (Peer(..))
23 import FuncTorrent.Utils (splitN)
26 data TrackerResponse = TrackerResponse {
27 interval :: Maybe Integer
29 , complete :: Maybe Integer
30 , incomplete :: Maybe Integer
33 -- | Deserialize tracker response
34 mkTrackerResponse :: BVal -> Either ByteString TrackerResponse
35 mkTrackerResponse resp =
36 case lookup "failure reason" body of
37 Just (Bstr err) -> Left err
38 Just _ -> Left "Unknown failure"
40 let (Just (Bint i)) = lookup "interval" body
41 (Just (Bstr peersBS)) = lookup "peers" body
42 pl = map makePeer (splitN 6 peersBS)
43 in Right TrackerResponse {
47 , incomplete = Nothing
52 toInt :: String -> Integer
55 toPort :: ByteString -> Integer
56 toPort = read . ("0x" ++) . unpack . B16.encode
58 toIP :: ByteString -> String
59 toIP = Data.List.intercalate "." .
60 map (show . toInt . ("0x" ++) . unpack) .
63 makePeer :: ByteString -> Peer
64 makePeer peer = Peer "" (toIP ip') (toPort port')
65 where (ip', port') = splitAt 4 peer
67 -- | Connect to a tracker and get peer info
68 tracker :: Metainfo -> String -> IO ByteString
69 tracker m peer_id = get (head . announceList $ m) $ mkArgs m peer_id
71 getTrackerResponse :: Metainfo -> String -> IO (Either ByteString TrackerResponse)
72 getTrackerResponse m peerId = do
73 resp <- tracker m peerId
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 :: Metainfo -> String -> [(String, ByteString)]
95 mkArgs m peer_id = [("info_hash", pack . urlEncodeHash . B16.encode . infoHash $ m),
96 ("peer_id", pack . urlEncode $ peer_id),
100 ("left", pack . show . lengthInBytes $ info m),
102 ("event", "started")]