Persistent.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.QUIC.Recovery.Persistent (
    getMaxAckDelay,
    calcPTO,
    backOff,
    inPersistentCongestion,
    findDuration, -- for testing
    getPTO,
) where

import Data.Sequence (Seq, ViewL (..))
import qualified Data.Sequence as Seq
import Data.UnixTime

import Network.QUIC.Imports
import Network.QUIC.Recovery.Constants
import Network.QUIC.Recovery.Misc
import Network.QUIC.Recovery.Types
import Network.QUIC.Types

getMaxAckDelay :: Maybe EncryptionLevel -> Microseconds -> Microseconds
getMaxAckDelay Nothing n = n
getMaxAckDelay (Just lvl) n
    | lvl `elem` [InitialLevel, HandshakeLevel] = 0
    | otherwise = n

-- Sec 6.2.1. Computing PTO
-- PTO = smoothed_rtt + max(4*rttvar, kGranularity) + max_ack_delay
calcPTO :: RTT -> Maybe EncryptionLevel -> Microseconds
calcPTO RTT{..} mlvl = smoothedRTT + max (rttvar !<<. 2) kGranularity + dly
  where
    dly = getMaxAckDelay mlvl maxAckDelay1RTT

backOff :: Microseconds -> Int -> Microseconds
backOff n cnt = n * (2 ^ cnt)

-- Sec 7.8. Persistent Congestion
inPersistentCongestion :: LDCC -> Seq SentPacket -> IO Bool
inPersistentCongestion ldcc@LDCC{..} lostPackets = do
    pn <- getPktNumPersistent ldcc
    let mduration = findDuration lostPackets pn
    case mduration of
        Nothing -> return False
        Just duration -> do
            rtt <- readIORef recoveryRTT
            let pto = calcPTO rtt Nothing
                Microseconds congestionPeriod = kPersistentCongestionThreshold pto
                threshold = microSecondsToUnixDiffTime congestionPeriod
            return (duration > threshold)

findDuration :: Seq SentPacket -> PacketNumber -> Maybe UnixDiffTime
findDuration pkts0 pn = leftEdge pkts0 Nothing
  where
    leftEdge pkts mdiff = case Seq.viewl pkts' of
        EmptyL -> mdiff
        l :< pkts'' -> case rightEdge (spPacketNumber l) pkts'' Nothing of
            (Nothing, pkts''') -> leftEdge pkts''' mdiff
            (Just r, pkts''') ->
                let diff' = spTimeSent r `diffUnixTime` spTimeSent l
                 in case mdiff of
                        Nothing -> leftEdge pkts''' $ Just diff'
                        Just diff
                            | diff' > diff -> leftEdge pkts''' $ Just diff'
                            | otherwise -> leftEdge pkts''' $ Just diff
      where
        (_, pkts') = Seq.breakl (\x -> spAckEliciting x && spPacketNumber x >= pn) pkts
    rightEdge n pkts Nothing = case Seq.viewl pkts of
        EmptyL -> (Nothing, Seq.empty)
        r :< pkts'
            | spPacketNumber r == n + 1 ->
                if spAckEliciting r
                    then rightEdge (n + 1) pkts' $ Just r
                    else rightEdge (n + 1) pkts' Nothing
            | otherwise -> (Nothing, pkts)
    rightEdge n pkts mr0 = case Seq.viewl pkts of
        EmptyL -> (mr0, Seq.empty)
        r :< pkts'
            | spPacketNumber r == n + 1 ->
                if spAckEliciting r
                    then rightEdge (n + 1) pkts' $ Just r
                    else rightEdge (n + 1) pkts' mr0
            | otherwise -> (mr0, pkts)

getPTO :: LDCC -> IO Microseconds
getPTO LDCC{..} = do
    rtt <- readIORef recoveryRTT
    return $ calcPTO rtt Nothing