2 - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
4 - This file is part of FuncTorrent.
6 - FuncTorrent is free software; you can redistribute it and/or modify
7 - it under the terms of the GNU General Public License as published by
8 - the Free Software Foundation; either version 3 of the License, or
9 - (at your option) any later version.
11 - FuncTorrent is distributed in the hope that it will be useful,
12 - but WITHOUT ANY WARRANTY; without even the implied warranty of
13 - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 - GNU General Public License for more details.
16 - You should have received a copy of the GNU General Public License
17 - along with FuncTorrent; if not, see <http://www.gnu.org/licenses/>
20 {-# LANGUAGE OverloadedStrings #-}
22 module FuncTorrent.Tracker.Http
26 import Prelude hiding (lookup, splitAt)
28 import Control.Concurrent (threadDelay)
29 import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)
30 import Control.Monad (forever, void)
31 import qualified Data.ByteString.Base16 as B16 (encode)
32 import Data.ByteString (ByteString)
33 import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
34 import Data.Char (chr)
35 import Data.List (intercalate)
36 import Data.Map as M (lookup)
37 import Network (PortNumber)
38 import Network.HTTP.Base (urlEncode)
40 import qualified FuncTorrent.Bencode as Benc
41 import FuncTorrent.Bencode (BVal(..))
42 import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
43 import FuncTorrent.Network (sendGetRequest)
44 import FuncTorrent.PeerMsgs (Peer(..), makePeer)
45 import FuncTorrent.Utils (splitN, IP, Port)
46 import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..))
49 --- | URL encode hash as per RFC1738
51 --- REVIEW: Why is this not written in terms of `Network.HTTP.Base.urlEncode` or
52 --- equivalent library function?
53 urlEncodeHash :: ByteString -> String
54 urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
55 where encode' b@[c1, c2] = let c = chr (read ("0x" ++ b))
58 escape i c1 c2 | i `elem` nonSpecialChars = [i]
59 | otherwise = "%" ++ [c1] ++ [c2]
61 nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
63 -- | Make arguments that should be posted to tracker.
64 -- This is a separate pure function for testability.
65 mkArgs :: PortNumber -> String -> Integer -> Integer -> Integer -> ByteString -> [(String, ByteString)]
66 mkArgs port peer_id up down left' infoHash =
67 [("info_hash", pack . urlEncodeHash . B16.encode $ infoHash),
68 ("peer_id", pack . urlEncode $ peer_id),
69 ("port", pack $ show port),
70 ("uploaded", pack $ show up),
71 ("downloaded", pack $ show down),
72 ("left", pack $ show left'),
76 trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
77 trackerLoop url sport peerId infohash fschan tstate = forever $ do
78 st' <- FS.getStats fschan
80 let up = FS.bytesRead st
81 down = FS.bytesWritten st
82 resp <- sendGetRequest url $ mkArgs sport peerId up down (left tstate) infohash
83 case Benc.decode resp of
85 return () -- $ pack (show e)
87 case parseTrackerResponse trackerInfo of
90 ps <- isEmptyMVar $ connectedPeers tstate
93 putMVar (connectedPeers tstate) (peers tresp)
95 void $ swapMVar (connectedPeers tstate) (peers tresp)
96 threadDelay $ fromIntegral (interval tresp)
98 parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
99 parseTrackerResponse resp =
100 case lookup "failure reason" body of
101 Just (Bstr err) -> Left err
102 Just _ -> Left "Unknown failure"
104 let (Just (Bint i)) = lookup "interval" body
105 (Just (Bstr peersBS)) = lookup "peers" body
106 pl = map makePeer (splitN 6 peersBS)
107 in Right TrackerResponse {
111 , incomplete = Nothing