summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker/Wai.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Tracker/Wai.hs')
-rw-r--r--src/Network/BitTorrent/Tracker/Wai.hs102
1 files changed, 102 insertions, 0 deletions
diff --git a/src/Network/BitTorrent/Tracker/Wai.hs b/src/Network/BitTorrent/Tracker/Wai.hs
new file mode 100644
index 00000000..f290c380
--- /dev/null
+++ b/src/Network/BitTorrent/Tracker/Wai.hs
@@ -0,0 +1,102 @@
1-- supported extensions:
2--
3-- no_peer_id - do not send peer id if no_peer_id=1 specified
4-- http://www.bittorrent.org/beps/bep_0023.html
5--
6-- compact - compact=1 or compact=0
7-- http://permalink.gmane.org/gmane.network.bit-torrent.general/4030
8--
9--
10{-# LANGUAGE RecordWildCards #-}
11module Network.BitTorrent.Tracker.Wai
12 ( tracker
13 ) where
14
15import Control.Monad.Trans.Resource
16import Data.BEncode as BE
17import Data.ByteString
18import Data.Default
19import Data.List as L
20import Network.HTTP.Types
21import Network.Wai
22
23import Data.Torrent.Progress
24import Network.BitTorrent.Core.PeerId
25import Network.BitTorrent.Core.PeerAddr
26import Network.BitTorrent.Tracker.RPC.Message
27
28
29data TrackerSettings = TrackerSettings
30 { -- | If peer did not specified the "numwant" then this value is
31 -- used.
32 defNumWant :: {-# UNPACK #-} !Int
33
34 -- | If peer specified to big numwant value.
35 , maxNumWant :: {-# UNPACK #-} !Int
36
37 -- | Recommended time interval to wait between regular announce
38 -- requests.
39 , reannounceInterval :: {-# UNPACK #-} !Int
40
41 -- | Minimum time interval to wait between regular announce
42 -- requests.
43 , reannounceMinInterval :: !(Maybe Int)
44
45 -- | Whether to send count of seeders.
46 , completePeers :: !Bool
47
48 -- | Whether to send count of leechers.
49 , incompletePeers :: !Bool
50
51 -- | Do not send peer id in response. Peer can override this value
52 -- by setting "no_peer_id" to 0 or 1.
53 , noPeerId :: !Bool
54
55 -- | Whether to send compact peer list. Peer can override this
56 -- value by setting "compact" to 0 or 1.
57 , compactPeerList :: !Bool
58 }
59
60instance Default TrackerSettings where
61 def = TrackerSettings
62 { defNumWant = defaultNumWant
63 , maxNumWant = defaultMaxNumWant
64 , reannounceInterval = defaultReannounceInterval
65 , reannounceMinInterval = Nothing
66 , compactPeerList = False
67 , completePeers = False
68 , incompletePeers = False
69 , noPeerId = False
70 }
71
72getAnnounceR :: AnnounceRequest -> ResourceT IO AnnounceInfo
73getAnnounceR = undefined
74
75getScrapeR :: ScrapeQuery -> ResourceT IO ScrapeInfo
76getScrapeR = undefined
77
78-- content-type: "text/plain" ?
79tracker :: Application
80tracker Request {..}
81 | requestMethod /= methodGet
82 = return $ responseLBS methodNotAllowed405 [] ""
83
84 | otherwise = do
85 case pathInfo of
86 ["announce"] ->
87 case parseAnnounceRequest $ queryToSimpleQuery queryString of
88 Right query -> do
89 info <- getAnnounceR query
90 return $ responseLBS ok200 [] $ BE.encode info
91 Left msg ->
92 return $ responseLBS (parseFailureStatus msg) [] ""
93
94 ["scrape"] ->
95 case Right $ parseScrapeQuery $ queryToSimpleQuery queryString of -- TODO
96 Right query -> do
97 info <- getScrapeR query
98 return $ responseLBS ok200 [] $ BE.encode info
99 Left _ ->
100 return $ responseLBS badRequest400 [] ""
101
102 _ -> undefined --badPath