diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2014-02-14 23:59:51 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2014-02-14 23:59:51 +0400 |
commit | daf978ddd1f0a07ce4711fa97f51d0ec02478f73 (patch) | |
tree | 73aed776a0db115bb8133f10f399bde8a16a3d16 /src/Network/BitTorrent/Exchange/Wire.hs | |
parent | 5f25d1759ef168917247bc0533ec7cc57dfdc5ac (diff) |
Allow to set default request queue length at runtime
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Wire.hs')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Wire.hs | 34 |
1 files changed, 15 insertions, 19 deletions
diff --git a/src/Network/BitTorrent/Exchange/Wire.hs b/src/Network/BitTorrent/Exchange/Wire.hs index e88b3ae5..4aebdd24 100644 --- a/src/Network/BitTorrent/Exchange/Wire.hs +++ b/src/Network/BitTorrent/Exchange/Wire.hs | |||
@@ -52,7 +52,7 @@ module Network.BitTorrent.Exchange.Wire | |||
52 | , recvMessage | 52 | , recvMessage |
53 | , sendMessage | 53 | , sendMessage |
54 | , filterQueue | 54 | , filterQueue |
55 | , getAdvertisedQueueLength | 55 | , getMaxQueueLength |
56 | 56 | ||
57 | -- * Query | 57 | -- * Query |
58 | , getMetadata | 58 | , getMetadata |
@@ -404,6 +404,8 @@ data Options = Options | |||
404 | -- send any message for this period of time. | 404 | -- send any message for this period of time. |
405 | , keepaliveTimeout :: {-# UNPACK #-} !Int | 405 | , keepaliveTimeout :: {-# UNPACK #-} !Int |
406 | 406 | ||
407 | , requestQueueLength :: {-# UNPACK #-} !Int | ||
408 | |||
407 | -- | Used to protect against flood attacks. | 409 | -- | Used to protect against flood attacks. |
408 | , floodDetector :: FloodDetector | 410 | , floodDetector :: FloodDetector |
409 | 411 | ||
@@ -434,11 +436,12 @@ data Options = Options | |||
434 | -- change them. | 436 | -- change them. |
435 | instance Default Options where | 437 | instance Default Options where |
436 | def = Options | 438 | def = Options |
437 | { keepaliveInterval = defaultKeepAliveInterval | 439 | { keepaliveInterval = defaultKeepAliveInterval |
438 | , keepaliveTimeout = defaultKeepAliveTimeout | 440 | , keepaliveTimeout = defaultKeepAliveTimeout |
439 | , floodDetector = def | 441 | , requestQueueLength = defaultRequestQueueLength |
440 | , metadataFactor = defaultMetadataFactor | 442 | , floodDetector = def |
441 | , maxInfoDictSize = defaultMaxInfoDictSize | 443 | , metadataFactor = defaultMetadataFactor |
444 | , maxInfoDictSize = defaultMaxInfoDictSize | ||
442 | } | 445 | } |
443 | 446 | ||
444 | {----------------------------------------------------------------------- | 447 | {----------------------------------------------------------------------- |
@@ -591,19 +594,6 @@ instance MonadState ConnectionState (Connected s) where | |||
591 | type Wire s a = ConduitM Message Message (Connected s) a | 594 | type Wire s a = ConduitM Message Message (Connected s) a |
592 | 595 | ||
593 | {----------------------------------------------------------------------- | 596 | {----------------------------------------------------------------------- |
594 | -- Query | ||
595 | -----------------------------------------------------------------------} | ||
596 | |||
597 | -- TODO configurable | ||
598 | defQueueLength :: Int | ||
599 | defQueueLength = 1 | ||
600 | |||
601 | getAdvertisedQueueLength :: Connected s Int | ||
602 | getAdvertisedQueueLength = do | ||
603 | ExtendedHandshake {..} <- use connRemoteEhs | ||
604 | return $ fromMaybe defQueueLength ehsQueueLength | ||
605 | |||
606 | {----------------------------------------------------------------------- | ||
607 | -- Wrapper | 597 | -- Wrapper |
608 | -----------------------------------------------------------------------} | 598 | -----------------------------------------------------------------------} |
609 | 599 | ||
@@ -661,6 +651,12 @@ sendMessage msg = do | |||
661 | ecaps <- use connExtCaps | 651 | ecaps <- use connExtCaps |
662 | yield $ envelop ecaps msg | 652 | yield $ envelop ecaps msg |
663 | 653 | ||
654 | getMaxQueueLength :: Connected s Int | ||
655 | getMaxQueueLength = do | ||
656 | advertisedLen <- ehsQueueLength <$> use connRemoteEhs | ||
657 | defaultLen <- asks (requestQueueLength . connOptions) | ||
658 | return $ fromMaybe defaultLen advertisedLen | ||
659 | |||
664 | -- | Filter pending messages from send buffer. | 660 | -- | Filter pending messages from send buffer. |
665 | filterQueue :: (Message -> Bool) -> Wire s () | 661 | filterQueue :: (Message -> Bool) -> Wire s () |
666 | filterQueue p = lift $ do | 662 | filterQueue p = lift $ do |