diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Session.hs | 27 |
1 files changed, 16 insertions, 11 deletions
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs index 107b83d6..f66e8bde 100644 --- a/src/Network/BitTorrent/Tracker/Session.hs +++ b/src/Network/BitTorrent/Tracker/Session.hs | |||
@@ -161,17 +161,18 @@ cacheScrape AnnounceInfo {..} = | |||
161 | } | 161 | } |
162 | 162 | ||
163 | -- | Make announce request to specific tracker returning new state. | 163 | -- | Make announce request to specific tracker returning new state. |
164 | notifyTo :: Manager -> InfoHash -> Event | 164 | notifyTo :: Manager -> Session -> Event -> TrackerEntry -> IO TrackerEntry |
165 | -> TrackerEntry -> IO TrackerEntry | 165 | notifyTo mgr s @ Session {..} event entry @ TrackerEntry {..} = do |
166 | notifyTo mgr ih event entry @ TrackerEntry {..} = do | ||
167 | |||
168 | let shouldNotify = needNotify event statusSent | 166 | let shouldNotify = needNotify event statusSent |
169 | mustNotify <- maybe (isExpired trackerPeers) return shouldNotify | 167 | mustNotify <- maybe (isExpired trackerPeers) return shouldNotify |
170 | if not mustNotify | 168 | if not mustNotify |
171 | then return entry | 169 | then return entry |
172 | else do | 170 | else do |
173 | let q = SAnnounceQuery ih def Nothing (Just event) | 171 | let q = SAnnounceQuery sessionTopic def Nothing (Just event) |
174 | res <- RPC.announce mgr trackerURI q | 172 | res <- RPC.announce mgr trackerURI q |
173 | when (statusSent == Nothing) $ do | ||
174 | send sessionEvents (TrackerConfirmed trackerURI) | ||
175 | send sessionEvents (AnnouncedTo trackerURI) | ||
175 | let status' = nextStatus event <|> statusSent | 176 | let status' = nextStatus event <|> statusSent |
176 | TrackerEntry trackerURI status' | 177 | TrackerEntry trackerURI status' |
177 | <$> cachePeers res | 178 | <$> cachePeers res |
@@ -218,8 +219,9 @@ newSession ih origUris = do | |||
218 | -- function block until all trackers tied with this peer notified with | 219 | -- function block until all trackers tied with this peer notified with |
219 | -- 'Stopped' event. | 220 | -- 'Stopped' event. |
220 | closeSession :: Manager -> Session -> IO () | 221 | closeSession :: Manager -> Session -> IO () |
221 | closeSession m s = do | 222 | closeSession m s @ Session {..} = do |
222 | notify m s Stopped | 223 | notify m s Stopped |
224 | send sessionEvents SessionClosed | ||
223 | 225 | ||
224 | {----------------------------------------------------------------------- | 226 | {----------------------------------------------------------------------- |
225 | -- Events | 227 | -- Events |
@@ -230,7 +232,6 @@ data SessionEvent | |||
230 | | TrackerConfirmed URI | 232 | | TrackerConfirmed URI |
231 | | TrackerRemoved URI | 233 | | TrackerRemoved URI |
232 | | AnnouncedTo URI | 234 | | AnnouncedTo URI |
233 | | Reannounced URI | ||
234 | | SessionClosed | 235 | | SessionClosed |
235 | 236 | ||
236 | subscribe :: Session -> IO (ReceivePort SessionEvent) | 237 | subscribe :: Session -> IO (ReceivePort SessionEvent) |
@@ -261,9 +262,9 @@ allNotify Stopped = True | |||
261 | allNotify Completed = True | 262 | allNotify Completed = True |
262 | 263 | ||
263 | notifyAll :: Manager -> Session -> Event -> IO () | 264 | notifyAll :: Manager -> Session -> Event -> IO () |
264 | notifyAll mgr Session {..} event = do | 265 | notifyAll mgr s @ Session {..} event = do |
265 | modifyMVar_ sessionTrackers $ | 266 | modifyMVar_ sessionTrackers $ |
266 | (traversal (notifyTo mgr sessionTopic event)) | 267 | (traversal (notifyTo mgr s event)) |
267 | where | 268 | where |
268 | traversal | 269 | traversal |
269 | | allNotify event = traverseAll | 270 | | allNotify event = traverseAll |
@@ -304,10 +305,14 @@ collect f lst =(catMaybes . toList) <$> traverse f lst | |||
304 | -- number of retries before giving up entirely. | 305 | -- number of retries before giving up entirely. |
305 | 306 | ||
306 | addTracker :: Session -> URI -> IO () | 307 | addTracker :: Session -> URI -> IO () |
307 | addTracker = undefined | 308 | addTracker Session {..} uri = do |
309 | undefined | ||
310 | send sessionEvents (TrackerAdded uri) | ||
308 | 311 | ||
309 | removeTracker :: Session -> URI -> IO () | 312 | removeTracker :: Session -> URI -> IO () |
310 | removeTracker = undefined | 313 | removeTracker Session {..} uri = do |
314 | undefined | ||
315 | send sessionEvents (TrackerRemoved uri) | ||
311 | 316 | ||
312 | -- Also, as specified under the definitions section, a tracker that | 317 | -- Also, as specified under the definitions section, a tracker that |
313 | -- has not worked should never be propagated to other peers over the | 318 | -- has not worked should never be propagated to other peers over the |