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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
{-# LANGUAGE RecordWildCards #-}
module Network.BitTorrent.Tracker.Wai
( tracker
) where
import Control.Monad.Trans.Resource
import Data.BEncode as BE
import Data.ByteString
import Data.Default
import Data.List as L
import Network.HTTP.Types
import Network.Wai
import Data.Torrent.Progress
import Network.BitTorrent.Core.PeerId
import Network.BitTorrent.Core.PeerAddr
import Network.BitTorrent.Tracker.Message
data TrackerSettings = TrackerSettings
{ -- | If peer did not specified the "numwant" then this value is
-- used.
defNumWant :: {-# UNPACK #-} !Int
-- | If peer specified to big numwant value.
, maxNumWant :: {-# UNPACK #-} !Int
-- | Recommended time interval to wait between regular announce
-- requests.
, reannounceInterval :: {-# UNPACK #-} !Int
-- | Minimum time interval to wait between regular announce
-- requests.
, reannounceMinInterval :: !(Maybe Int)
-- | Whether to send count of seeders.
, completePeers :: !Bool
-- | Whether to send count of leechers.
, incompletePeers :: !Bool
-- | Do not send peer id in response. Peer can override this value
-- by setting "no_peer_id" to 0 or 1.
, noPeerId :: !Bool
-- | Whether to send compact peer list. Peer can override this
-- value by setting "compact" to 0 or 1.
, compactPeerList :: !Bool
}
instance Default TrackerSettings where
def = TrackerSettings
{ defNumWant = defaultNumWant
, maxNumWant = defaultMaxNumWant
, reannounceInterval = defaultReannounceInterval
, reannounceMinInterval = Nothing
, compactPeerList = False
, completePeers = False
, incompletePeers = False
, noPeerId = False
}
getAnnounceR :: AnnounceRequest -> ResourceT IO AnnounceInfo
getAnnounceR = undefined
getScrapeR :: ScrapeQuery -> ResourceT IO ScrapeInfo
getScrapeR = undefined
-- content-type: "text/plain" ?
tracker :: Application
tracker Request {..}
| requestMethod /= methodGet
= return $ responseLBS methodNotAllowed405 [] ""
| otherwise = do
case pathInfo of
["announce"] ->
case parseAnnounceRequest $ queryToSimpleQuery queryString of
Right query -> do
info <- getAnnounceR query
return $ responseLBS ok200 [] $ BE.encode info
Left msg ->
return $ responseLBS (parseFailureStatus msg) [] ""
["scrape"] ->
case Right $ parseScrapeQuery $ queryToSimpleQuery queryString of -- TODO
Right query -> do
info <- getScrapeR query
return $ responseLBS ok200 [] $ BE.encode info
Left _ ->
return $ responseLBS badRequest400 [] ""
_ -> undefined --badPath
|
