summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker/Session.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Tracker/Session.hs')
-rw-r--r--src/Network/BitTorrent/Tracker/Session.hs31
1 files changed, 18 insertions, 13 deletions
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs
index 6767eb68..06c6ea19 100644
--- a/src/Network/BitTorrent/Tracker/Session.hs
+++ b/src/Network/BitTorrent/Tracker/Session.hs
@@ -154,16 +154,16 @@ notifyTo mgr ih event entry @ TrackerEntry {..} = do
154-- | Multitracker session. 154-- | Multitracker session.
155data Session = Session 155data Session = Session
156 { -- | Infohash to announce at each 'announce' request. 156 { -- | Infohash to announce at each 'announce' request.
157 infohash :: !InfoHash 157 sessionTopic :: !InfoHash
158 158
159 -- | Status of this client is used to filter duplicated 159 -- | Current status of this client is used to filter duplicated
160 -- notifications, for e.g. we don't want to notify a tracker with 160 -- notifications, for e.g. we don't want to notify a tracker with
161 -- ['Stopped', 'Stopped'], the last should be ignored. 161 -- ['Stopped', 'Stopped'], the last should be ignored.
162 , currentStatus :: !(IORef Status) 162 , sessionStatus :: !(IORef Status)
163 163
164 -- | A set of single-tracker sessions. Any request to a tracker 164 -- | A set of single-tracker sessions. Any request to a tracker
165 -- must take a lock. 165 -- must take a lock.
166 , trackers :: !(MVar (TrackerList TrackerEntry)) 166 , sessionTrackers :: !(MVar (TrackerList TrackerEntry))
167 } 167 }
168 168
169-- | Create a new multitracker session in paused state. Tracker list 169-- | Create a new multitracker session in paused state. Tracker list
@@ -171,10 +171,14 @@ data Session = Session
171-- client presence use 'notify'. 171-- client presence use 'notify'.
172newSession :: InfoHash -> TrackerList URI -> IO Session 172newSession :: InfoHash -> TrackerList URI -> IO Session
173newSession ih origUris = do 173newSession ih origUris = do
174 uris <- shuffleTiers origUris 174 urisList <- shuffleTiers origUris
175 status <- newIORef def 175 statusRef <- newIORef def
176 entries <- newMVar (fmap nullEntry uris) 176 entriesVar <- newMVar (fmap nullEntry urisList)
177 return (Session ih status entries) 177 return Session
178 { sessionTopic = ih
179 , sessionStatus = statusRef
180 , sessionTrackers = entriesVar
181 }
178 182
179-- | Release scarce resources associated with the given session. 183-- | Release scarce resources associated with the given session.
180closeSession :: Session -> IO () 184closeSession :: Session -> IO ()
@@ -187,7 +191,7 @@ withSession ih uris = bracket (newSession ih uris) closeSession
187-- | Get last announced status. The only action can alter this status 191-- | Get last announced status. The only action can alter this status
188-- is 'notify'. 192-- is 'notify'.
189getStatus :: Session -> IO Status 193getStatus :: Session -> IO Status
190getStatus Session {..} = readIORef currentStatus 194getStatus Session {..} = readIORef sessionStatus
191 195
192-- | Do we need to sent this event to a first working tracker or to 196-- | Do we need to sent this event to a first working tracker or to
193-- the all known good trackers? 197-- the all known good trackers?
@@ -198,7 +202,8 @@ allNotify Completed = True
198 202
199notifyAll :: Manager -> Session -> Event -> IO () 203notifyAll :: Manager -> Session -> Event -> IO ()
200notifyAll mgr Session {..} event = do 204notifyAll mgr Session {..} event = do
201 modifyMVar_ trackers (traversal (notifyTo mgr infohash event)) 205 modifyMVar_ sessionTrackers $
206 (traversal (notifyTo mgr sessionTopic event))
202 where 207 where
203 traversal 208 traversal
204 | allNotify event = traverseAll 209 | allNotify event = traverseAll
@@ -210,7 +215,7 @@ notifyAll mgr Session {..} event = do
210-- This function /may/ block until tracker query proceed. 215-- This function /may/ block until tracker query proceed.
211notify :: Manager -> Session -> Event -> IO () 216notify :: Manager -> Session -> Event -> IO ()
212notify mgr ses event = do 217notify mgr ses event = do
213 prevStatus <- atomicModifyIORef (currentStatus ses) $ \ s -> 218 prevStatus <- atomicModifyIORef (sessionStatus ses) $ \ s ->
214 (fromMaybe s (nextStatus event), s) 219 (fromMaybe s (nextStatus event), s)
215 when (needNotify event (Just prevStatus) == Just True) $ do 220 when (needNotify event (Just prevStatus) == Just True) $ do
216 notifyAll mgr ses event 221 notifyAll mgr ses event
@@ -219,8 +224,8 @@ notify mgr ses event = do
219-- | The returned list of peers can have duplicates. 224-- | The returned list of peers can have duplicates.
220-- This function /may/ block. Use async if needed. 225-- This function /may/ block. Use async if needed.
221askPeers :: Manager -> Session -> IO [PeerAddr IP] 226askPeers :: Manager -> Session -> IO [PeerAddr IP]
222askPeers mgr ses = do 227askPeers _mgr ses = do
223 list <- readMVar (trackers ses) 228 list <- readMVar (sessionTrackers ses)
224 L.concat <$> collect (tryTakeData . peersCache) list 229 L.concat <$> collect (tryTakeData . peersCache) list
225 230
226collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b] 231collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b]