summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/Internal/Cache.hs5
-rw-r--r--src/Network/BitTorrent/Tracker.hs15
-rw-r--r--src/Network/BitTorrent/Tracker/Session.hs45
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
35import Data.Default 36import Data.Default
36import Data.Time 37import Data.Time
37import Data.Time.Clock.POSIX 38import Data.Time.Clock.POSIX
39import System.IO.Unsafe
38 40
39 41
40data Cached a = Cached 42data 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
148unsafeTryTakeData :: Cached a -> Maybe a
149unsafeTryTakeData = unsafePerformIO . tryTakeData
150
146invalidateData :: Cached a -> IO a -> IO (Cached a) 151invalidateData :: Cached a -> IO a -> IO (Cached a)
147invalidateData Cached {..} action = do 152invalidateData 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
45import Network.BitTorrent.Internal.Cache (tryTakeData, unsafeTryTakeData)
37import Network.BitTorrent.Tracker.Message 46import Network.BitTorrent.Tracker.Message
38import Network.BitTorrent.Tracker.List 47import Network.BitTorrent.Tracker.List
39import Network.BitTorrent.Tracker.RPC 48import 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
36import Control.Monad 44import Control.Monad
37import Data.Default 45import Data.Default
38import Data.Fixed 46import Data.Fixed
39import Data.Foldable 47import Data.Foldable as F
40import Data.IORef 48import Data.IORef
41import Data.List as L 49import Data.List as L
42import Data.Maybe 50import 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
136notifyTo mgr ih event entry @ TrackerEntry {..} = do 144notifyTo 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
193getStatus :: Session -> IO Status 201getStatus :: Session -> IO Status
194getStatus Session {..} = readIORef sessionStatus 202getStatus Session {..} = readIORef sessionStatus
195 203
204getSessionState :: Session -> IO (TrackerList TrackerEntry)
205getSessionState 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?
198allNotify :: Event -> Bool 209allNotify :: Event -> Bool
@@ -226,7 +237,7 @@ notify mgr ses event = do
226askPeers :: Manager -> Session -> IO [PeerAddr IP] 237askPeers :: Manager -> Session -> IO [PeerAddr IP]
227askPeers _mgr ses = do 238askPeers _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
231collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b] 242collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b]
232collect f lst =(catMaybes . toList) <$> traverse f lst 243collect 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
241data 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