diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/Exchange.hs | 5 | ||||
-rw-r--r-- | src/Network/BitTorrent/Exchange/Protocol.hs | 4 | ||||
-rw-r--r-- | src/Network/BitTorrent/Sessions.hs | 18 | ||||
-rw-r--r-- | src/Network/BitTorrent/Sessions/Types.lhs | 4 |
4 files changed, 30 insertions, 1 deletions
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs index dc41b08e..0f1d2833 100644 --- a/src/Network/BitTorrent/Exchange.hs +++ b/src/Network/BitTorrent/Exchange.hs | |||
@@ -66,6 +66,11 @@ module Network.BitTorrent.Exchange | |||
66 | 66 | ||
67 | -- * Block | 67 | -- * Block |
68 | , Block(..), BlockIx(..) | 68 | , Block(..), BlockIx(..) |
69 | |||
70 | -- * Status | ||
71 | , PeerStatus(..), SessionStatus(..) | ||
72 | , inverseStatus | ||
73 | , canDownload, canUpload | ||
69 | ) where | 74 | ) where |
70 | 75 | ||
71 | import Control.Applicative | 76 | import Control.Applicative |
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs index 8461745a..00b6795b 100644 --- a/src/Network/BitTorrent/Exchange/Protocol.hs +++ b/src/Network/BitTorrent/Exchange/Protocol.hs | |||
@@ -56,6 +56,7 @@ module Network.BitTorrent.Exchange.Protocol | |||
56 | , choking, interested | 56 | , choking, interested |
57 | 57 | ||
58 | , SessionStatus(..) | 58 | , SessionStatus(..) |
59 | , inverseStatus | ||
59 | , clientStatus, peerStatus | 60 | , clientStatus, peerStatus |
60 | , canUpload, canDownload | 61 | , canUpload, canDownload |
61 | 62 | ||
@@ -549,6 +550,9 @@ canDownload :: SessionStatus -> Bool | |||
549 | canDownload SessionStatus {..} | 550 | canDownload SessionStatus {..} |
550 | = _interested _clientStatus && not (_choking _peerStatus) | 551 | = _interested _clientStatus && not (_choking _peerStatus) |
551 | 552 | ||
553 | inverseStatus :: SessionStatus -> SessionStatus | ||
554 | inverseStatus SessionStatus {..} = SessionStatus _peerStatus _clientStatus | ||
555 | |||
552 | -- | Indicates how many peers are allowed to download from the client | 556 | -- | Indicates how many peers are allowed to download from the client |
553 | -- by default. | 557 | -- by default. |
554 | defaultUnchokeSlots :: Int | 558 | defaultUnchokeSlots :: Int |
diff --git a/src/Network/BitTorrent/Sessions.hs b/src/Network/BitTorrent/Sessions.hs index 8bfa64d1..1d0d21b4 100644 --- a/src/Network/BitTorrent/Sessions.hs +++ b/src/Network/BitTorrent/Sessions.hs | |||
@@ -29,19 +29,28 @@ module Network.BitTorrent.Sessions | |||
29 | , getCurrentProgress | 29 | , getCurrentProgress |
30 | , getSwarmCount | 30 | , getSwarmCount |
31 | , getPeerCount | 31 | , getPeerCount |
32 | , getActiveSwarms | ||
32 | , getSwarm | 33 | , getSwarm |
33 | , getStorage | 34 | , getStorage |
34 | , getTorrentInfo | 35 | , getTorrentInfo |
35 | , openSwarmSession | 36 | , openSwarmSession |
36 | 37 | ||
37 | -- * Swarm | 38 | -- * Swarm |
38 | , SwarmSession( SwarmSession, torrentMeta, clientSession ) | 39 | , SwarmSession( SwarmSession, torrentMeta |
40 | , clientSession, storage | ||
41 | ) | ||
39 | 42 | ||
40 | , SessionCount | 43 | , SessionCount |
41 | , getSessionCount | 44 | , getSessionCount |
42 | , getClientBitfield | 45 | , getClientBitfield |
46 | , getActivePeers | ||
43 | 47 | ||
44 | , discover | 48 | , discover |
49 | |||
50 | , PeerSession ( connectedPeerAddr, enabledExtensions ) | ||
51 | , getSessionState | ||
52 | |||
53 | , SessionState (..) | ||
45 | ) where | 54 | ) where |
46 | 55 | ||
47 | import Prelude hiding (mapM_, elem) | 56 | import Prelude hiding (mapM_, elem) |
@@ -163,6 +172,9 @@ getPeerCount ClientSession {..} = liftIO $ do | |||
163 | unused <- peekAvail activeThreads | 172 | unused <- peekAvail activeThreads |
164 | return (maxActive - unused) | 173 | return (maxActive - unused) |
165 | 174 | ||
175 | getActiveSwarms :: ClientSession -> IO [SwarmSession] | ||
176 | getActiveSwarms ClientSession {..} = M.elems <$> readTVarIO swarmSessions | ||
177 | |||
166 | getListenerPort :: ClientSession -> IO PortNumber | 178 | getListenerPort :: ClientSession -> IO PortNumber |
167 | getListenerPort ClientSession {..} = servPort <$> readMVar peerListener | 179 | getListenerPort ClientSession {..} = servPort <$> readMVar peerListener |
168 | 180 | ||
@@ -249,6 +261,10 @@ getSwarm cs @ ClientSession {..} ih = do | |||
249 | getStorage :: ClientSession -> InfoHash -> IO Storage | 261 | getStorage :: ClientSession -> InfoHash -> IO Storage |
250 | getStorage cs ih = storage <$> getSwarm cs ih | 262 | getStorage cs ih = storage <$> getSwarm cs ih |
251 | 263 | ||
264 | -- TODO keep sorted? | ||
265 | getActivePeers :: SwarmSession -> IO [PeerSession] | ||
266 | getActivePeers SwarmSession {..} = S.toList <$> readTVarIO connectedPeers | ||
267 | |||
252 | getTorrentInfo :: ClientSession -> InfoHash -> IO (Maybe Torrent) | 268 | getTorrentInfo :: ClientSession -> InfoHash -> IO (Maybe Torrent) |
253 | getTorrentInfo cs ih = do | 269 | getTorrentInfo cs ih = do |
254 | tstatus <- torrentPresence cs ih | 270 | tstatus <- torrentPresence cs ih |
diff --git a/src/Network/BitTorrent/Sessions/Types.lhs b/src/Network/BitTorrent/Sessions/Types.lhs index af2a6755..5571e23a 100644 --- a/src/Network/BitTorrent/Sessions/Types.lhs +++ b/src/Network/BitTorrent/Sessions/Types.lhs | |||
@@ -34,6 +34,7 @@ | |||
34 | > , SessionState (..) | 34 | > , SessionState (..) |
35 | > , status, bitfield | 35 | > , status, bitfield |
36 | > , initialSessionState | 36 | > , initialSessionState |
37 | > , getSessionState | ||
37 | > | 38 | > |
38 | > , SessionException (..) | 39 | > , SessionException (..) |
39 | > , isSessionException, putSessionException | 40 | > , isSessionException, putSessionException |
@@ -416,6 +417,9 @@ Peer session state | |||
416 | > initialSessionState :: PieceCount -> SessionState | 417 | > initialSessionState :: PieceCount -> SessionState |
417 | > initialSessionState pc = SessionState (haveNone pc) def | 418 | > initialSessionState pc = SessionState (haveNone pc) def |
418 | 419 | ||
420 | > getSessionState :: PeerSession -> IO SessionState | ||
421 | > getSessionState PeerSession {..} = readIORef sessionState | ||
422 | |||
419 | Peer session exceptions | 423 | Peer session exceptions |
420 | ------------------------------------------------------------------------ | 424 | ------------------------------------------------------------------------ |
421 | 425 | ||