diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker/Session.hs')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Session.hs | 75 |
1 files changed, 32 insertions, 43 deletions
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs index b15075c1..f1b4eae8 100644 --- a/src/Network/BitTorrent/Tracker/Session.hs +++ b/src/Network/BitTorrent/Tracker/Session.hs | |||
@@ -94,28 +94,22 @@ nullEntry :: URI -> TrackerEntry | |||
94 | nullEntry uri = TrackerEntry uri Nothing def def | 94 | nullEntry uri = TrackerEntry uri Nothing def def |
95 | 95 | ||
96 | -- | Do we need to notify this /specific/ tracker? | 96 | -- | Do we need to notify this /specific/ tracker? |
97 | needNotify :: Maybe Event -> Maybe Status -> Maybe Bool | 97 | needNotify :: Event -> Maybe Status -> Maybe Bool |
98 | needNotify Nothing Nothing = Just True | 98 | needNotify Started Nothing = Just True |
99 | needNotify (Just Started) Nothing = Just True | 99 | needNotify Stopped Nothing = Just False |
100 | needNotify (Just Stopped) Nothing = Just False | 100 | needNotify Completed Nothing = Just False |
101 | needNotify (Just Completed) Nothing = Just False | 101 | needNotify Started (Just Running) = Nothing |
102 | 102 | needNotify Stopped (Just Running) = Just True | |
103 | needNotify Nothing (Just Running) = Nothing | 103 | needNotify Completed (Just Running) = Just True |
104 | needNotify (Just Started) (Just Running) = Nothing | 104 | needNotify Started (Just Paused ) = Just True |
105 | needNotify (Just Stopped) (Just Running) = Just True | 105 | needNotify Stopped (Just Paused ) = Just False |
106 | needNotify (Just Completed) (Just Running) = Just True | 106 | needNotify Completed (Just Paused ) = Just True |
107 | |||
108 | needNotify Nothing (Just Paused ) = Just False | ||
109 | needNotify (Just Started) (Just Paused ) = Just True | ||
110 | needNotify (Just Stopped) (Just Paused ) = Just False | ||
111 | needNotify (Just Completed) (Just Paused ) = Just True | ||
112 | 107 | ||
113 | -- | Client status after event announce succeed. | 108 | -- | Client status after event announce succeed. |
114 | nextStatus :: Maybe Event -> Status | 109 | nextStatus :: Event -> Status |
115 | nextStatus Nothing = Running | 110 | nextStatus Started = Running |
116 | nextStatus (Just Started ) = Running | 111 | nextStatus Stopped = Paused |
117 | nextStatus (Just Stopped ) = Paused | 112 | nextStatus Completed = Running |
118 | nextStatus (Just Completed) = Running | ||
119 | 113 | ||
120 | seconds :: Int -> NominalDiffTime | 114 | seconds :: Int -> NominalDiffTime |
121 | seconds n = realToFrac (toEnum n :: Uni) | 115 | seconds n = realToFrac (toEnum n :: Uni) |
@@ -136,17 +130,18 @@ cacheScrape AnnounceInfo {..} = | |||
136 | } | 130 | } |
137 | 131 | ||
138 | -- | Make announce request to specific tracker returning new state. | 132 | -- | Make announce request to specific tracker returning new state. |
139 | announceTo :: Manager -> InfoHash -> Maybe Event | 133 | notifyTo :: Manager -> InfoHash -> Event |
140 | -> TrackerEntry -> IO TrackerEntry | 134 | -> TrackerEntry -> IO TrackerEntry |
141 | announceTo mgr ih mevent entry @ TrackerEntry {..} = do | 135 | notifyTo mgr ih event entry @ TrackerEntry {..} = do |
142 | let shouldNotify = needNotify mevent statusSent | 136 | |
137 | let shouldNotify = needNotify event statusSent | ||
143 | mustNotify <- maybe (isExpired peersCache) return shouldNotify | 138 | mustNotify <- maybe (isExpired peersCache) return shouldNotify |
144 | if not mustNotify | 139 | if not mustNotify |
145 | then return entry | 140 | then return entry |
146 | else do | 141 | else do |
147 | let q = SAnnounceQuery ih def Nothing mevent | 142 | let q = SAnnounceQuery ih def Nothing (Just event) |
148 | res <- RPC.announce mgr trackerURI q | 143 | res <- RPC.announce mgr trackerURI q |
149 | TrackerEntry trackerURI (Just (nextStatus mevent)) | 144 | TrackerEntry trackerURI (Just (nextStatus event)) |
150 | <$> cachePeers res <*> cacheScrape res | 145 | <$> cachePeers res <*> cacheScrape res |
151 | 146 | ||
152 | {----------------------------------------------------------------------- | 147 | {----------------------------------------------------------------------- |
@@ -193,18 +188,17 @@ getStatus Session {..} = readMVar currentStatus | |||
193 | 188 | ||
194 | -- | Do we need to sent this event to a first working tracker or to | 189 | -- | Do we need to sent this event to a first working tracker or to |
195 | -- the all known good trackers? | 190 | -- the all known good trackers? |
196 | allNotify :: Maybe Event -> Bool | 191 | allNotify :: Event -> Bool |
197 | allNotify Nothing = False | 192 | allNotify Started = False |
198 | allNotify (Just Started) = False | 193 | allNotify Stopped = True |
199 | allNotify (Just Stopped) = True | 194 | allNotify Completed = True |
200 | allNotify (Just Completed) = True | 195 | |
201 | 196 | notifyAll :: Manager -> Session -> Event -> IO () | |
202 | announceAll :: Manager -> Session -> Maybe Event -> IO () | 197 | notifyAll mgr Session {..} event = do |
203 | announceAll mgr Session {..} mevent = do | 198 | modifyMVar_ trackers (traversal (notifyTo mgr infohash event)) |
204 | modifyMVar_ trackers (traversal (announceTo mgr infohash mevent)) | ||
205 | where | 199 | where |
206 | traversal | 200 | traversal |
207 | | allNotify mevent = traverseAll | 201 | | allNotify event = traverseAll |
208 | | otherwise = traverseTiers | 202 | | otherwise = traverseTiers |
209 | 203 | ||
210 | -- TODO send notifications to tracker periodically. | 204 | -- TODO send notifications to tracker periodically. |
@@ -213,14 +207,9 @@ announceAll mgr Session {..} mevent = do | |||
213 | -- This function /may/ block until tracker query proceed. | 207 | -- This function /may/ block until tracker query proceed. |
214 | notify :: Manager -> Session -> Event -> IO () | 208 | notify :: Manager -> Session -> Event -> IO () |
215 | notify mgr ses event = do | 209 | notify mgr ses event = do |
216 | prevStatus <- swapMVar (currentStatus ses) (nextStatus (Just event)) | 210 | prevStatus <- swapMVar (currentStatus ses) (nextStatus event) |
217 | when (needNotify (Just event) (Just prevStatus) == Just True) $ do | 211 | when (needNotify event (Just prevStatus) == Just True) $ do |
218 | announceAll mgr ses (Just event) | 212 | notifyAll mgr ses event |
219 | |||
220 | -- TODO fork thread for reannounces | ||
221 | -- | | ||
222 | announce :: Manager -> Session -> IO () | ||
223 | announce mgr ses = announceAll mgr ses Nothing | ||
224 | 213 | ||
225 | -- TODO run announce if sesion have no peers | 214 | -- TODO run announce if sesion have no peers |
226 | -- | The returned list of peers can have duplicates. | 215 | -- | The returned list of peers can have duplicates. |