diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Session.hs | 31 |
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. |
155 | data Session = Session | 155 | data 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'. |
172 | newSession :: InfoHash -> TrackerList URI -> IO Session | 172 | newSession :: InfoHash -> TrackerList URI -> IO Session |
173 | newSession ih origUris = do | 173 | newSession 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. |
180 | closeSession :: Session -> IO () | 184 | closeSession :: 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'. |
189 | getStatus :: Session -> IO Status | 193 | getStatus :: Session -> IO Status |
190 | getStatus Session {..} = readIORef currentStatus | 194 | getStatus 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 | ||
199 | notifyAll :: Manager -> Session -> Event -> IO () | 203 | notifyAll :: Manager -> Session -> Event -> IO () |
200 | notifyAll mgr Session {..} event = do | 204 | notifyAll 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. |
211 | notify :: Manager -> Session -> Event -> IO () | 216 | notify :: Manager -> Session -> Event -> IO () |
212 | notify mgr ses event = do | 217 | notify 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. |
221 | askPeers :: Manager -> Session -> IO [PeerAddr IP] | 226 | askPeers :: Manager -> Session -> IO [PeerAddr IP] |
222 | askPeers mgr ses = do | 227 | askPeers _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 | ||
226 | collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b] | 231 | collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b] |