summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/Exchange/Protocol.hs5
-rw-r--r--src/Network/BitTorrent/Internal.lhs87
2 files changed, 73 insertions, 19 deletions
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs
index d4d9b239..c4128032 100644
--- a/src/Network/BitTorrent/Exchange/Protocol.hs
+++ b/src/Network/BitTorrent/Exchange/Protocol.hs
@@ -29,9 +29,10 @@
29{-# LANGUAGE RecordWildCards #-} 29{-# LANGUAGE RecordWildCards #-}
30{-# LANGUAGE TemplateHaskell #-} 30{-# LANGUAGE TemplateHaskell #-}
31module Network.BitTorrent.Exchange.Protocol 31module Network.BitTorrent.Exchange.Protocol
32 ( -- * Inital handshake 32 ( -- * Initial handshake
33 Handshake(..), ppHandshake 33 Handshake(..), ppHandshake
34 , handshake , handshakeCaps 34 , handshake, handshakeCaps
35 , recvHandshake, sendHandshake
35 36
36 -- ** Defaults 37 -- ** Defaults
37 , defaultHandshake, defaultBTProtocol, defaultReserved 38 , defaultHandshake, defaultBTProtocol, defaultReserved
diff --git a/src/Network/BitTorrent/Internal.lhs b/src/Network/BitTorrent/Internal.lhs
index 24fecac7..8dbf488e 100644
--- a/src/Network/BitTorrent/Internal.lhs
+++ b/src/Network/BitTorrent/Internal.lhs
@@ -94,6 +94,7 @@
94> import Data.Default 94> import Data.Default
95> import Data.Function 95> import Data.Function
96> import Data.Foldable (mapM_) 96> import Data.Foldable (mapM_)
97> import Data.Map as M
97> import Data.HashMap.Strict as HM 98> import Data.HashMap.Strict as HM
98> import Data.Ord 99> import Data.Ord
99> import Data.Set as S 100> import Data.Set as S
@@ -219,6 +220,8 @@ than seeder threads.
219Torrent Map 220Torrent Map
220------------------------------------------------------------------------ 221------------------------------------------------------------------------
221 222
223TODO: keep track global peer have piece set.
224
222Keeping all seeding torrent metafiles in memory is a _bad_ idea: for 225Keeping all seeding torrent metafiles in memory is a _bad_ idea: for
2231TB of data we need at least 100MB of metadata. (using 256KB piece 2261TB of data we need at least 100MB of metadata. (using 256KB piece
224size). This solution do not scale further. 227size). This solution do not scale further.
@@ -269,7 +272,31 @@ back.
269> unregisterTorrent = error "unregisterTorrent" 272> unregisterTorrent = error "unregisterTorrent"
270> -- modifyTVar' torrentMap $ HM.delete ih 273> -- modifyTVar' torrentMap $ HM.delete ih
271 274
272Client session 275Client Services
276------------------------------------------------------------------------
277
278There are two servers started as client start:
279
280 * DHT node listener - needed by other peers to discover
281 * Peer listener - need by other peers to join this client.
282
283Thus any client (assuming DHT is enabled) provides at least 2 services
284so we can abstract out into ClientService:
285
286> data ClientService = ClientService {
287> servPort :: !PortNumber
288> , servThread :: !ThreadId
289> } deriving Show
290
291startService :: PortNumber -> IO a -> IO ClientService
292startService p m = forkIO $ handle $ m p
293 where
294 handle :: IOError -> IO ()
295
296> stopService :: ClientService -> IO ()
297> stopService ClientService {..} = killThread servThread
298
299Client Sessions
273------------------------------------------------------------------------ 300------------------------------------------------------------------------
274 301
275Basically, client session should contain options which user 302Basically, client session should contain options which user
@@ -304,10 +331,12 @@ and different enabled extensions at the same time.
304> -- 'PeerSession'. 331> -- 'PeerSession'.
305> , allowedExtensions :: [Extension] 332> , allowedExtensions :: [Extension]
306 333
307> -- | Port where client listen for other peers 334-- > , peerListener :: !ClientService
335-- > , nodeListener :: !ClientService
336
337> -- | Port where client listen for the other peers.
308> , listenerPort :: PortNumber 338> , listenerPort :: PortNumber
309> -- TODO restart listener if it fail 339
310> -- , dhtListenerPort
311> -- | Semaphor used to bound number of active P2P sessions. 340> -- | Semaphor used to bound number of active P2P sessions.
312> , activeThreads :: !(MSem ThreadCount) 341> , activeThreads :: !(MSem ThreadCount)
313 342
@@ -315,7 +344,7 @@ and different enabled extensions at the same time.
315> , maxActive :: !ThreadCount 344> , maxActive :: !ThreadCount
316 345
317> -- | Used to traverse the swarm session. 346> -- | Used to traverse the swarm session.
318> , swarmSessions :: !(TVar (Set SwarmSession)) 347> , swarmSessions :: !(TVar (Map InfoHash SwarmSession))
319 348
320> , eventManager :: !EventManager 349> , eventManager :: !EventManager
321 350
@@ -326,9 +355,9 @@ and different enabled extensions at the same time.
326> , torrentMap :: !(TVar TorrentMap) 355> , torrentMap :: !(TVar TorrentMap)
327> } 356> }
328 357
329> -- currentProgress field is reduntant: progress depends on the all swarm bitfields 358NOTE: currentProgress field is reduntant: progress depends on the all swarm
330> -- maybe we can remove the 'currentProgress' and compute it on demand? 359bitfields maybe we can remove the 'currentProgress' and compute it on
331 360demand?
332 361
333> instance Eq ClientSession where 362> instance Eq ClientSession where
334> (==) = (==) `on` clientPeerId 363> (==) = (==) `on` clientPeerId
@@ -336,6 +365,25 @@ and different enabled extensions at the same time.
336> instance Ord ClientSession where 365> instance Ord ClientSession where
337> compare = comparing clientPeerId 366> compare = comparing clientPeerId
338 367
368Torrent presence
369------------------------------------------------------------------------
370
371> data TorrentPresence = Active SwarmSession
372> | Registered TorrentLoc
373> | Unknown
374
375> torrentPresence :: ClientSession -> InfoHash -> IO TorrentPresence
376> torrentPresence ClientSession {..} ih = do
377> sws <- readTVarIO swarmSessions
378> case M.lookup ih sws of
379> Just ss -> return $ Active ss
380> Nothing -> do
381> tm <- readTVarIO torrentMap
382> return $ maybe Unknown Registered $ HM.lookup ih tm
383
384Retrieving client info
385------------------------------------------------------------------------
386
339> -- | Get current global progress of the client. This value is usually 387> -- | Get current global progress of the client. This value is usually
340> -- shown to a user. 388> -- shown to a user.
341> getCurrentProgress :: MonadIO m => ClientSession -> m Progress 389> getCurrentProgress :: MonadIO m => ClientSession -> m Progress
@@ -344,7 +392,7 @@ and different enabled extensions at the same time.
344> -- | Get number of swarms client aware of. 392> -- | Get number of swarms client aware of.
345> getSwarmCount :: MonadIO m => ClientSession -> m SessionCount 393> getSwarmCount :: MonadIO m => ClientSession -> m SessionCount
346> getSwarmCount ClientSession {..} = liftIO $ 394> getSwarmCount ClientSession {..} = liftIO $
347> S.size <$> readTVarIO swarmSessions 395> M.size <$> readTVarIO swarmSessions
348 396
349> -- | Get number of peers the client currently connected to. 397> -- | Get number of peers the client currently connected to.
350> getPeerCount :: MonadIO m => ClientSession -> m ThreadCount 398> getPeerCount :: MonadIO m => ClientSession -> m ThreadCount
@@ -369,18 +417,23 @@ and different enabled extensions at the same time.
369> <*> pure 10 -- forkListener (error "listener") 417> <*> pure 10 -- forkListener (error "listener")
370> <*> MSem.new n 418> <*> MSem.new n
371> <*> pure n 419> <*> pure n
372> <*> newTVarIO S.empty 420> <*> newTVarIO M.empty
373> <*> pure mgr 421> <*> pure mgr
374> <*> newTVarIO (startProgress 0) 422> <*> newTVarIO (startProgress 0)
375> <*> newTVarIO HM.empty 423> <*> newTVarIO HM.empty
376 424
377data TorrentStatus = Active SwarmSession 425> listenerHandler :: ClientSession -> Socket -> IO ()
378 | Registered TorrentLoc 426> listenerHandler ses sock = do
379 | Unknown 427> Handshake {..} <- recvHandshake sock
380lookupTorrent :: ClientSession -> InfoHash -> IO TorrentStatus 428> status <- torrentPresence ses hsInfoHash
381lookupTorrent ses ih = 429> case status of
430> Unknown -> return ()
431> Active ses -> error "listener handler"
432> -- TODO here we need to lookup local torrent status: BF e.t.c>
433> Registered _ -> return ()
434> return ()
382 435
383Swarm session 436Swarm sessions
384------------------------------------------------------------------------ 437------------------------------------------------------------------------
385 438
386NOTE: If client is a leecher then there is NO particular reason to 439NOTE: If client is a leecher then there is NO particular reason to
@@ -500,7 +553,7 @@ However if client is a seeder then the value depends on .
500> pieceLength = ciPieceLength . tInfo . torrentMeta 553> pieceLength = ciPieceLength . tInfo . torrentMeta
501> {-# INLINE pieceLength #-} 554> {-# INLINE pieceLength #-}
502 555
503Peer session 556Peer sessions
504------------------------------------------------------------------------ 557------------------------------------------------------------------------
505 558
506> -- | Peer session contain all data necessary for peer to peer 559> -- | Peer session contain all data necessary for peer to peer