diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker/Session.hs')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Session.hs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs index 467ca3d7..c0685100 100644 --- a/src/Network/BitTorrent/Tracker/Session.hs +++ b/src/Network/BitTorrent/Tracker/Session.hs | |||
@@ -33,7 +33,7 @@ module Network.BitTorrent.Tracker.Session | |||
33 | import Control.Applicative | 33 | import Control.Applicative |
34 | import Control.Exception | 34 | import Control.Exception |
35 | import Control.Concurrent | 35 | import Control.Concurrent |
36 | 36 | import Control.Monad | |
37 | import Data.Default | 37 | import Data.Default |
38 | import Data.Fixed | 38 | import Data.Fixed |
39 | import Data.Foldable | 39 | import Data.Foldable |
@@ -189,7 +189,7 @@ withSession ih uris = bracket (newSession ih uris) closeSession | |||
189 | -- | Get last announced status. The only action can alter this status | 189 | -- | Get last announced status. The only action can alter this status |
190 | -- is 'notify'. | 190 | -- is 'notify'. |
191 | getStatus :: Session -> IO Status | 191 | getStatus :: Session -> IO Status |
192 | getStatus Session {..} = takeMVar currentStatus | 192 | getStatus Session {..} = readMVar currentStatus |
193 | 193 | ||
194 | -- | Do we need to sent this event to a first working tracker or to | 194 | -- | Do we need to sent this event to a first working tracker or to |
195 | -- the all known good trackers? | 195 | -- the all known good trackers? |
@@ -208,12 +208,14 @@ announceAll mgr Session {..} mevent = do | |||
208 | | otherwise = traverseTiers | 208 | | otherwise = traverseTiers |
209 | 209 | ||
210 | -- TODO send notifications to tracker periodically. | 210 | -- TODO send notifications to tracker periodically. |
211 | -- TODO change 'currentStatus' | ||
212 | -- | | 211 | -- | |
213 | -- | 212 | -- |
214 | -- This function /may/ block until tracker query proceed. | 213 | -- This function /may/ block until tracker query proceed. |
215 | notify :: Manager -> Session -> Event -> IO () | 214 | notify :: Manager -> Session -> Event -> IO () |
216 | notify mgr ses event = announceAll mgr ses (Just event) | 215 | notify mgr ses event = do |
216 | prevStatus <- swapMVar (currentStatus ses) (nextStatus (Just event)) | ||
217 | when (needNotify (Just event) (Just prevStatus) == Just True) $ do | ||
218 | announceAll mgr ses (Just event) | ||
217 | 219 | ||
218 | -- TODO fork thread for reannounces | 220 | -- TODO fork thread for reannounces |
219 | -- | | 221 | -- | |
@@ -221,7 +223,8 @@ announce :: Manager -> Session -> IO () | |||
221 | announce mgr ses = announceAll mgr ses Nothing | 223 | announce mgr ses = announceAll mgr ses Nothing |
222 | 224 | ||
223 | -- TODO run announce if sesion have no peers | 225 | -- TODO run announce if sesion have no peers |
224 | -- | This function /may/ block. Use async if needed. | 226 | -- | The returned list of peers can have duplicates. |
227 | -- This function /may/ block. Use async if needed. | ||
225 | askPeers :: Manager -> Session -> IO [PeerAddr IP] | 228 | askPeers :: Manager -> Session -> IO [PeerAddr IP] |
226 | askPeers mgr ses = do | 229 | askPeers mgr ses = do |
227 | list <- readMVar (trackers ses) | 230 | list <- readMVar (trackers ses) |