summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Internal.lhs77
1 files changed, 36 insertions, 41 deletions
diff --git a/src/Network/BitTorrent/Internal.lhs b/src/Network/BitTorrent/Internal.lhs
index ed4fd1a0..f46ca244 100644
--- a/src/Network/BitTorrent/Internal.lhs
+++ b/src/Network/BitTorrent/Internal.lhs
@@ -9,13 +9,10 @@
9> -- provides sessions needed by Network.BitTorrent and 9> -- provides sessions needed by Network.BitTorrent and
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> -- NOTE: Expose only static data in data field lists, all dynamic
13> -- data should be modified through standalone functions.
12> -- 14> --
13> 15>
14
15**NOTE**: Expose only static data in data field lists, all dynamic
16data should be modified through standalone functions.
17
18>
19> {-# LANGUAGE OverloadedStrings #-} 16> {-# LANGUAGE OverloadedStrings #-}
20> {-# LANGUAGE RecordWildCards #-} 17> {-# LANGUAGE RecordWildCards #-}
21> {-# LANGUAGE ViewPatterns #-} 18> {-# LANGUAGE ViewPatterns #-}
@@ -513,27 +510,26 @@ Peer session
513> -- | Extensions such that both peer and client support. 510> -- | Extensions such that both peer and client support.
514> , enabledExtensions :: [Extension] 511> , enabledExtensions :: [Extension]
515 512
516> -- | To dissconnect from died peers appropriately we should check 513To dissconnect from died peers appropriately we should check if a peer
517> -- if a peer do not sent the KA message within given interval. If 514do not sent the KA message within given interval. If yes, we should
518> -- yes, we should throw an exception in 'TimeoutCallback' and 515throw an exception in 'TimeoutCallback' and close session between
519> -- close session between peers. 516peers.
520> -- 517
521> -- We should update timeout if we /receive/ any message within 518We should update timeout if we /receive/ any message within timeout
522> -- timeout interval to keep connection up. 519interval to keep connection up.
520
523> , incomingTimeout :: !TimeoutKey 521> , incomingTimeout :: !TimeoutKey
524 522
525> -- | To send KA message appropriately we should know when was last 523To send KA message appropriately we should know when was last time we
526> -- time we sent a message to a peer. To do that we keep registered 524sent a message to a peer. To do that we keep registered timeout in
527> -- timeout in event manager and if we do not sent any message to 525event manager and if we do not sent any message to the peer within
528> -- the peer within given interval then we send KA message in 526given interval then we send KA message in 'TimeoutCallback'.
529> -- 'TimeoutCallback'.
530> --
531> -- We should update timeout if we /send/ any message within timeout
532> -- to avoid reduntant KA messages.
533> --
534> , outcomingTimeout :: !TimeoutKey
535 527
536> -- TODO use dupChan for broadcasting 528We should update timeout if we /send/ any message within timeout to
529avoid reduntant KA messages.
530
531> , outcomingTimeout :: !TimeoutKey
532>
537> -- | Broadcast messages waiting to be sent to peer. 533> -- | Broadcast messages waiting to be sent to peer.
538> , pendingMessages :: !(TChan Message) 534> , pendingMessages :: !(TChan Message)
539 535
@@ -623,19 +619,18 @@ Peer session
623Broadcasting: Have, Cancel, Bitfield, SuggestPiece 619Broadcasting: Have, Cancel, Bitfield, SuggestPiece
624------------------------------------------------------------------------ 620------------------------------------------------------------------------
625 621
626> -- here we should enqueue broadcast messages and keep in mind that: 622Here we should enqueue broadcast messages and keep in mind that:
627> -- 623 * We should enqueue broadcast events as they are appear.
628> -- * We should enqueue broadcast events as they are appear. 624 * We should yield broadcast messages as fast as we get them.
629> -- * We should yield broadcast messages as fast as we get them.
630> --
631> -- these 2 phases might differ in time significantly
632 625
633> -- TODO do this; but only when it'll be clean which other broadcast 626these 2 phases might differ in time significantly
634> -- messages & events we should send
635 627
636> -- 1. Update client have bitfield --\____ in one transaction; 628**TODO**: do this; but only when it'll be clean which other broadcast
637> -- 2. Update downloaded stats --/ 629messages & events we should send.
638> -- 3. Signal to the all other peer about this. 630
6311. Update client have bitfield --\____ in one transaction;
6322. Update downloaded stats --/
6333. Signal to the all other peer about this.
639 634
640> available :: Bitfield -> SwarmSession -> IO () 635> available :: Bitfield -> SwarmSession -> IO ()
641> available bf se @ SwarmSession {..} = {-# SCC available #-} do 636> available bf se @ SwarmSession {..} = {-# SCC available #-} do
@@ -646,16 +641,16 @@ Broadcasting: Have, Cancel, Bitfield, SuggestPiece
646> atomically $ do 641> atomically $ do
647> modifyTVar' clientBitfield (BF.union bf) 642> modifyTVar' clientBitfield (BF.union bf)
648> modifyTVar' (currentProgress clientSession) (downloadedProgress bytes) 643> modifyTVar' (currentProgress clientSession) (downloadedProgress bytes)
649 644>
650> broadcast = mapM_ (writeTChan broadcastMessages . Have) (BF.toList bf) 645> broadcast = mapM_ (writeTChan broadcastMessages . Have) (BF.toList bf)
651 646
652 647
653> -- TODO compute size of messages: if it's faster to send Bitfield 648TODO compute size of messages: if it's faster to send Bitfield
654> -- instead many Have do that 649instead many Have do that
655> -- 650
656> -- also if there is single Have message in queue then the 651also if there is single Have message in queue then the
657> -- corresponding piece is likely still in memory or disc cache, 652corresponding piece is likely still in memory or disc cache,
658> -- when we can send SuggestPiece 653when we can send SuggestPiece
659 654
660> -- | Get pending messages queue appeared in result of asynchronously 655> -- | Get pending messages queue appeared in result of asynchronously
661> -- changed client state. Resulting queue should be sent to a peer 656> -- changed client state. Resulting queue should be sent to a peer