summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r--src/Network/BitTorrent/Tracker/Session.hs17
1 files changed, 10 insertions, 7 deletions
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs
index f1b4eae8..a9f436e8 100644
--- a/src/Network/BitTorrent/Tracker/Session.hs
+++ b/src/Network/BitTorrent/Tracker/Session.hs
@@ -106,10 +106,10 @@ needNotify Stopped (Just Paused ) = Just False
106needNotify Completed (Just Paused ) = Just True 106needNotify Completed (Just Paused ) = Just True
107 107
108-- | Client status after event announce succeed. 108-- | Client status after event announce succeed.
109nextStatus :: Event -> Status 109nextStatus :: Event -> Maybe Status
110nextStatus Started = Running 110nextStatus Started = Just Running
111nextStatus Stopped = Paused 111nextStatus Stopped = Just Paused
112nextStatus Completed = Running 112nextStatus Completed = Nothing -- must keep previous status
113 113
114seconds :: Int -> NominalDiffTime 114seconds :: Int -> NominalDiffTime
115seconds n = realToFrac (toEnum n :: Uni) 115seconds n = realToFrac (toEnum n :: Uni)
@@ -141,8 +141,10 @@ notifyTo mgr ih event entry @ TrackerEntry {..} = do
141 else do 141 else do
142 let q = SAnnounceQuery ih def Nothing (Just event) 142 let q = SAnnounceQuery ih def Nothing (Just event)
143 res <- RPC.announce mgr trackerURI q 143 res <- RPC.announce mgr trackerURI q
144 TrackerEntry trackerURI (Just (nextStatus event)) 144 let status' = nextStatus event <|> statusSent
145 <$> cachePeers res <*> cacheScrape res 145 TrackerEntry trackerURI status'
146 <$> cachePeers res
147 <*> cacheScrape res
146 148
147{----------------------------------------------------------------------- 149{-----------------------------------------------------------------------
148-- Multitracker Session 150-- Multitracker Session
@@ -207,7 +209,8 @@ notifyAll mgr Session {..} event = do
207-- This function /may/ block until tracker query proceed. 209-- This function /may/ block until tracker query proceed.
208notify :: Manager -> Session -> Event -> IO () 210notify :: Manager -> Session -> Event -> IO ()
209notify mgr ses event = do 211notify mgr ses event = do
210 prevStatus <- swapMVar (currentStatus ses) (nextStatus event) 212 prevStatus <- modifyMVar (currentStatus ses) $ \ s ->
213 return (fromMaybe s (nextStatus event), s)
211 when (needNotify event (Just prevStatus) == Just True) $ do 214 when (needNotify event (Just prevStatus) == Just True) $ do
212 notifyAll mgr ses event 215 notifyAll mgr ses event
213 216