Flow.hs

{-# LANGUAGE RecordWildCards #-}

module Network.Control.Flow (
    -- * Flow control for sending
    TxFlow (..),
    newTxFlow,
    txWindowSize,
    WindowSize,

    -- * Flow control for receiving
    RxFlow (..),
    newRxFlow,
    FlowControlType (..),
    maybeOpenRxWindow,
    checkRxLimit,
) where

import Data.Bits

-- | 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