summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker/Wai.hs
blob: 69510fa03371b8bbea242ca3feae740ae5e75d79 (plain)
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
94
95
96
97
98
99
100
101
102
103
104
105
106
-- |
--   Copyright   :  (c) Sam Truzjan 2013
--   License     :  BSD3
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  experimental
--   Portability :  portable
--
--   Tracker WAI application.
--
{-# LANGUAGE RecordWildCards #-}
module Network.BitTorrent.Tracker.Wai
       ( -- * Configuration
         TrackerSettings (..)

         -- * Application
       , 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.Tracker.Message


-- | Various configuration settings used to generate tracker response.
data TrackerSettings = TrackerSettings
  { -- | If peer did not specified the "numwant" then this value is
    -- used.
    defNumWant            :: {-# UNPACK #-} !Int

    -- | If peer specified too 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
  } deriving (Show, Read, Eq)

-- | Conservative tracker settings compatible with any client.
instance Default TrackerSettings where
  def = TrackerSettings
    { defNumWant            = defaultNumWant
    , maxNumWant            = defaultMaxNumWant
    , reannounceInterval    = defaultReannounceInterval
    , reannounceMinInterval = Nothing
    , compactPeerList       = False
    , completePeers         = False
    , incompletePeers       = False
    , noPeerId              = False
    }

getAnnounceR :: TrackerSettings -> AnnounceRequest -> ResourceT IO AnnounceInfo
getAnnounceR = undefined

getScrapeR :: TrackerSettings -> ScrapeQuery -> ResourceT IO ScrapeInfo
getScrapeR = undefined

-- content-type: "text/plain"!
tracker :: TrackerSettings -> Application
tracker settings Request {..}
  | requestMethod /= methodGet
  = return $ responseLBS methodNotAllowed405 [] ""

  | otherwise = do
    case pathInfo of
      ["announce"] ->
        case parseAnnounceRequest $ queryToSimpleQuery queryString of
          Right query -> do
            info <- getAnnounceR settings 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 settings query
            return $ responseLBS ok200 [] $ BE.encode info
          Left _ ->
            return $ responseLBS badRequest400 [] ""

      _            -> undefined --badPath