diff options
Diffstat (limited to 'src/Network/BitTorrent/Internal.lhs')
-rw-r--r-- | src/Network/BitTorrent/Internal.lhs | 87 |
1 files changed, 70 insertions, 17 deletions
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. | |||
219 | Torrent Map | 220 | Torrent Map |
220 | ------------------------------------------------------------------------ | 221 | ------------------------------------------------------------------------ |
221 | 222 | ||
223 | TODO: keep track global peer have piece set. | ||
224 | |||
222 | Keeping all seeding torrent metafiles in memory is a _bad_ idea: for | 225 | Keeping all seeding torrent metafiles in memory is a _bad_ idea: for |
223 | 1TB of data we need at least 100MB of metadata. (using 256KB piece | 226 | 1TB of data we need at least 100MB of metadata. (using 256KB piece |
224 | size). This solution do not scale further. | 227 | size). 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 | ||
272 | Client session | 275 | Client Services |
276 | ------------------------------------------------------------------------ | ||
277 | |||
278 | There 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 | |||
283 | Thus any client (assuming DHT is enabled) provides at least 2 services | ||
284 | so we can abstract out into ClientService: | ||
285 | |||
286 | > data ClientService = ClientService { | ||
287 | > servPort :: !PortNumber | ||
288 | > , servThread :: !ThreadId | ||
289 | > } deriving Show | ||
290 | |||
291 | startService :: PortNumber -> IO a -> IO ClientService | ||
292 | startService p m = forkIO $ handle $ m p | ||
293 | where | ||
294 | handle :: IOError -> IO () | ||
295 | |||
296 | > stopService :: ClientService -> IO () | ||
297 | > stopService ClientService {..} = killThread servThread | ||
298 | |||
299 | Client Sessions | ||
273 | ------------------------------------------------------------------------ | 300 | ------------------------------------------------------------------------ |
274 | 301 | ||
275 | Basically, client session should contain options which user | 302 | Basically, 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 | 358 | NOTE: currentProgress field is reduntant: progress depends on the all swarm |
330 | > -- maybe we can remove the 'currentProgress' and compute it on demand? | 359 | bitfields maybe we can remove the 'currentProgress' and compute it on |
331 | 360 | demand? | |
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 | ||
368 | Torrent 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 | |||
384 | Retrieving 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 | ||
377 | data TorrentStatus = Active SwarmSession | 425 | > listenerHandler :: ClientSession -> Socket -> IO () |
378 | | Registered TorrentLoc | 426 | > listenerHandler ses sock = do |
379 | | Unknown | 427 | > Handshake {..} <- recvHandshake sock |
380 | lookupTorrent :: ClientSession -> InfoHash -> IO TorrentStatus | 428 | > status <- torrentPresence ses hsInfoHash |
381 | lookupTorrent 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 | ||
383 | Swarm session | 436 | Swarm sessions |
384 | ------------------------------------------------------------------------ | 437 | ------------------------------------------------------------------------ |
385 | 438 | ||
386 | NOTE: If client is a leecher then there is NO particular reason to | 439 | NOTE: 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 | ||
503 | Peer session | 556 | Peer 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 |