{-# LANGUAGE RecordWildCards #-}

module Network.Control.Flow (
    -- * 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
    TxFlow (..),
    newTxFlow,
    txWindowSize,
    WindowSize,

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

import Data.Bits

-- | Default max streams. (64)
defaultMaxStreams :: Int
defaultMaxStreams :: Int
defaultMaxStreams = Int
64

-- | Default max data of a stream. (256K bytes)
defaultMaxStreamData :: Int
defaultMaxStreamData :: Int
defaultMaxStreamData = Int
262144

-- | Default max data of a connection. (1M bytes)
defaultMaxData :: Int
defaultMaxData :: Int
defaultMaxData = Int
1048576

-- | Window size.
type WindowSize = Int

-- | Flow for sending
--
-- @
-- -------------------------------------->
--        ^           ^
--     txfSent    txfLimit
--
--        |-----------| The size which this node can send
--        txWindowSize
-- @
data TxFlow = TxFlow
    { TxFlow -> Int
txfSent :: Int
    -- ^ The total size of sent data.
    , TxFlow -> Int
txfLimit :: Int
    -- ^ The total size of data which can be sent.
    }
    deriving (TxFlow -> TxFlow -> Bool
(TxFlow -> TxFlow -> Bool)
-> (TxFlow -> TxFlow -> Bool) -> Eq TxFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxFlow -> TxFlow -> Bool
== :: TxFlow -> TxFlow -> Bool
$c/= :: TxFlow -> TxFlow -> Bool
/= :: TxFlow -> TxFlow -> Bool
Eq, Int -> TxFlow -> ShowS
[TxFlow] -> ShowS
TxFlow -> String
(Int -> TxFlow -> ShowS)
-> (TxFlow -> String) -> ([TxFlow] -> ShowS) -> Show TxFlow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxFlow -> ShowS
showsPrec :: Int -> TxFlow -> ShowS
$cshow :: TxFlow -> String
show :: TxFlow -> String
$cshowList :: [TxFlow] -> ShowS
showList :: [TxFlow] -> ShowS
Show)

-- | Creating TX flow with a receive buffer size.
newTxFlow :: WindowSize -> TxFlow
newTxFlow :: Int -> TxFlow
newTxFlow Int
win = Int -> Int -> TxFlow
TxFlow Int
0 Int
win

-- | 'txfLimit' - 'txfSent'.
txWindowSize :: TxFlow -> WindowSize
txWindowSize :: TxFlow -> Int
txWindowSize TxFlow{Int
txfSent :: TxFlow -> Int
txfLimit :: TxFlow -> Int
txfSent :: Int
txfLimit :: Int
..} = Int
txfLimit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
txfSent

-- | Flow for receiving.
--
-- @
--                 rxfBufSize
--        |------------------------|
-- -------------------------------------->
--        ^            ^           ^
--   rxfConsumed   rxfReceived  rxfLimit
--
--                     |-----------| The size which the peer can send
--                        Window
-- @
data RxFlow = RxFlow
    { RxFlow -> Int
rxfBufSize :: Int
    -- ^ Receive buffer size.
    , RxFlow -> Int
rxfConsumed :: Int
    -- ^ The total size which the application is consumed.
    , RxFlow -> Int
rxfReceived :: Int
    -- ^ The total already-received size.
    , RxFlow -> Int
rxfLimit :: Int
    -- ^ The total size which can be recived.
    }
    deriving (RxFlow -> RxFlow -> Bool
(RxFlow -> RxFlow -> Bool)
-> (RxFlow -> RxFlow -> Bool) -> Eq RxFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RxFlow -> RxFlow -> Bool
== :: RxFlow -> RxFlow -> Bool
$c/= :: RxFlow -> RxFlow -> Bool
/= :: RxFlow -> RxFlow -> Bool
Eq, Int -> RxFlow -> ShowS
[RxFlow] -> ShowS
RxFlow -> String
(Int -> RxFlow -> ShowS)
-> (RxFlow -> String) -> ([RxFlow] -> ShowS) -> Show RxFlow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RxFlow -> ShowS
showsPrec :: Int -> RxFlow -> ShowS
$cshow :: RxFlow -> String
show :: RxFlow -> String
$cshowList :: [RxFlow] -> ShowS
showList :: [RxFlow] -> ShowS
Show)

-- | Creating RX flow with an initial window size.
newRxFlow :: WindowSize -> RxFlow
newRxFlow :: Int -> RxFlow
newRxFlow Int
win = Int -> Int -> Int -> Int -> RxFlow
RxFlow Int
win Int
0 Int
0 Int
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 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.
    -> FlowControlType
    -> RxFlow
    -> (RxFlow, Maybe Int)
    -- ^ 'Just' if the size should be informed to the peer.
maybeOpenRxWindow :: Int -> FlowControlType -> RxFlow -> (RxFlow, Maybe Int)
maybeOpenRxWindow Int
consumed FlowControlType
fct flow :: RxFlow
flow@RxFlow{Int
rxfBufSize :: RxFlow -> Int
rxfConsumed :: RxFlow -> Int
rxfReceived :: RxFlow -> Int
rxfLimit :: RxFlow -> Int
rxfBufSize :: Int
rxfConsumed :: Int
rxfReceived :: Int
rxfLimit :: Int
..}
    | Int
available Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
threshold =
        let rxfLimit' :: Int
rxfLimit' = Int
consumed' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rxfBufSize
            flow' :: RxFlow
flow' =
                RxFlow
flow
                    { rxfConsumed = consumed'
                    , rxfLimit = rxfLimit'
                    }
            update :: Int
update = case FlowControlType
fct of
                FlowControlType
FCTWindowUpdate -> Int
rxfLimit' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rxfLimit
                FlowControlType
FCTMaxData -> Int
rxfLimit'
         in (RxFlow
flow', Int -> Maybe Int
forall a. a -> Maybe a
Just Int
update)
    | Bool
otherwise =
        let flow' :: RxFlow
flow' = RxFlow
flow{rxfConsumed = consumed'}
         in (RxFlow
flow', Maybe Int
forall a. Maybe a
Nothing)
  where
    available :: Int
available = Int
rxfLimit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rxfReceived
    threshold :: Int
threshold = Int
rxfBufSize Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
    consumed' :: Int
consumed' = Int
rxfConsumed Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Int -> RxFlow -> (RxFlow, Bool)
checkRxLimit Int
received flow :: RxFlow
flow@RxFlow{Int
rxfBufSize :: RxFlow -> Int
rxfConsumed :: RxFlow -> Int
rxfReceived :: RxFlow -> Int
rxfLimit :: RxFlow -> Int
rxfBufSize :: Int
rxfConsumed :: Int
rxfReceived :: Int
rxfLimit :: Int
..}
    | Int
received' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rxfLimit =
        let flow' :: RxFlow
flow' = RxFlow
flow{rxfReceived = received'}
         in (RxFlow
flow', Bool
True)
    | Bool
otherwise = (RxFlow
flow, Bool
False)
  where
    received' :: Int
received' = Int
rxfReceived Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
received