summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent.hs14
-rw-r--r--src/Network/BitTorrent/Internal.hs38
2 files changed, 42 insertions, 10 deletions
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index bb8eb800..ef144f1f 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -102,15 +102,13 @@ defaultClient = newClient defaultThreadCount defaultExtensions
102-- thus we can obtain an unified interface 102-- thus we can obtain an unified interface
103 103
104discover :: SwarmSession -> P2P () -> IO () 104discover :: SwarmSession -> P2P () -> IO ()
105discover swarm action = {-# SCC discover #-} do 105discover swarm @ SwarmSession {..} action = {-# SCC discover #-} do
106 port <- forkListener (error "discover") 106 let conn = TConnection (tAnnounce torrentMeta)
107 (tInfoHash torrentMeta)
108 (clientPeerId clientSession)
109 (listenerPort clientSession)
107 110
108 let conn = TConnection (tAnnounce (torrentMeta swarm)) 111 progress <- getCurrentProgress clientSession
109 (tInfoHash (torrentMeta swarm))
110 (clientPeerId (clientSession swarm))
111 port
112
113 progress <- getCurrentProgress (clientSession swarm)
114 112
115 withTracker progress conn $ \tses -> do 113 withTracker progress conn $ \tses -> do
116 forever $ do 114 forever $ do
diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs
index fffd4727..964dfd75 100644
--- a/src/Network/BitTorrent/Internal.hs
+++ b/src/Network/BitTorrent/Internal.hs
@@ -10,7 +10,35 @@
10-- Network.BitTorrent.Exchange and modules. To hide some internals 10-- Network.BitTorrent.Exchange and modules. To hide some internals
11-- of this module we detach it from Exchange. 11-- of this module we detach it from Exchange.
12-- 12--
13-- Note: expose only static data in data field lists, all dynamic 13-- Thread layout
14--
15-- When client session created 2 new threads appear:
16--
17-- * DHT listener - replies to DHT requests;
18--
19-- * Peer listener - accept new P2P connection initiated by other
20-- peers.
21--
22-- When swarn session created 3 new threads appear:
23--
24-- * DHT request loop asks for new peers;
25--
26-- * Tracker request loop asks for new peers;
27--
28-- * controller which fork new avaand manage running P2P sessions.
29--
30-- Peer session is one always forked thread.
31--
32-- When client\/swarm\/peer session gets closed kill the
33-- corresponding threads, but flush data to disc. (for e.g. storage
34-- block map)
35--
36-- So for e.g., in order to obtain our first block we need to run at
37-- least 7 threads: main thread, 2 client session thread, 3 swarm
38-- session threads and PeerSession thread.
39--
40--
41-- NOTE: expose only static data in data field lists, all dynamic
14-- data should be modified through standalone functions. 42-- data should be modified through standalone functions.
15-- 43--
16{-# LANGUAGE OverloadedStrings #-} 44{-# LANGUAGE OverloadedStrings #-}
@@ -22,7 +50,7 @@ module Network.BitTorrent.Internal
22 ( Progress(..), startProgress 50 ( Progress(..), startProgress
23 51
24 -- * Client 52 -- * Client
25 , ClientSession (clientPeerId, allowedExtensions) 53 , ClientSession (clientPeerId, allowedExtensions, listenerPort)
26 54
27 , ThreadCount 55 , ThreadCount
28 , defaultThreadCount 56 , defaultThreadCount
@@ -241,6 +269,10 @@ data ClientSession = ClientSession {
241 -- 'PeerSession'. 269 -- 'PeerSession'.
242 , allowedExtensions :: [Extension] 270 , allowedExtensions :: [Extension]
243 271
272 -- | Port where client listen for other peers
273 , listenerPort :: PortNumber
274 -- TODO restart listener if it fail
275
244 -- | Semaphor used to bound number of active P2P sessions. 276 -- | Semaphor used to bound number of active P2P sessions.
245 , activeThreads :: !(MSem ThreadCount) 277 , activeThreads :: !(MSem ThreadCount)
246 278
@@ -262,6 +294,7 @@ data ClientSession = ClientSession {
262-- currentProgress field is reduntant: progress depends on the all swarm bitfields 294-- currentProgress field is reduntant: progress depends on the all swarm bitfields
263-- maybe we can remove the 'currentProgress' and compute it on demand? 295-- maybe we can remove the 'currentProgress' and compute it on demand?
264 296
297
265instance Eq ClientSession where 298instance Eq ClientSession where
266 (==) = (==) `on` clientPeerId 299 (==) = (==) `on` clientPeerId
267 300
@@ -298,6 +331,7 @@ newClient n exts = do
298 ClientSession 331 ClientSession
299 <$> newPeerId 332 <$> newPeerId
300 <*> pure exts 333 <*> pure exts
334 <*> forkListener (error "listener")
301 <*> MSem.new n 335 <*> MSem.new n
302 <*> pure n 336 <*> pure n
303 <*> newTVarIO S.empty 337 <*> newTVarIO S.empty