~ Expose some session data.

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
 
          -- * Block
        , Block(..), BlockIx(..)
+
+         -- * Status
+       , PeerStatus(..), SessionStatus(..)
+       , inverseStatus
+       , canDownload, canUpload
        ) where
 
 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
        , choking, interested
 
        , SessionStatus(..)
+       , inverseStatus
        , clientStatus, peerStatus
        , canUpload, canDownload
 
@@ -549,6 +550,9 @@ canDownload :: SessionStatus -> Bool
 canDownload SessionStatus {..}
   = _interested _clientStatus && not (_choking _peerStatus)
 
+inverseStatus :: SessionStatus -> SessionStatus
+inverseStatus SessionStatus {..} = SessionStatus _peerStatus _clientStatus
+
 -- | Indicates how many peers are allowed to download from the client
 -- by default.
 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
        , getCurrentProgress
        , getSwarmCount
        , getPeerCount
+       , getActiveSwarms
        , getSwarm
        , getStorage
        , getTorrentInfo
        , openSwarmSession
 
          -- * Swarm
-       , SwarmSession( SwarmSession, torrentMeta, clientSession )
+       , SwarmSession( SwarmSession, torrentMeta
+                     , clientSession, storage
+                     )
 
        , SessionCount
        , getSessionCount
        , getClientBitfield
+       , getActivePeers
 
        , discover
+
+       , PeerSession ( connectedPeerAddr, enabledExtensions )
+       , getSessionState
+
+       , SessionState (..)
        ) where
 
 import Prelude hiding (mapM_, elem)
@@ -163,6 +172,9 @@ getPeerCount ClientSession {..} = liftIO $ do
   unused  <- peekAvail activeThreads
   return (maxActive - unused)
 
+getActiveSwarms :: ClientSession -> IO [SwarmSession]
+getActiveSwarms ClientSession {..} = M.elems <$> readTVarIO swarmSessions
+
 getListenerPort :: ClientSession -> IO PortNumber
 getListenerPort ClientSession {..} = servPort <$> readMVar peerListener
 
@@ -249,6 +261,10 @@ getSwarm cs @ ClientSession {..} ih = do
 getStorage :: ClientSession -> InfoHash -> IO Storage
 getStorage cs ih = storage <$> getSwarm cs ih
 
+-- TODO keep sorted?
+getActivePeers :: SwarmSession -> IO [PeerSession]
+getActivePeers SwarmSession {..} = S.toList <$> readTVarIO connectedPeers
+
 getTorrentInfo :: ClientSession -> InfoHash -> IO (Maybe Torrent)
 getTorrentInfo cs ih = do
   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 @@
 >        , SessionState (..)
 >        , status, bitfield
 >        , initialSessionState
+>        , getSessionState
 >
 >        , SessionException (..)
 >        , isSessionException, putSessionException
@@ -416,6 +417,9 @@ Peer session state
 > initialSessionState :: PieceCount -> SessionState
 > initialSessionState pc = SessionState (haveNone pc) def
 
+> getSessionState :: PeerSession -> IO SessionState
+> getSessionState PeerSession {..} = readIORef sessionState
+
 Peer session exceptions
 ------------------------------------------------------------------------