network-control 0.0.2 → 0.1.0
raw patch · 6 files changed
+242/−17 lines, 6 filesdep +QuickCheckdep +hspecdep +network-controldep ~base
Dependencies added: QuickCheck, hspec, network-control, pretty-simple, text
Dependency ranges changed: base
Files
- Changelog.md +5/−0
- Network/Control.hs +1/−0
- Network/Control/Flow.hs +80/−16
- network-control.cabal +20/−1
- test/Network/Control/FlowSpec.hs +135/−0
- test/Spec.hs +1/−0
Changelog.md view
@@ -1,5 +1,10 @@ # Revision history for network-control +## 0.1.0++* Breaking change: Renaming rxfWindow to rxfBufSize.+* Updating the document about flow control.+ ## 0.0.2 * Adding constants.
Network/Control.hs view
@@ -1,4 +1,5 @@ -- | Common parts to control network protocols.+-- This library assumes that 'Int' is 64bit. module Network.Control ( module Network.Control.Flow, module Network.Control.LRUCache,
Network/Control/Flow.hs view
@@ -1,18 +1,24 @@ {-# LANGUAGE RecordWildCards #-} module Network.Control.Flow (- -- * Constants for flow control.+ -- * Flow control++ -- | This is based on the total approach of QUIC rather than+ -- the difference approach of HTTP\/2 because QUIC'one is+ -- considered safer. Please refer to [Using HTTP\/3 Stream Limits in HTTP\/2](https://datatracker.ietf.org/doc/draft-thomson-httpbis-h2-stream-limits/) to understand that QUIC's approaches are better though its topic is about stream concurrency.++ -- ** Constants for flow control. defaultMaxStreams, defaultMaxStreamData, defaultMaxData, - -- * Flow control for sending+ -- ** Flow control for sending TxFlow (..), newTxFlow, txWindowSize, WindowSize, - -- * Flow control for receiving+ -- ** Flow control for receiving RxFlow (..), newRxFlow, FlowControlType (..),@@ -38,13 +44,24 @@ type WindowSize = Int -- | Flow for sending+--+-- @+-- -------------------------------------->+-- ^ ^+-- txfSent txfLimit+--+-- |-----------| The size which this node can send+-- txWindowSize+-- @ data TxFlow = TxFlow { txfSent :: Int+ -- ^ The total size of sent data. , txfLimit :: Int+ -- ^ The total size of data which can be sent. }- deriving (Show)+ deriving (Eq, Show) --- | Creating TX flow with an initial window size.+-- | Creating TX flow with a receive buffer size. newTxFlow :: WindowSize -> TxFlow newTxFlow win = TxFlow 0 win @@ -52,14 +69,29 @@ txWindowSize :: TxFlow -> WindowSize txWindowSize TxFlow{..} = txfLimit - txfSent --- | Flow for receiving+-- | Flow for receiving.+--+-- @+-- rxfBufSize+-- |------------------------|+-- -------------------------------------->+-- ^ ^ ^+-- rxfConsumed rxfReceived rxfLimit+--+-- |-----------| The size which the peer can send+-- Window+-- @ data RxFlow = RxFlow- { rxfWindow :: WindowSize+ { rxfBufSize :: Int+ -- ^ Receive buffer size. , rxfConsumed :: Int+ -- ^ The total size which the application is consumed. , rxfReceived :: Int+ -- ^ The total already-received size. , rxfLimit :: Int+ -- ^ The total size which can be recived. }- deriving (Show)+ deriving (Eq, Show) -- | Creating RX flow with an initial window size. newRxFlow :: WindowSize -> RxFlow@@ -72,10 +104,42 @@ | -- | QUIC style FCTMaxData --- | When an application consumed received data,--- this function should be called to update 'rxfConsumed'.--- If the window size is less than the half of the initial window.+-- | When an application consumed received data, this function should+-- be called to update 'rxfConsumed'. If the available buffer size+-- is less than the half of the total buffer size. -- the representation of window size update is returned.+--+-- @+-- Example:+--+-- rxfBufSize+-- |------------------------|+-- -------------------------------------->+-- ^ ^ ^+-- rxfConsumed rxfReceived rxfLimit+-- |01234567890|+--+-- In the case where the window update should be informed to the peer,+-- 'rxfConsumed' and 'rxfLimit' move to the right. The difference+-- of old and new 'rxfLimit' is window update.+--+-- rxfBufSize+-- |------------------------|+-- -------------------------------------->+-- ^ ^ ^+-- rxfConsumed rxfReceived rxfLimit+-- |0123456789012| : window glows+--+-- Otherwise, only 'rxfConsumed' moves to the right.+--+-- rxfBufSize+-- |------------------------|+-- -------------------------------------->+-- ^ ^ ^+-- rxfConsumed rxfReceived rxfLimit+-- |01234567890| : window stays+--+-- @ maybeOpenRxWindow :: Int -- ^ The consumed size.@@ -85,22 +149,22 @@ -- ^ 'Just' if the size should be informed to the peer. maybeOpenRxWindow consumed fct flow@RxFlow{..} | available < threshold =- let limit = consumed' + rxfWindow+ let rxfLimit' = consumed' + rxfBufSize flow' = flow { rxfConsumed = consumed'- , rxfLimit = limit+ , rxfLimit = rxfLimit' } update = case fct of- FCTWindowUpdate -> limit - rxfLimit- FCTMaxData -> limit+ FCTWindowUpdate -> rxfLimit' - rxfLimit+ FCTMaxData -> rxfLimit' in (flow', Just update) | otherwise = let flow' = flow{rxfConsumed = consumed'} in (flow', Nothing) where available = rxfLimit - rxfReceived- threshold = rxfWindow `unsafeShiftR` 1+ threshold = rxfBufSize `unsafeShiftR` 1 consumed' = rxfConsumed + consumed -- | Checking if received data is acceptable against the
network-control.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: network-control-version: 0.0.2+version: 0.1.0 license: BSD-3-Clause license-file: LICENSE maintainer: kazu@iij.ad.jp@@ -25,3 +25,22 @@ base >=4.14 && <5, psqueues, unix-time++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ build-tool-depends: hspec-discover:hspec-discover+ hs-source-dirs: test+ other-modules:+ Network.Control.FlowSpec++ default-language: Haskell2010+ default-extensions: Strict StrictData+ ghc-options: -Wall -threaded+ build-depends:+ base,+ hspec >=1.3,+ network-control,+ QuickCheck,+ pretty-simple,+ text
+ test/Network/Control/FlowSpec.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-orphans -Wno-incomplete-patterns #-}++module Network.Control.FlowSpec where++import Data.List+import Data.Text.Lazy (unpack)+import Network.Control+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import Text.Pretty.Simple++-- types++data Op = Consume | Receive+ deriving (Eq, Show, Bounded, Enum)++data OpWithResult = ConsumeWithResult (Maybe Int) | ReceiveWithResult Bool+ deriving (Eq, Show)++data Step op = Step {stepOp :: op, stepArg :: Int}+ deriving (Eq, Show)++data Trace = Trace+ { traceStart :: RxFlow+ , traceSteps :: [(Int, Step OpWithResult, RxFlow)]+ }+ deriving (Eq, Show)++-- arbitrary instances++maxWindowSize :: Int+maxWindowSize = 200 -- (more realistic: 2_000_000)++minFrameSize :: Int+minFrameSize = -20++instance Arbitrary RxFlow where+ arbitrary = newRxFlow <$> chooseInt (1, maxWindowSize)++instance Arbitrary Op where+ arbitrary = elements [minBound ..]++instance Arbitrary Trace where+ arbitrary = do+ initialFlow <- arbitrary+ len <- chooseInt (0, 500)+ Trace initialFlow <$> runManySteps len 0 initialFlow+ where+ runManySteps :: Int -> Int -> RxFlow -> Gen [(Int, Step OpWithResult, RxFlow)]+ runManySteps 0 _ _ = pure []+ runManySteps len ix oldFlow | len > 0 = do+ (newStep, newFlow) <- runStep oldFlow <$> genStep oldFlow+ ((ix, newStep, newFlow) :) <$> runManySteps (len - 1) (ix + 1) newFlow++ -- Not sure frame size > window size or 0 or engative consumed or received bytes are+ -- legal, but RxFlow works fine with them. :)+ genStep :: RxFlow -> Gen (Step Op)+ genStep oldFlow = oneof [mkConsume, mkReceive]+ where+ mkReceive =+ Step Receive <$> chooseInt (minFrameSize, rxfBufSize oldFlow * 2)++ mkConsume =+ let recv = rxfReceived oldFlow+ in if recv > 0+ then Step Consume <$> chooseInt (minFrameSize, rxfReceived oldFlow)+ else mkReceive++ runStep :: RxFlow -> Step Op -> (Step OpWithResult, RxFlow)+ runStep oldFlow = \case+ Step Consume arg ->+ let (newFlow, limitDelta) = maybeOpenRxWindow arg FCTWindowUpdate oldFlow+ in (Step (ConsumeWithResult limitDelta) arg, newFlow)+ Step Receive arg ->+ let (newFlow, isAcceptable) = checkRxLimit arg oldFlow+ in (Step (ReceiveWithResult isAcceptable) arg, newFlow)++ shrink trace@(Trace initialFlow steps) =+ trunc trace <> (Trace initialFlow <$> init (inits steps))+ where+ trunc :: Trace -> [Trace]+ trunc (Trace _ stp) = case reverse stp of+ [] -> []+ [_] -> []+ ((ix, lastStep, lastFlow) : (_, _, initFlow) : _) -> [Trace initFlow [(ix, lastStep, lastFlow)]]++-- invariants++assertTrace :: Trace -> Property+assertTrace (Trace initialFlow steps) = assertStep initialFlow steps++assertStep :: RxFlow -> [(Int, Step OpWithResult, RxFlow)] -> Property+assertStep _ [] = property True+assertStep oldFlow ((ix, step, newFlow) : steps) =+ (counterexample ("step #" <> show ix) check) .&. assertStep newFlow steps+ where+ check :: Expectation+ check = case step of+ Step (ConsumeWithResult limitDelta) arg -> do+ newFlow+ `shouldBe` RxFlow+ { rxfBufSize = rxfBufSize newFlow+ , rxfConsumed = rxfConsumed oldFlow + arg+ , rxfReceived = rxfReceived oldFlow+ , rxfLimit =+ if rxfLimit oldFlow - rxfReceived oldFlow < rxfBufSize oldFlow `div` 2+ then rxfConsumed oldFlow + arg + rxfBufSize oldFlow+ else rxfLimit oldFlow+ }+ limitDelta+ `shouldBe` case rxfLimit newFlow - rxfLimit oldFlow of+ 0 -> Nothing+ n -> Just n+ Step (ReceiveWithResult isAcceptable) arg -> do+ newFlow+ `shouldBe` if isAcceptable+ then+ RxFlow+ { rxfBufSize = rxfBufSize newFlow+ , rxfConsumed = rxfConsumed oldFlow+ , rxfReceived = rxfReceived oldFlow + arg+ , rxfLimit = rxfLimit oldFlow+ }+ else oldFlow++spec :: Spec+spec = do+ focus . prop "state transition graph checks out" $+ \trace -> counterexample (unpack $ pShowNoColor trace) (assertTrace trace)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}