+ Add progress to client session.

2 files changed, 26 insertions, 22 deletions

diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs
index d34c6236..e231fb2c 100644
--- a/src/Network/BitTorrent/Internal.hs
+++ b/src/Network/BitTorrent/Internal.hs
@@ -12,7 +12,8 @@
 --
 {-# LANGUAGE RecordWildCards #-}
 module Network.BitTorrent.Internal
-       ( ClientSession(..), newClient
+       ( Progress(..), startProgress
+       , ClientSession(..), newClient
        , SwarmSession(..), newLeacher, newSeeder
        , PeerSession(..), withPeerSession
 
@@ -49,6 +50,21 @@ import Network.BitTorrent.Exchange.Protocol as BT
 
 
 
+-- | 'Progress' contains upload/download/left stats about
+--   current client state.
+--
+--   This data is considered as dynamic within one session.
+--
+data Progress = Progress {
+    prUploaded   :: Integer -- ^ Total amount of bytes uploaded.
+  , prDownloaded :: Integer -- ^ Total amount of bytes downloaded.
+  , prLeft       :: Integer -- ^ Total amount of bytes left.
+  } deriving Show
+
+startProgress :: Integer -> Progress
+startProgress = Progress 0 0
+
+
 {-----------------------------------------------------------------------
     Client session
 -----------------------------------------------------------------------}
@@ -59,6 +75,7 @@ data ClientSession = ClientSession {
   , allowedExtensions :: [Extension] -- ^
   , swarmSessions     :: TVar (Set SwarmSession)
   , eventManager      :: EventManager
+  , currentProgress   :: IORef Progress
   }
 
 instance Eq ClientSession where
@@ -72,6 +89,7 @@ newClient exts = ClientSession <$> newPeerID
                                <*> pure exts
                                <*> newTVarIO S.empty
                                <*> Ev.new
+                               <*> newIORef (startProgress 0)
 
 {-----------------------------------------------------------------------
     Swarm session
@@ -80,21 +98,21 @@ newClient exts = ClientSession <$> newPeerID
 -- | Extensions are set globally by
 --   Swarm session are un
 data SwarmSession = SwarmSession {
-    torrentInfoHash   :: InfoHash
+    torrentMeta       :: Torrent
   , clientSession     :: ClientSession
   , clientBitfield    :: IORef Bitfield
   , connectedPeers    :: TVar (Set PeerSession)
   }
 
 instance Eq SwarmSession where
-  (==) = (==) `on` torrentInfoHash
+  (==) = (==) `on` (tInfoHash . torrentMeta)
 
 instance Ord SwarmSession where
-  compare = comparing torrentInfoHash
+  compare = comparing (tInfoHash . torrentMeta)
 
 newSwarmSession :: Bitfield -> ClientSession -> Torrent -> IO SwarmSession
-newSwarmSession bf cs @ ClientSession {..} Torrent {..}
-  = SwarmSession <$> pure tInfoHash
+newSwarmSession bf cs @ ClientSession {..} t @ Torrent {..}
+  = SwarmSession <$> pure t
                  <*> pure cs
                  <*> newIORef bf
                  <*> newTVarIO S.empty
@@ -160,7 +178,7 @@ withPeerSession ss @ SwarmSession {..} addr
     openSession = do
       let caps = encodeExts $ allowedExtensions $ clientSession
       let pid  = clientPeerID $ clientSession
-      let chs  = Handshake defaultBTProtocol caps torrentInfoHash pid
+      let chs  = Handshake defaultBTProtocol caps (tInfoHash torrentMeta) pid
 
       sock <- connectToPeer addr
       phs  <- handshake sock chs `onException` close sock
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs
index aaa08f3c..9acfc53d 100644
--- a/src/Network/BitTorrent/Tracker.hs
+++ b/src/Network/BitTorrent/Tracker.hs
@@ -37,6 +37,7 @@ import Data.Torrent
 import Network
 import Network.URI
 
+import Network.BitTorrent.Internal
 import Network.BitTorrent.Peer
 import Network.BitTorrent.Tracker.Protocol
 import Network.BitTorrent.Tracker.Scrape
@@ -58,21 +59,6 @@ tconnection :: Torrent -> PeerID -> PortNumber -> TConnection
 tconnection t = TConnection (tAnnounce t) (tInfoHash t)
 
 
--- | 'Progress' contains upload/download/left stats about
---   current client state.
---
---   This data is considered as dynamic within one session.
---
-data Progress = Progress {
-    prUploaded   :: Integer -- ^ Total amount of bytes uploaded.
-  , prDownloaded :: Integer -- ^ Total amount of bytes downloaded.
-  , prLeft       :: Integer -- ^ Total amount of bytes left.
-  } deriving Show
-
-startProgress :: Integer -> Progress
-startProgress = Progress 0 0
-
-
 -- | used to avoid boilerplate; do NOT export me
 genericReq :: TConnection -> Progress -> TRequest
 genericReq ses pr =   TRequest {