diff options
-rw-r--r-- | src/Network/BitTorrent/Internal/Cache.hs | 5 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker.hs | 15 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Session.hs | 45 |
3 files changed, 38 insertions, 27 deletions
diff --git a/src/Network/BitTorrent/Internal/Cache.hs b/src/Network/BitTorrent/Internal/Cache.hs index 1eb2f192..8c74467a 100644 --- a/src/Network/BitTorrent/Internal/Cache.hs +++ b/src/Network/BitTorrent/Internal/Cache.hs | |||
@@ -27,6 +27,7 @@ module Network.BitTorrent.Internal.Cache | |||
27 | 27 | ||
28 | -- * Cached data | 28 | -- * Cached data |
29 | , tryTakeData | 29 | , tryTakeData |
30 | , unsafeTryTakeData | ||
30 | , takeData | 31 | , takeData |
31 | ) where | 32 | ) where |
32 | 33 | ||
@@ -35,6 +36,7 @@ import Data.Monoid | |||
35 | import Data.Default | 36 | import Data.Default |
36 | import Data.Time | 37 | import Data.Time |
37 | import Data.Time.Clock.POSIX | 38 | import Data.Time.Clock.POSIX |
39 | import System.IO.Unsafe | ||
38 | 40 | ||
39 | 41 | ||
40 | data Cached a = Cached | 42 | data Cached a = Cached |
@@ -143,6 +145,9 @@ tryTakeData c = do | |||
143 | alive <- isAlive c | 145 | alive <- isAlive c |
144 | return $ if alive then Just (cachedData c) else Nothing | 146 | return $ if alive then Just (cachedData c) else Nothing |
145 | 147 | ||
148 | unsafeTryTakeData :: Cached a -> Maybe a | ||
149 | unsafeTryTakeData = unsafePerformIO . tryTakeData | ||
150 | |||
146 | invalidateData :: Cached a -> IO a -> IO (Cached a) | 151 | invalidateData :: Cached a -> IO a -> IO (Cached a) |
147 | invalidateData Cached {..} action = do | 152 | invalidateData Cached {..} action = do |
148 | t <- getPOSIXTime | 153 | t <- getPOSIXTime |
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs index f43b5dc2..a58d5091 100644 --- a/src/Network/BitTorrent/Tracker.hs +++ b/src/Network/BitTorrent/Tracker.hs | |||
@@ -25,15 +25,24 @@ module Network.BitTorrent.Tracker | |||
25 | , newSession | 25 | , newSession |
26 | , closeSession | 26 | , closeSession |
27 | 27 | ||
28 | -- * Events | 28 | -- ** Events |
29 | , Event (..) | 29 | , Event (..) |
30 | , notify | 30 | , notify |
31 | , askPeers | 31 | , askPeers |
32 | 32 | ||
33 | -- * Query | 33 | -- ** Session state |
34 | -- , getSessionState | 34 | , TrackerEntry |
35 | , trackerURI | ||
36 | , trackerPeers | ||
37 | , trackerScrape | ||
38 | |||
39 | , tryTakeData | ||
40 | , unsafeTryTakeData | ||
41 | |||
42 | , getSessionState | ||
35 | ) where | 43 | ) where |
36 | 44 | ||
45 | import Network.BitTorrent.Internal.Cache (tryTakeData, unsafeTryTakeData) | ||
37 | import Network.BitTorrent.Tracker.Message | 46 | import Network.BitTorrent.Tracker.Message |
38 | import Network.BitTorrent.Tracker.List | 47 | import Network.BitTorrent.Tracker.List |
39 | import Network.BitTorrent.Tracker.RPC | 48 | import Network.BitTorrent.Tracker.RPC |
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs index 06c6ea19..59958ccd 100644 --- a/src/Network/BitTorrent/Tracker/Session.hs +++ b/src/Network/BitTorrent/Tracker/Session.hs | |||
@@ -14,14 +14,22 @@ module Network.BitTorrent.Tracker.Session | |||
14 | , closeSession | 14 | , closeSession |
15 | , withSession | 15 | , withSession |
16 | 16 | ||
17 | -- * Query | 17 | -- * Client send notifications |
18 | , Event (..) | ||
19 | , notify | ||
20 | , askPeers | ||
21 | |||
22 | -- * Session state | ||
23 | -- ** Status | ||
18 | , Status (..) | 24 | , Status (..) |
19 | , getStatus | 25 | , getStatus |
20 | , askPeers | ||
21 | 26 | ||
22 | -- * Events | 27 | -- ** Single tracker sessions |
23 | , Event (..) | 28 | , TrackerEntry |
24 | , notify | 29 | , trackerURI |
30 | , trackerPeers | ||
31 | , trackerScrape | ||
32 | , getSessionState | ||
25 | 33 | ||
26 | -- * Tracker Exchange | 34 | -- * Tracker Exchange |
27 | -- | BEP28: <http://www.bittorrent.org/beps/bep_0028.html> | 35 | -- | BEP28: <http://www.bittorrent.org/beps/bep_0028.html> |
@@ -36,7 +44,7 @@ import Control.Concurrent | |||
36 | import Control.Monad | 44 | import Control.Monad |
37 | import Data.Default | 45 | import Data.Default |
38 | import Data.Fixed | 46 | import Data.Fixed |
39 | import Data.Foldable | 47 | import Data.Foldable as F |
40 | import Data.IORef | 48 | import Data.IORef |
41 | import Data.List as L | 49 | import Data.List as L |
42 | import Data.Maybe | 50 | import Data.Maybe |
@@ -84,10 +92,10 @@ data TrackerEntry = TrackerEntry | |||
84 | , statusSent :: !(Maybe Status) | 92 | , statusSent :: !(Maybe Status) |
85 | 93 | ||
86 | -- | Can be used to retrieve peer set. | 94 | -- | Can be used to retrieve peer set. |
87 | , peersCache :: Cached [PeerAddr IP] | 95 | , trackerPeers :: Cached [PeerAddr IP] |
88 | 96 | ||
89 | -- | Can be used to show brief swarm stats in client GUI. | 97 | -- | Can be used to show brief swarm stats in client GUI. |
90 | , scrapeCache :: Cached LastScrape | 98 | , trackerScrape :: Cached LastScrape |
91 | } | 99 | } |
92 | 100 | ||
93 | -- | Single tracker session with empty state. | 101 | -- | Single tracker session with empty state. |
@@ -136,7 +144,7 @@ notifyTo :: Manager -> InfoHash -> Event | |||
136 | notifyTo mgr ih event entry @ TrackerEntry {..} = do | 144 | notifyTo mgr ih event entry @ TrackerEntry {..} = do |
137 | 145 | ||
138 | let shouldNotify = needNotify event statusSent | 146 | let shouldNotify = needNotify event statusSent |
139 | mustNotify <- maybe (isExpired peersCache) return shouldNotify | 147 | mustNotify <- maybe (isExpired trackerPeers) return shouldNotify |
140 | if not mustNotify | 148 | if not mustNotify |
141 | then return entry | 149 | then return entry |
142 | else do | 150 | else do |
@@ -193,6 +201,9 @@ withSession ih uris = bracket (newSession ih uris) closeSession | |||
193 | getStatus :: Session -> IO Status | 201 | getStatus :: Session -> IO Status |
194 | getStatus Session {..} = readIORef sessionStatus | 202 | getStatus Session {..} = readIORef sessionStatus |
195 | 203 | ||
204 | getSessionState :: Session -> IO (TrackerList TrackerEntry) | ||
205 | getSessionState Session {..} = readMVar sessionTrackers | ||
206 | |||
196 | -- | Do we need to sent this event to a first working tracker or to | 207 | -- | Do we need to sent this event to a first working tracker or to |
197 | -- the all known good trackers? | 208 | -- the all known good trackers? |
198 | allNotify :: Event -> Bool | 209 | allNotify :: Event -> Bool |
@@ -226,7 +237,7 @@ notify mgr ses event = do | |||
226 | askPeers :: Manager -> Session -> IO [PeerAddr IP] | 237 | askPeers :: Manager -> Session -> IO [PeerAddr IP] |
227 | askPeers _mgr ses = do | 238 | askPeers _mgr ses = do |
228 | list <- readMVar (sessionTrackers ses) | 239 | list <- readMVar (sessionTrackers ses) |
229 | L.concat <$> collect (tryTakeData . peersCache) list | 240 | L.concat <$> collect (tryTakeData . trackerPeers) list |
230 | 241 | ||
231 | collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b] | 242 | collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b] |
232 | collect f lst =(catMaybes . toList) <$> traverse f lst | 243 | collect f lst =(catMaybes . toList) <$> traverse f lst |
@@ -235,20 +246,6 @@ collect f lst =(catMaybes . toList) <$> traverse f lst | |||
235 | --sourcePeers | 246 | --sourcePeers |
236 | 247 | ||
237 | {----------------------------------------------------------------------- | 248 | {----------------------------------------------------------------------- |
238 | -- State query | ||
239 | -----------------------------------------------------------------------} | ||
240 | |||
241 | data TrackerInfo = TrackerInfo | ||
242 | { | ||
243 | } | ||
244 | |||
245 | --instance ToJSON TrackerInfo where | ||
246 | -- toJSON = undefined | ||
247 | |||
248 | --getSessionState :: Session -> IO (TrackerList TrackerInfo) | ||
249 | --getSessionState = undefined | ||
250 | |||
251 | {----------------------------------------------------------------------- | ||
252 | -- Tracker exchange | 249 | -- Tracker exchange |
253 | -----------------------------------------------------------------------} | 250 | -----------------------------------------------------------------------} |
254 | 251 | ||