diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Session.hs | 34 |
1 files changed, 31 insertions, 3 deletions
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs index 4c61034e..a17973ad 100644 --- a/src/Network/BitTorrent/Tracker/Session.hs +++ b/src/Network/BitTorrent/Tracker/Session.hs | |||
@@ -38,11 +38,16 @@ module Network.BitTorrent.Tracker.Session | |||
38 | , addTracker | 38 | , addTracker |
39 | , removeTracker | 39 | , removeTracker |
40 | , getTrustedTrackers | 40 | , getTrustedTrackers |
41 | |||
42 | -- * Events | ||
43 | , SessionEvent (..) | ||
44 | , subscribe | ||
41 | ) where | 45 | ) where |
42 | 46 | ||
43 | import Control.Applicative | 47 | import Control.Applicative |
44 | import Control.Exception | 48 | import Control.Exception |
45 | import Control.Concurrent | 49 | import Control.Concurrent |
50 | import Control.Concurrent.Chan.Split | ||
46 | import Control.Monad | 51 | import Control.Monad |
47 | import Data.Aeson | 52 | import Data.Aeson |
48 | import Data.Aeson.TH | 53 | import Data.Aeson.TH |
@@ -189,6 +194,8 @@ data Session = Session | |||
189 | -- | A set of single-tracker sessions. Any request to a tracker | 194 | -- | A set of single-tracker sessions. Any request to a tracker |
190 | -- must take a lock. | 195 | -- must take a lock. |
191 | , sessionTrackers :: !(MVar (TrackerList TrackerEntry)) | 196 | , sessionTrackers :: !(MVar (TrackerList TrackerEntry)) |
197 | |||
198 | , sessionEvents :: !(SendPort SessionEvent) | ||
192 | } | 199 | } |
193 | 200 | ||
194 | -- | Create a new multitracker session in paused state. Tracker list | 201 | -- | Create a new multitracker session in paused state. Tracker list |
@@ -196,19 +203,40 @@ data Session = Session | |||
196 | -- client presence use 'notify'. | 203 | -- client presence use 'notify'. |
197 | newSession :: InfoHash -> TrackerList URI -> IO Session | 204 | newSession :: InfoHash -> TrackerList URI -> IO Session |
198 | newSession ih origUris = do | 205 | newSession ih origUris = do |
199 | urisList <- shuffleTiers origUris | 206 | urisList <- shuffleTiers origUris |
200 | statusRef <- newIORef def | 207 | statusRef <- newIORef def |
201 | entriesVar <- newMVar (fmap nullEntry urisList) | 208 | entriesVar <- newMVar (fmap nullEntry urisList) |
209 | eventStream <- newSendPort | ||
202 | return Session | 210 | return Session |
203 | { sessionTopic = ih | 211 | { sessionTopic = ih |
204 | , sessionStatus = statusRef | 212 | , sessionStatus = statusRef |
205 | , sessionTrackers = entriesVar | 213 | , sessionTrackers = entriesVar |
214 | , sessionEvents = eventStream | ||
206 | } | 215 | } |
207 | 216 | ||
208 | -- | Release scarce resources associated with the given session. | 217 | -- | Release scarce resources associated with the given session. |
209 | closeSession :: Session -> IO () | 218 | closeSession :: Session -> IO () |
210 | closeSession _ = return () | 219 | closeSession _ = return () |
211 | 220 | ||
221 | {----------------------------------------------------------------------- | ||
222 | -- Events | ||
223 | -----------------------------------------------------------------------} | ||
224 | |||
225 | data SessionEvent | ||
226 | = TrackerAdded URI | ||
227 | | TrackerConfirmed URI | ||
228 | | TrackerRemoved URI | ||
229 | | AnnouncedTo URI | ||
230 | | Reannounced URI | ||
231 | | SessionClosed | ||
232 | |||
233 | subscribe :: Session -> IO (ReceivePort SessionEvent) | ||
234 | subscribe Session {..} = listen sessionEvents | ||
235 | |||
236 | {----------------------------------------------------------------------- | ||
237 | -- Operations | ||
238 | -----------------------------------------------------------------------} | ||
239 | |||
212 | -- | Normally you need to use 'Control.Monad.Trans.Resource.alloc'. | 240 | -- | Normally you need to use 'Control.Monad.Trans.Resource.alloc'. |
213 | withSession :: InfoHash -> TrackerList URI -> (Session -> IO ()) -> IO () | 241 | withSession :: InfoHash -> TrackerList URI -> (Session -> IO ()) -> IO () |
214 | withSession ih uris = bracket (newSession ih uris) closeSession | 242 | withSession ih uris = bracket (newSession ih uris) closeSession |