From 17949276fbd32ab75bcb18016210b6947df54ed1 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Thu, 20 Mar 2014 01:09:54 +0400
Subject: Expose multitracker session state

---
 src/Network/BitTorrent/Internal/Cache.hs  |  5 ++++
 src/Network/BitTorrent/Tracker.hs         | 15 ++++++++---
 src/Network/BitTorrent/Tracker/Session.hs | 45 +++++++++++++++----------------
 3 files changed, 38 insertions(+), 27 deletions(-)

(limited to 'src/Network/BitTorrent')

diff --git a/src/Network/BitTorrent/Internal/Cache.hs b/src/Network/BitTorrent/Internal/Cache.hs
index 1eb2f192..8c74467a 100644
--- a/src/Network/BitTorrent/Internal/Cache.hs
+++ b/src/Network/BitTorrent/Internal/Cache.hs
@@ -27,6 +27,7 @@ module Network.BitTorrent.Internal.Cache
 
          -- * Cached data
        , tryTakeData
+       , unsafeTryTakeData
        , takeData
        ) where
 
@@ -35,6 +36,7 @@ import Data.Monoid
 import Data.Default
 import Data.Time
 import Data.Time.Clock.POSIX
+import System.IO.Unsafe
 
 
 data Cached a = Cached
@@ -143,6 +145,9 @@ tryTakeData c = do
   alive <- isAlive c
   return $ if alive then Just (cachedData c) else Nothing
 
+unsafeTryTakeData :: Cached a -> Maybe a
+unsafeTryTakeData = unsafePerformIO . tryTakeData
+
 invalidateData :: Cached a -> IO a -> IO (Cached a)
 invalidateData Cached {..} action = do
   t <- getPOSIXTime
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs
index f43b5dc2..a58d5091 100644
--- a/src/Network/BitTorrent/Tracker.hs
+++ b/src/Network/BitTorrent/Tracker.hs
@@ -25,15 +25,24 @@ module Network.BitTorrent.Tracker
        , newSession
        , closeSession
 
-         -- * Events
+         -- ** Events
        , Event (..)
        , notify
        , askPeers
 
-         -- * Query
---       , getSessionState
+         -- ** Session state
+       , TrackerEntry
+       , trackerURI
+       , trackerPeers
+       , trackerScrape
+
+       , tryTakeData
+       , unsafeTryTakeData
+
+       , getSessionState
        ) where
 
+import Network.BitTorrent.Internal.Cache (tryTakeData, unsafeTryTakeData)
 import Network.BitTorrent.Tracker.Message
 import Network.BitTorrent.Tracker.List
 import Network.BitTorrent.Tracker.RPC
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs
index 06c6ea19..59958ccd 100644
--- a/src/Network/BitTorrent/Tracker/Session.hs
+++ b/src/Network/BitTorrent/Tracker/Session.hs
@@ -14,14 +14,22 @@ module Network.BitTorrent.Tracker.Session
        , closeSession
        , withSession
 
-         -- * Query
+         -- * Client send notifications
+       , Event (..)
+       , notify
+       , askPeers
+
+         -- * Session state
+         -- ** Status
        , Status (..)
        , getStatus
-       , askPeers
 
-         -- * Events
-       , Event (..)
-       , notify
+         -- ** Single tracker sessions
+       , TrackerEntry
+       , trackerURI
+       , trackerPeers
+       , trackerScrape
+       , getSessionState
 
          -- * Tracker Exchange
          -- | BEP28: <http://www.bittorrent.org/beps/bep_0028.html>
@@ -36,7 +44,7 @@ import Control.Concurrent
 import Control.Monad
 import Data.Default
 import Data.Fixed
-import Data.Foldable
+import Data.Foldable as F
 import Data.IORef
 import Data.List as L
 import Data.Maybe
@@ -84,10 +92,10 @@ data TrackerEntry = TrackerEntry
   , statusSent    :: !(Maybe Status)
 
     -- | Can be used to retrieve peer set.
-  , peersCache    :: Cached [PeerAddr IP]
+  , trackerPeers  :: Cached [PeerAddr IP]
 
     -- | Can be used to show brief swarm stats in client GUI.
-  , scrapeCache   :: Cached LastScrape
+  , trackerScrape :: Cached LastScrape
   }
 
 -- | Single tracker session with empty state.
@@ -136,7 +144,7 @@ notifyTo :: Manager -> InfoHash -> Event
 notifyTo mgr ih event entry @ TrackerEntry {..} = do
 
   let shouldNotify = needNotify event statusSent
-  mustNotify <- maybe (isExpired peersCache) return shouldNotify
+  mustNotify <- maybe (isExpired trackerPeers) return shouldNotify
   if not mustNotify
     then return entry
     else do
@@ -193,6 +201,9 @@ withSession ih uris = bracket (newSession ih uris) closeSession
 getStatus :: Session -> IO Status
 getStatus Session {..} = readIORef sessionStatus
 
+getSessionState :: Session -> IO (TrackerList TrackerEntry)
+getSessionState Session {..} = readMVar sessionTrackers
+
 -- | Do we need to sent this event to a first working tracker or to
 -- the all known good trackers?
 allNotify :: Event -> Bool
@@ -226,7 +237,7 @@ notify mgr ses event = do
 askPeers :: Manager -> Session -> IO [PeerAddr IP]
 askPeers _mgr ses = do
   list    <- readMVar (sessionTrackers ses)
-  L.concat <$> collect (tryTakeData . peersCache) list
+  L.concat <$> collect (tryTakeData . trackerPeers) list
 
 collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b]
 collect f lst =(catMaybes . toList) <$> traverse f lst
@@ -234,20 +245,6 @@ collect f lst =(catMaybes . toList) <$> traverse f lst
 --sourcePeers :: Session -> Source (PeerAddr IP)
 --sourcePeers
 
-{-----------------------------------------------------------------------
---  State query
------------------------------------------------------------------------}
-
-data TrackerInfo = TrackerInfo
-  {
-  }
-
---instance ToJSON TrackerInfo where
---  toJSON = undefined
-
---getSessionState :: Session -> IO (TrackerList TrackerInfo)
---getSessionState = undefined
-
 {-----------------------------------------------------------------------
 --  Tracker exchange
 -----------------------------------------------------------------------}
-- 
cgit v1.2.3