network-control-0.0.2/0000755000000000000000000000000007346545000013051 5ustar0000000000000000network-control-0.0.2/Changelog.md0000644000000000000000000000020407346545000015256 0ustar0000000000000000# Revision history for network-control ## 0.0.2 * Adding constants. ## 0.0.1 * Supporting GHC 8.10. ## 0.0.0 * First version. network-control-0.0.2/LICENSE0000644000000000000000000000276507346545000014070 0ustar0000000000000000Copyright (c) 2023, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. network-control-0.0.2/Network/0000755000000000000000000000000007346545000014502 5ustar0000000000000000network-control-0.0.2/Network/Control.hs0000644000000000000000000000042107346545000016453 0ustar0000000000000000-- | Common parts to control network protocols. module Network.Control ( module Network.Control.Flow, module Network.Control.LRUCache, module Network.Control.Rate, ) where import Network.Control.Flow import Network.Control.LRUCache import Network.Control.Rate network-control-0.0.2/Network/Control/0000755000000000000000000000000007346545000016122 5ustar0000000000000000network-control-0.0.2/Network/Control/Flow.hs0000644000000000000000000000574507346545000017400 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Network.Control.Flow ( -- * Constants for flow control. defaultMaxStreams, defaultMaxStreamData, defaultMaxData, -- * Flow control for sending TxFlow (..), newTxFlow, txWindowSize, WindowSize, -- * Flow control for receiving RxFlow (..), newRxFlow, FlowControlType (..), maybeOpenRxWindow, checkRxLimit, ) where import Data.Bits -- | Default max streams. (64) defaultMaxStreams :: Int defaultMaxStreams = 64 -- | Default max data of a stream. (256K bytes) defaultMaxStreamData :: Int defaultMaxStreamData = 262144 -- | Default max data of a connection. (1M bytes) defaultMaxData :: Int defaultMaxData = 1048576 -- | Window size. type WindowSize = Int -- | Flow for sending data TxFlow = TxFlow { txfSent :: Int , txfLimit :: Int } deriving (Show) -- | Creating TX flow with an initial window size. newTxFlow :: WindowSize -> TxFlow newTxFlow win = TxFlow 0 win -- | 'txfLimit' - 'txfSent'. txWindowSize :: TxFlow -> WindowSize txWindowSize TxFlow{..} = txfLimit - txfSent -- | Flow for receiving data RxFlow = RxFlow { rxfWindow :: WindowSize , rxfConsumed :: Int , rxfReceived :: Int , rxfLimit :: Int } deriving (Show) -- | Creating RX flow with an initial window size. newRxFlow :: WindowSize -> RxFlow newRxFlow win = RxFlow win 0 0 win -- | The representation of window size update. data FlowControlType = -- | HTTP\/2 style FCTWindowUpdate | -- | 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. -- the representation of window size update is returned. maybeOpenRxWindow :: Int -- ^ The consumed size. -> FlowControlType -> RxFlow -> (RxFlow, Maybe Int) -- ^ 'Just' if the size should be informed to the peer. maybeOpenRxWindow consumed fct flow@RxFlow{..} | available < threshold = let limit = consumed' + rxfWindow flow' = flow { rxfConsumed = consumed' , rxfLimit = limit } update = case fct of FCTWindowUpdate -> limit - rxfLimit FCTMaxData -> limit in (flow', Just update) | otherwise = let flow' = flow{rxfConsumed = consumed'} in (flow', Nothing) where available = rxfLimit - rxfReceived threshold = rxfWindow `unsafeShiftR` 1 consumed' = rxfConsumed + consumed -- | Checking if received data is acceptable against the -- current window. checkRxLimit :: Int -- ^ The size of received data. -> RxFlow -> (RxFlow, Bool) -- ^ Acceptable if 'True'. checkRxLimit received flow@RxFlow{..} | received' <= rxfLimit = let flow' = flow{rxfReceived = received'} in (flow', True) | otherwise = (flow, False) where received' = rxfReceived + received network-control-0.0.2/Network/Control/LRUCache.hs0000644000000000000000000000234607346545000020051 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Network.Control.LRUCache ( -- * LRU cache LRUCache, empty, insert, delete, lookup, ) where import Prelude hiding (lookup) import Data.OrdPSQ (OrdPSQ) import qualified Data.OrdPSQ as PSQ type Priority = Int -- | Sized cache based on least recently used. data LRUCache k v = LRUCache { lcLimit :: Int , lcSize :: Int , lcTick :: Priority , lcQueue :: OrdPSQ k Priority v } -- | Empty 'LRUCache'. empty :: Int -- ^ The size of 'LRUCache'. -> LRUCache k v empty lim = LRUCache lim 0 0 PSQ.empty -- | Inserting. insert :: Ord k => k -> v -> LRUCache k v -> LRUCache k v insert k v c@LRUCache{..} | lcSize == lcLimit = let q = PSQ.insert k lcTick v $ PSQ.deleteMin lcQueue in c{lcTick = lcTick + 1, lcQueue = q} | otherwise = let q = PSQ.insert k lcTick v lcQueue in c{lcTick = lcTick + 1, lcQueue = q, lcSize = lcSize + 1} -- | Deleting. delete :: Ord k => k -> LRUCache k v -> LRUCache k v delete k c@LRUCache{..} = let q = PSQ.delete k lcQueue in c{lcQueue = q, lcSize = lcSize - 1} -- | Looking up. lookup :: Ord k => k -> LRUCache k v -> Maybe v lookup k LRUCache{..} = snd <$> PSQ.lookup k lcQueue network-control-0.0.2/Network/Control/Rate.hs0000644000000000000000000000231007346545000017345 0ustar0000000000000000module Network.Control.Rate ( -- * Rate control Rate, newRate, getRate, addRate, ) where import Data.IORef import Data.UnixTime -- | Type for rating. newtype Rate = Rate (IORef Counter) data Counter = Counter Int UnixTime -- | Creating a new 'Rate'. newRate :: IO Rate newRate = do cntr <- Counter 0 <$> getUnixTime Rate <$> newIORef cntr -- | Getting the current rate. -- If one or more seconds have passed since the previous call, the -- counter is re-initialized with 1 and it is returned. Otherwise, -- incremented counter number is returned. getRate :: Rate -> IO Int getRate r = addRate r 1 -- | Getting the current rate. -- If one or more seconds have passed since the previous call, the -- counter is re-initialized with the second argument and it is -- returned. Otherwise, increased counter number is returned. addRate :: Rate -> Int -> IO Int addRate (Rate ref) x = do Counter n beg <- readIORef ref cur <- getUnixTime if (cur `diffUnixTime` beg) > 1 then do let n' = x writeIORef ref $ Counter n' cur return n' else do let n' = n + x writeIORef ref $ Counter n' beg return n' network-control-0.0.2/network-control.cabal0000644000000000000000000000134107346545000017203 0ustar0000000000000000cabal-version: 3.0 name: network-control version: 0.0.2 license: BSD-3-Clause license-file: LICENSE maintainer: kazu@iij.ad.jp author: Kazu Yamamoto synopsis: Library to control network protocols description: Common parts to control network protocols category: Network build-type: Simple extra-doc-files: Changelog.md library exposed-modules: Network.Control other-modules: Network.Control.Flow Network.Control.LRUCache Network.Control.Rate default-language: Haskell2010 default-extensions: Strict StrictData ghc-options: -Wall build-depends: base >=4.14 && <5, psqueues, unix-time