diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/Core/PeerAddr.hs | 4 | ||||
-rw-r--r-- | src/Network/BitTorrent/Internal/Cache.hs | 14 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Session.hs | 29 |
3 files changed, 41 insertions, 6 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs index b62cb945..adf64c7f 100644 --- a/src/Network/BitTorrent/Core/PeerAddr.hs +++ b/src/Network/BitTorrent/Core/PeerAddr.hs | |||
@@ -34,6 +34,7 @@ module Network.BitTorrent.Core.PeerAddr | |||
34 | import Control.Applicative | 34 | import Control.Applicative |
35 | import Control.Monad | 35 | import Control.Monad |
36 | import Data.Aeson (ToJSON, FromJSON) | 36 | import Data.Aeson (ToJSON, FromJSON) |
37 | import Data.Aeson.TH | ||
37 | import Data.BEncode as BS | 38 | import Data.BEncode as BS |
38 | import Data.BEncode.BDict (BKey) | 39 | import Data.BEncode.BDict (BKey) |
39 | import Data.ByteString.Char8 as BS8 | 40 | import Data.ByteString.Char8 as BS8 |
@@ -57,6 +58,7 @@ import Text.Read (readMaybe) | |||
57 | import qualified Text.ParserCombinators.ReadP as RP | 58 | import qualified Text.ParserCombinators.ReadP as RP |
58 | 59 | ||
59 | import Data.Torrent.InfoHash | 60 | import Data.Torrent.InfoHash |
61 | import Data.Torrent.JSON | ||
60 | import Network.BitTorrent.Core.PeerId | 62 | import Network.BitTorrent.Core.PeerId |
61 | 63 | ||
62 | 64 | ||
@@ -206,6 +208,8 @@ data PeerAddr a = PeerAddr | |||
206 | , peerPort :: {-# UNPACK #-} !PortNumber | 208 | , peerPort :: {-# UNPACK #-} !PortNumber |
207 | } deriving (Show, Eq, Ord, Typeable, Functor) | 209 | } deriving (Show, Eq, Ord, Typeable, Functor) |
208 | 210 | ||
211 | $(deriveJSON omitRecordPrefix ''PeerAddr) | ||
212 | |||
209 | peer_ip_key, peer_id_key, peer_port_key :: BKey | 213 | peer_ip_key, peer_id_key, peer_port_key :: BKey |
210 | peer_ip_key = "ip" | 214 | peer_ip_key = "ip" |
211 | peer_id_key = "peer id" | 215 | peer_id_key = "peer id" |
diff --git a/src/Network/BitTorrent/Internal/Cache.hs b/src/Network/BitTorrent/Internal/Cache.hs index 8c74467a..b77e5e82 100644 --- a/src/Network/BitTorrent/Internal/Cache.hs +++ b/src/Network/BitTorrent/Internal/Cache.hs | |||
@@ -32,6 +32,7 @@ module Network.BitTorrent.Internal.Cache | |||
32 | ) where | 32 | ) where |
33 | 33 | ||
34 | import Control.Applicative | 34 | import Control.Applicative |
35 | import Data.Aeson | ||
35 | import Data.Monoid | 36 | import Data.Monoid |
36 | import Data.Default | 37 | import Data.Default |
37 | import Data.Time | 38 | import Data.Time |
@@ -55,6 +56,19 @@ data Cached a = Cached | |||
55 | 56 | ||
56 | -- INVARIANT: minUpdateInterval <= updateInterval | 57 | -- INVARIANT: minUpdateInterval <= updateInterval |
57 | 58 | ||
59 | -- | TODO exsample | ||
60 | instance ToJSON a => ToJSON (Cached a) where | ||
61 | toJSON Cached {..} | ||
62 | | currentTime < expireTime = object | ||
63 | [ "observed" .= posixSecondsToUTCTime lastUpdated | ||
64 | , "expired" .= posixSecondsToUTCTime expireTime | ||
65 | , "data" .= cachedData | ||
66 | ] | ||
67 | | otherwise = String "cached data expired" | ||
68 | where | ||
69 | expireTime = currentTime + updateInterval | ||
70 | currentTime = unsafePerformIO getPOSIXTime | ||
71 | |||
58 | instance Default (Cached a) where | 72 | instance Default (Cached a) where |
59 | def = mempty | 73 | def = mempty |
60 | 74 | ||
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 | -- | |