module Network.QUIC.Recovery.Constants where

import Network.QUIC.Connector
import Network.QUIC.Imports
import Network.QUIC.Recovery.Types
import Network.QUIC.Types

timerGranularity :: Microseconds
timerGranularity :: Microseconds
timerGranularity = Int -> Microseconds
Microseconds Int
10000

-- | Maximum reordering in packets before packet threshold loss
--   detection considers a packet lost.
kPacketThreshold :: PacketNumber
kPacketThreshold :: Int
kPacketThreshold = Int
3

-- | Maximum reordering in time before time threshold loss detection
--   considers a packet lost.  Specified as an RTT multiplier.
kTimeThreshold :: Microseconds -> Microseconds
kTimeThreshold :: Microseconds -> Microseconds
kTimeThreshold Microseconds
x = Microseconds
x Microseconds -> Microseconds -> Microseconds
forall a. Num a => a -> a -> a
+ (Microseconds
x Microseconds -> Int -> Microseconds
forall a. Bits a => a -> Int -> a
!>>. Int
3) -- 9/8

-- | Timer granularity.
kGranularity :: Microseconds
-- kGranularity = Microseconds 5000
kGranularity :: Microseconds
kGranularity = Microseconds
timerGranularity Microseconds -> Microseconds -> Microseconds
forall a. Num a => a -> a -> a
* Microseconds
2

-- | Default limit on the initial bytes in flight.
kInitialWindow :: Int -> Int
-- kInitialWindow pktSiz = min 14720 (10 * pktSiz)
kInitialWindow :: Int -> Int
kInitialWindow Int
pktSiz = Int
pktSiz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
!<<. Int
2 --  !<<. 1 is not good enough

-- | Minimum congestion window in bytes.
kMinimumWindow :: LDCC -> IO Int
kMinimumWindow :: LDCC -> IO Int
kMinimumWindow LDCC
ldcc = do
    Int
siz <- LDCC -> IO Int
forall a. Connector a => a -> IO Int
getMaxPacketSize LDCC
ldcc
    Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
siz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
!<<. Int
2) -- !<<. 1 is not good enough

-- | Reduction in congestion window when a new loss event is detected.
kLossReductionFactor :: Int -> Int
kLossReductionFactor :: Int -> Int
kLossReductionFactor = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
!>>. Int
1) -- 0.5

-- | Period of time for persistent congestion to be established,
-- specified as a PTO multiplier.
kPersistentCongestionThreshold :: Microseconds -> Microseconds
kPersistentCongestionThreshold :: Microseconds -> Microseconds
kPersistentCongestionThreshold (Microseconds Int
us) = Int -> Microseconds
Microseconds (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
us)