diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-07-07 00:52:15 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-07-07 00:52:15 +0400 |
commit | e95d39a49d476e09b7d8da82bac514284f9d4e0f (patch) | |
tree | 37f073b266d724aabcc40ba6cd4e1323446de127 /src | |
parent | 05787c18b88db130e178b19aee09c21398a16256 (diff) |
~ Reassign listener to client session.
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent.hs | 14 | ||||
-rw-r--r-- | src/Network/BitTorrent/Internal.hs | 38 |
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 | ||
104 | discover :: SwarmSession -> P2P () -> IO () | 104 | discover :: SwarmSession -> P2P () -> IO () |
105 | discover swarm action = {-# SCC discover #-} do | 105 | discover 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 | |||
265 | instance Eq ClientSession where | 298 | instance 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 |