hTorrent/Tracker.hs at master · ian-mi/hTorrent · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
module Tracker where

import BEncode
import Torrent.Env
import Peer
import CompactPeer

import HTorrentPrelude
import Data.Attoparsec.ByteString
import qualified Data.ByteString.Char8 as CBS
import Network.HTTP
import Network.HTTP.Types.URI
import Network.Socket
import Network.URI

formatRequest :: TorrentInfo -> Request ByteString
formatRequest i = mkRequest GET uri
    where   query = renderSimpleQuery True [
                ("info_hash", i ^. torrentHash),
                ("peer_id", i ^. localId),
                ("port", fromString (show (i ^. portNumber))),
                ("uploaded", fromString (show (i ^. uploaded))),
                ("downloaded", fromString (show 0)),
                ("left", fromString (show (i ^. numPieces * i ^. pieceLength))),
                ("compact", "1"),
                ("event", "started") ]
            uri = (i ^. tracker) {uriQuery = CBS.unpack query}

parseResponse :: BEncode -> Maybe (Int, [Peer])
parseResponse b = (,) <$> i <*> ps
    where   i = bLookup "interval" bInt b
            ps = bLookup "peers" bList b >>= mapM parsePeer

compactResponse :: BEncode -> Maybe (Int, [SockAddr])
compactResponse b = (,) <$> i <*> ps
    where   i = bLookup "interval" bInt b
            ps = bLookup "peers" bString b >>= compactPeers

parseCompactResponse :: ByteString -> Maybe (Int, [SockAddr])
parseCompactResponse = (>>= compactResponse) . maybeResult . parse parseBEncode

getResponse :: TorrentInfo -> IO ByteString
getResponse i = simpleHTTP (formatRequest i) >>= getResponseBody

trackerRequest :: TorrentInfo -> IO (Maybe (Int, [SockAddr]))
trackerRequest = fmap parseCompactResponse . getResponse