diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-12-06 02:38:04 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-12-06 02:38:04 +0400 |
commit | 56cf0e26eaa3ef528431b07b35558987cd447cf5 (patch) | |
tree | dcc2093915960aeb5a4cb5ac202651129d350307 /src/Network/BitTorrent/Tracker/Wai.hs | |
parent | b8952febca2e04f2949bbe98d4c6fe422f13f415 (diff) |
Add documentation to Wai module
Diffstat (limited to 'src/Network/BitTorrent/Tracker/Wai.hs')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Wai.hs | 33 |
1 files changed, 24 insertions, 9 deletions
diff --git a/src/Network/BitTorrent/Tracker/Wai.hs b/src/Network/BitTorrent/Tracker/Wai.hs index 770816b4..c43c7a3a 100644 --- a/src/Network/BitTorrent/Tracker/Wai.hs +++ b/src/Network/BitTorrent/Tracker/Wai.hs | |||
@@ -1,6 +1,19 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- Tracker WAI application. | ||
9 | -- | ||
1 | {-# LANGUAGE RecordWildCards #-} | 10 | {-# LANGUAGE RecordWildCards #-} |
2 | module Network.BitTorrent.Tracker.Wai | 11 | module Network.BitTorrent.Tracker.Wai |
3 | ( tracker | 12 | ( -- * Configuration |
13 | TrackerSettings (..) | ||
14 | |||
15 | -- * Application | ||
16 | , tracker | ||
4 | ) where | 17 | ) where |
5 | 18 | ||
6 | import Control.Monad.Trans.Resource | 19 | import Control.Monad.Trans.Resource |
@@ -15,12 +28,13 @@ import Data.Torrent.Progress | |||
15 | import Network.BitTorrent.Tracker.Message | 28 | import Network.BitTorrent.Tracker.Message |
16 | 29 | ||
17 | 30 | ||
31 | -- | Various configuration settings used to generate tracker response. | ||
18 | data TrackerSettings = TrackerSettings | 32 | data TrackerSettings = TrackerSettings |
19 | { -- | If peer did not specified the "numwant" then this value is | 33 | { -- | If peer did not specified the "numwant" then this value is |
20 | -- used. | 34 | -- used. |
21 | defNumWant :: {-# UNPACK #-} !Int | 35 | defNumWant :: {-# UNPACK #-} !Int |
22 | 36 | ||
23 | -- | If peer specified to big numwant value. | 37 | -- | If peer specified too big numwant value. |
24 | , maxNumWant :: {-# UNPACK #-} !Int | 38 | , maxNumWant :: {-# UNPACK #-} !Int |
25 | 39 | ||
26 | -- | Recommended time interval to wait between regular announce | 40 | -- | Recommended time interval to wait between regular announce |
@@ -44,8 +58,9 @@ data TrackerSettings = TrackerSettings | |||
44 | -- | Whether to send compact peer list. Peer can override this | 58 | -- | Whether to send compact peer list. Peer can override this |
45 | -- value by setting "compact" to 0 or 1. | 59 | -- value by setting "compact" to 0 or 1. |
46 | , compactPeerList :: !Bool | 60 | , compactPeerList :: !Bool |
47 | } | 61 | } deriving (Show, Read, Eq) |
48 | 62 | ||
63 | -- | Conservative tracker settings compatible with any client. | ||
49 | instance Default TrackerSettings where | 64 | instance Default TrackerSettings where |
50 | def = TrackerSettings | 65 | def = TrackerSettings |
51 | { defNumWant = defaultNumWant | 66 | { defNumWant = defaultNumWant |
@@ -58,15 +73,15 @@ instance Default TrackerSettings where | |||
58 | , noPeerId = False | 73 | , noPeerId = False |
59 | } | 74 | } |
60 | 75 | ||
61 | getAnnounceR :: AnnounceRequest -> ResourceT IO AnnounceInfo | 76 | getAnnounceR :: TrackerSettings -> AnnounceRequest -> ResourceT IO AnnounceInfo |
62 | getAnnounceR = undefined | 77 | getAnnounceR = undefined |
63 | 78 | ||
64 | getScrapeR :: ScrapeQuery -> ResourceT IO ScrapeInfo | 79 | getScrapeR :: TrackerSettings -> ScrapeQuery -> ResourceT IO ScrapeInfo |
65 | getScrapeR = undefined | 80 | getScrapeR = undefined |
66 | 81 | ||
67 | -- content-type: "text/plain" ? | 82 | -- content-type: "text/plain" ? |
68 | tracker :: Application | 83 | tracker :: TrackerSettings -> Application |
69 | tracker Request {..} | 84 | tracker settings Request {..} |
70 | | requestMethod /= methodGet | 85 | | requestMethod /= methodGet |
71 | = return $ responseLBS methodNotAllowed405 [] "" | 86 | = return $ responseLBS methodNotAllowed405 [] "" |
72 | 87 | ||
@@ -75,7 +90,7 @@ tracker Request {..} | |||
75 | ["announce"] -> | 90 | ["announce"] -> |
76 | case parseAnnounceRequest $ queryToSimpleQuery queryString of | 91 | case parseAnnounceRequest $ queryToSimpleQuery queryString of |
77 | Right query -> do | 92 | Right query -> do |
78 | info <- getAnnounceR query | 93 | info <- getAnnounceR settings query |
79 | return $ responseLBS ok200 [] $ BE.encode info | 94 | return $ responseLBS ok200 [] $ BE.encode info |
80 | Left msg -> | 95 | Left msg -> |
81 | return $ responseLBS (parseFailureStatus msg) [] "" | 96 | return $ responseLBS (parseFailureStatus msg) [] "" |
@@ -83,7 +98,7 @@ tracker Request {..} | |||
83 | ["scrape"] -> | 98 | ["scrape"] -> |
84 | case Right $ parseScrapeQuery $ queryToSimpleQuery queryString of -- TODO | 99 | case Right $ parseScrapeQuery $ queryToSimpleQuery queryString of -- TODO |
85 | Right query -> do | 100 | Right query -> do |
86 | info <- getScrapeR query | 101 | info <- getScrapeR settings query |
87 | return $ responseLBS ok200 [] $ BE.encode info | 102 | return $ responseLBS ok200 [] $ BE.encode info |
88 | Left _ -> | 103 | Left _ -> |
89 | return $ responseLBS badRequest400 [] "" | 104 | return $ responseLBS badRequest400 [] "" |