diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker/Session.hs')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Session.hs | 29 |
1 files changed, 23 insertions, 6 deletions
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs index 59958ccd..4c61034e 100644 --- a/src/Network/BitTorrent/Tracker/Session.hs +++ b/src/Network/BitTorrent/Tracker/Session.hs | |||
@@ -7,6 +7,7 @@ | |||
7 | -- | 7 | -- |
8 | -- Multitracker sessions. | 8 | -- Multitracker sessions. |
9 | -- | 9 | -- |
10 | {-# LANGUAGE TemplateHaskell #-} | ||
10 | module Network.BitTorrent.Tracker.Session | 11 | module Network.BitTorrent.Tracker.Session |
11 | ( -- * Session | 12 | ( -- * Session |
12 | Session | 13 | Session |
@@ -25,6 +26,7 @@ module Network.BitTorrent.Tracker.Session | |||
25 | , getStatus | 26 | , getStatus |
26 | 27 | ||
27 | -- ** Single tracker sessions | 28 | -- ** Single tracker sessions |
29 | , LastScrape (..) | ||
28 | , TrackerEntry | 30 | , TrackerEntry |
29 | , trackerURI | 31 | , trackerURI |
30 | , trackerPeers | 32 | , trackerPeers |
@@ -42,6 +44,8 @@ import Control.Applicative | |||
42 | import Control.Exception | 44 | import Control.Exception |
43 | import Control.Concurrent | 45 | import Control.Concurrent |
44 | import Control.Monad | 46 | import Control.Monad |
47 | import Data.Aeson | ||
48 | import Data.Aeson.TH | ||
45 | import Data.Default | 49 | import Data.Default |
46 | import Data.Fixed | 50 | import Data.Fixed |
47 | import Data.Foldable as F | 51 | import Data.Foldable as F |
@@ -53,6 +57,7 @@ import Data.Traversable | |||
53 | import Network.URI | 57 | import Network.URI |
54 | 58 | ||
55 | import Data.Torrent.InfoHash | 59 | import Data.Torrent.InfoHash |
60 | import Data.Torrent.JSON | ||
56 | import Network.BitTorrent.Core | 61 | import Network.BitTorrent.Core |
57 | import Network.BitTorrent.Internal.Cache | 62 | import Network.BitTorrent.Internal.Cache |
58 | import Network.BitTorrent.Tracker.List | 63 | import Network.BitTorrent.Tracker.List |
@@ -79,10 +84,15 @@ instance Default LastScrape where | |||
79 | def = LastScrape Nothing Nothing | 84 | def = LastScrape Nothing Nothing |
80 | 85 | ||
81 | data LastScrape = LastScrape | 86 | data LastScrape = LastScrape |
82 | { leechersCount :: Maybe Int | 87 | { -- | Count of leechers the tracker aware of. |
83 | , seedersCount :: Maybe Int | 88 | scrapeLeechers :: Maybe Int |
89 | |||
90 | -- | Count of seeders the tracker aware of. | ||
91 | , scrapeSeeders :: Maybe Int | ||
84 | } deriving (Show, Eq) | 92 | } deriving (Show, Eq) |
85 | 93 | ||
94 | $(deriveJSON omitRecordPrefix ''LastScrape) | ||
95 | |||
86 | -- | Single tracker session. | 96 | -- | Single tracker session. |
87 | data TrackerEntry = TrackerEntry | 97 | data TrackerEntry = TrackerEntry |
88 | { -- | Tracker announce URI. | 98 | { -- | Tracker announce URI. |
@@ -98,7 +108,14 @@ data TrackerEntry = TrackerEntry | |||
98 | , trackerScrape :: Cached LastScrape | 108 | , trackerScrape :: Cached LastScrape |
99 | } | 109 | } |
100 | 110 | ||
101 | -- | Single tracker session with empty state. | 111 | instance ToJSON TrackerEntry where |
112 | toJSON TrackerEntry {..} = object | ||
113 | [ "uri" .= trackerURI | ||
114 | , "peers" .= trackerPeers | ||
115 | , "scrape" .= trackerScrape | ||
116 | ] | ||
117 | |||
118 | -- | Single tracker session with empty state.l | ||
102 | nullEntry :: URI -> TrackerEntry | 119 | nullEntry :: URI -> TrackerEntry |
103 | nullEntry uri = TrackerEntry uri Nothing def def | 120 | nullEntry uri = TrackerEntry uri Nothing def def |
104 | 121 | ||
@@ -134,8 +151,8 @@ cacheScrape AnnounceInfo {..} = | |||
134 | newCached (seconds respInterval) | 151 | newCached (seconds respInterval) |
135 | (seconds (fromMaybe respInterval respMinInterval)) | 152 | (seconds (fromMaybe respInterval respMinInterval)) |
136 | LastScrape | 153 | LastScrape |
137 | { seedersCount = respComplete | 154 | { scrapeSeeders = respComplete |
138 | , leechersCount = respIncomplete | 155 | , scrapeLeechers = respIncomplete |
139 | } | 156 | } |
140 | 157 | ||
141 | -- | Make announce request to specific tracker returning new state. | 158 | -- | Make announce request to specific tracker returning new state. |
@@ -218,7 +235,7 @@ notifyAll mgr Session {..} event = do | |||
218 | where | 235 | where |
219 | traversal | 236 | traversal |
220 | | allNotify event = traverseAll | 237 | | allNotify event = traverseAll |
221 | | otherwise = traverseTiers | 238 | | otherwise = traverseTiers |
222 | 239 | ||
223 | -- TODO send notifications to tracker periodically. | 240 | -- TODO send notifications to tracker periodically. |
224 | -- | | 241 | -- | |