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

module Network.QUIC.Recovery.Timer (
    getLossTimeAndSpace
  , getPtoTimeAndSpace
  , setLossDetectionTimer
  , beforeAntiAmp
  , ldccTimer
  ) where

import Control.Concurrent.STM
import qualified Data.Sequence as Seq
import GHC.Event hiding (new)

import Network.QUIC.Connector
import Network.QUIC.Imports
import Network.QUIC.Qlog
import Network.QUIC.Recovery.Detect
import Network.QUIC.Recovery.Metrics
import Network.QUIC.Recovery.Misc
import Network.QUIC.Recovery.Persistent
import Network.QUIC.Recovery.Release
import Network.QUIC.Recovery.Types
import Network.QUIC.Recovery.Utils
import Network.QUIC.Recovery.Constants
import Network.QUIC.Types

----------------------------------------------------------------

noInFlightPacket :: LDCC -> EncryptionLevel -> IO Bool
noInFlightPacket :: LDCC -> EncryptionLevel -> IO Bool
noInFlightPacket LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
..} EncryptionLevel
lvl = do
    SentPackets Seq SentPacket
db <- IORef SentPackets -> IO SentPackets
forall a. IORef a -> IO a
readIORef (Array EncryptionLevel (IORef SentPackets)
sentPackets Array EncryptionLevel (IORef SentPackets)
-> EncryptionLevel -> IORef SentPackets
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl)
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Seq SentPacket -> Bool
forall a. Seq a -> Bool
Seq.null Seq SentPacket
db

getLossTimeAndSpace :: LDCC -> IO (Maybe (TimeMicrosecond,EncryptionLevel))
getLossTimeAndSpace :: LDCC -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
getLossTimeAndSpace LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
..} =
    [EncryptionLevel]
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop [EncryptionLevel
InitialLevel, EncryptionLevel
HandshakeLevel, EncryptionLevel
RTT1Level] Maybe (TimeMicrosecond, EncryptionLevel)
forall a. Maybe a
Nothing
  where
    loop :: [EncryptionLevel]
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop []     Maybe (TimeMicrosecond, EncryptionLevel)
r = Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TimeMicrosecond, EncryptionLevel)
r
    loop (EncryptionLevel
l:[EncryptionLevel]
ls) Maybe (TimeMicrosecond, EncryptionLevel)
r = do
        Maybe TimeMicrosecond
mt <- LossDetection -> Maybe TimeMicrosecond
lossTime (LossDetection -> Maybe TimeMicrosecond)
-> IO LossDetection -> IO (Maybe TimeMicrosecond)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef LossDetection -> IO LossDetection
forall a. IORef a -> IO a
readIORef (Array EncryptionLevel (IORef LossDetection)
lossDetection Array EncryptionLevel (IORef LossDetection)
-> EncryptionLevel -> IORef LossDetection
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
l)
        case Maybe TimeMicrosecond
mt of
          Maybe TimeMicrosecond
Nothing -> [EncryptionLevel]
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop [EncryptionLevel]
ls Maybe (TimeMicrosecond, EncryptionLevel)
r
          Just TimeMicrosecond
t  -> case Maybe (TimeMicrosecond, EncryptionLevel)
r of
            Maybe (TimeMicrosecond, EncryptionLevel)
Nothing -> [EncryptionLevel]
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop [EncryptionLevel]
ls (Maybe (TimeMicrosecond, EncryptionLevel)
 -> IO (Maybe (TimeMicrosecond, EncryptionLevel)))
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
forall a b. (a -> b) -> a -> b
$ (TimeMicrosecond, EncryptionLevel)
-> Maybe (TimeMicrosecond, EncryptionLevel)
forall a. a -> Maybe a
Just (TimeMicrosecond
t,EncryptionLevel
l)
            Just (TimeMicrosecond
t0,EncryptionLevel
_)
               | TimeMicrosecond
t TimeMicrosecond -> TimeMicrosecond -> Bool
forall a. Ord a => a -> a -> Bool
< TimeMicrosecond
t0    -> [EncryptionLevel]
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop [EncryptionLevel]
ls (Maybe (TimeMicrosecond, EncryptionLevel)
 -> IO (Maybe (TimeMicrosecond, EncryptionLevel)))
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
forall a b. (a -> b) -> a -> b
$ (TimeMicrosecond, EncryptionLevel)
-> Maybe (TimeMicrosecond, EncryptionLevel)
forall a. a -> Maybe a
Just (TimeMicrosecond
t,EncryptionLevel
l)
               | Bool
otherwise -> [EncryptionLevel]
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop [EncryptionLevel]
ls Maybe (TimeMicrosecond, EncryptionLevel)
r

----------------------------------------------------------------

getPtoTimeAndSpace :: LDCC -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
getPtoTimeAndSpace :: LDCC -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
getPtoTimeAndSpace ldcc :: LDCC
ldcc@LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
..} = do
    -- Arm PTO from now when there are no inflight packets.
    CC{PacketNumber
Maybe TimeMicrosecond
CCMode
ccMode :: CC -> CCMode
numOfAckEliciting :: CC -> PacketNumber
bytesAcked :: CC -> PacketNumber
ssthresh :: CC -> PacketNumber
congestionRecoveryStartTime :: CC -> Maybe TimeMicrosecond
congestionWindow :: CC -> PacketNumber
bytesInFlight :: CC -> PacketNumber
ccMode :: CCMode
numOfAckEliciting :: PacketNumber
bytesAcked :: PacketNumber
ssthresh :: PacketNumber
congestionRecoveryStartTime :: Maybe TimeMicrosecond
congestionWindow :: PacketNumber
bytesInFlight :: PacketNumber
..} <- TVar CC -> IO CC
forall a. TVar a -> IO a
readTVarIO TVar CC
recoveryCC
    if PacketNumber
bytesInFlight PacketNumber -> PacketNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= PacketNumber
0 then do
        Bool
validated <- LDCC -> IO Bool
peerCompletedAddressValidation LDCC
ldcc
        if Bool
validated then do
            LDCC -> Debug -> IO ()
forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug LDCC
ldcc (Debug -> IO ()) -> Debug -> IO ()
forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"getPtoTimeAndSpace: validated"
            Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TimeMicrosecond, EncryptionLevel)
forall a. Maybe a
Nothing
          else do
            RTT
rtt <- IORef RTT -> IO RTT
forall a. IORef a -> IO a
readIORef IORef RTT
recoveryRTT
            EncryptionLevel
lvl <- LDCC -> IO EncryptionLevel
forall a. Connector a => a -> IO EncryptionLevel
getEncryptionLevel LDCC
ldcc
            let pto :: Microseconds
pto = Microseconds -> PacketNumber -> Microseconds
backOff (RTT -> Maybe EncryptionLevel -> Microseconds
calcPTO RTT
rtt (Maybe EncryptionLevel -> Microseconds)
-> Maybe EncryptionLevel -> Microseconds
forall a b. (a -> b) -> a -> b
$ EncryptionLevel -> Maybe EncryptionLevel
forall a. a -> Maybe a
Just EncryptionLevel
lvl) (RTT -> PacketNumber
ptoCount RTT
rtt)
            TimeMicrosecond
ptoTime <- Microseconds -> IO TimeMicrosecond
getFutureTimeMicrosecond Microseconds
pto
            Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TimeMicrosecond, EncryptionLevel)
 -> IO (Maybe (TimeMicrosecond, EncryptionLevel)))
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
forall a b. (a -> b) -> a -> b
$ (TimeMicrosecond, EncryptionLevel)
-> Maybe (TimeMicrosecond, EncryptionLevel)
forall a. a -> Maybe a
Just (TimeMicrosecond
ptoTime, EncryptionLevel
lvl)
      else do
        Bool
completed <- LDCC -> IO Bool
forall a. Connector a => a -> IO Bool
isConnectionEstablished LDCC
ldcc
        let lvls :: [EncryptionLevel]
lvls | Bool
completed = [EncryptionLevel
InitialLevel, EncryptionLevel
HandshakeLevel, EncryptionLevel
RTT1Level]
                 | Bool
otherwise = [EncryptionLevel
InitialLevel, EncryptionLevel
HandshakeLevel]
        [EncryptionLevel] -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop [EncryptionLevel]
lvls
  where
    loop :: [EncryptionLevel] -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
    loop :: [EncryptionLevel] -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop [] = Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TimeMicrosecond, EncryptionLevel)
forall a. Maybe a
Nothing
    loop (EncryptionLevel
l:[EncryptionLevel]
ls) = do
        Bool
notInFlight <- LDCC -> EncryptionLevel -> IO Bool
noInFlightPacket LDCC
ldcc EncryptionLevel
l
        if Bool
notInFlight then
            [EncryptionLevel] -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop [EncryptionLevel]
ls
          else do
            LossDetection{PacketNumber
Maybe TimeMicrosecond
TimeMicrosecond
AckInfo
timeOfLastAckElicitingPacket :: LossDetection -> TimeMicrosecond
previousAckInfo :: LossDetection -> AckInfo
largestAckedPacket :: LossDetection -> PacketNumber
lossTime :: Maybe TimeMicrosecond
timeOfLastAckElicitingPacket :: TimeMicrosecond
previousAckInfo :: AckInfo
largestAckedPacket :: PacketNumber
lossTime :: LossDetection -> Maybe TimeMicrosecond
..} <- IORef LossDetection -> IO LossDetection
forall a. IORef a -> IO a
readIORef (Array EncryptionLevel (IORef LossDetection)
lossDetection Array EncryptionLevel (IORef LossDetection)
-> EncryptionLevel -> IORef LossDetection
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
l)
            if TimeMicrosecond
timeOfLastAckElicitingPacket TimeMicrosecond -> TimeMicrosecond -> Bool
forall a. Eq a => a -> a -> Bool
== TimeMicrosecond
timeMicrosecond0 then
                [EncryptionLevel] -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
loop [EncryptionLevel]
ls
              else do
                  RTT
rtt <- IORef RTT -> IO RTT
forall a. IORef a -> IO a
readIORef IORef RTT
recoveryRTT
                  let pto0 :: Microseconds
pto0 = Microseconds -> PacketNumber -> Microseconds
backOff (RTT -> Maybe EncryptionLevel -> Microseconds
calcPTO RTT
rtt (Maybe EncryptionLevel -> Microseconds)
-> Maybe EncryptionLevel -> Microseconds
forall a b. (a -> b) -> a -> b
$ EncryptionLevel -> Maybe EncryptionLevel
forall a. a -> Maybe a
Just EncryptionLevel
l) (RTT -> PacketNumber
ptoCount RTT
rtt)
                      pto :: Microseconds
pto = Microseconds -> Microseconds -> Microseconds
forall a. Ord a => a -> a -> a
max Microseconds
pto0 Microseconds
kGranularity
                      ptoTime :: TimeMicrosecond
ptoTime = TimeMicrosecond
timeOfLastAckElicitingPacket TimeMicrosecond -> Microseconds -> TimeMicrosecond
`addMicroseconds` Microseconds
pto
                  Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TimeMicrosecond, EncryptionLevel)
 -> IO (Maybe (TimeMicrosecond, EncryptionLevel)))
-> Maybe (TimeMicrosecond, EncryptionLevel)
-> IO (Maybe (TimeMicrosecond, EncryptionLevel))
forall a b. (a -> b) -> a -> b
$ (TimeMicrosecond, EncryptionLevel)
-> Maybe (TimeMicrosecond, EncryptionLevel)
forall a. a -> Maybe a
Just (TimeMicrosecond
ptoTime, EncryptionLevel
l)

----------------------------------------------------------------

cancelLossDetectionTimer :: LDCC -> IO ()
cancelLossDetectionTimer :: LDCC -> IO ()
cancelLossDetectionTimer ldcc :: LDCC
ldcc@LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
..} = do
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar TimerInfoQ -> TimerInfoQ -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TimerInfoQ
timerInfoQ TimerInfoQ
Empty
    Maybe TimeoutKey
mk <- IORef (Maybe TimeoutKey)
-> (Maybe TimeoutKey -> (Maybe TimeoutKey, Maybe TimeoutKey))
-> IO (Maybe TimeoutKey)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Maybe TimeoutKey)
timerKey (Maybe TimeoutKey
forall a. Maybe a
Nothing,)
    Maybe TimeoutKey -> (TimeoutKey -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe TimeoutKey
mk ((TimeoutKey -> IO ()) -> IO ()) -> (TimeoutKey -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TimeoutKey
k -> do
        TimerManager
mgr <- IO TimerManager
getSystemTimerManager
        TimerManager -> TimeoutKey -> IO ()
unregisterTimeout TimerManager
mgr TimeoutKey
k
        IORef (Maybe TimerInfo) -> Maybe TimerInfo -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe TimerInfo)
timerInfo Maybe TimerInfo
forall a. Maybe a
Nothing
        LDCC -> IO ()
forall q. KeepQlog q => q -> IO ()
qlogLossTimerCancelled LDCC
ldcc

updateLossDetectionTimer :: LDCC -> TimerInfo -> IO ()
updateLossDetectionTimer :: LDCC -> TimerInfo -> IO ()
updateLossDetectionTimer ldcc :: LDCC
ldcc@LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
..} TimerInfo
tmi = do
    Maybe TimerInfo
mtmi <- IORef (Maybe TimerInfo) -> IO (Maybe TimerInfo)
forall a. IORef a -> IO a
readIORef IORef (Maybe TimerInfo)
timerInfo
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe TimerInfo
mtmi Maybe TimerInfo -> Maybe TimerInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= TimerInfo -> Maybe TimerInfo
forall a. a -> Maybe a
Just TimerInfo
tmi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        if TimerInfo -> EncryptionLevel
timerLevel TimerInfo
tmi EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT1Level then
            STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar TimerInfoQ -> TimerInfoQ -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TimerInfoQ
timerInfoQ (TimerInfoQ -> STM ()) -> TimerInfoQ -> STM ()
forall a b. (a -> b) -> a -> b
$ TimerInfo -> TimerInfoQ
Next TimerInfo
tmi
          else
            LDCC -> TimerInfo -> IO ()
updateLossDetectionTimer' LDCC
ldcc TimerInfo
tmi

ldccTimer :: LDCC -> IO ()
ldccTimer :: LDCC -> IO ()
ldccTimer ldcc :: LDCC
ldcc@LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
..} = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        TimerInfoQ
x <- TVar TimerInfoQ -> STM TimerInfoQ
forall a. TVar a -> STM a
readTVar TVar TimerInfoQ
timerInfoQ
        Bool -> STM ()
check (TimerInfoQ
x TimerInfoQ -> TimerInfoQ -> Bool
forall a. Eq a => a -> a -> Bool
/= TimerInfoQ
Empty)
    Microseconds -> IO ()
delay Microseconds
timerGranularity
    LDCC -> IO ()
updateWithNext LDCC
ldcc

updateWithNext :: LDCC -> IO ()
updateWithNext :: LDCC -> IO ()
updateWithNext ldcc :: LDCC
ldcc@LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
..} = do
    TimerInfoQ
x <- TVar TimerInfoQ -> IO TimerInfoQ
forall a. TVar a -> IO a
readTVarIO TVar TimerInfoQ
timerInfoQ
    case TimerInfoQ
x of
      TimerInfoQ
Empty    -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Next TimerInfo
tmi -> LDCC -> TimerInfo -> IO ()
updateLossDetectionTimer' LDCC
ldcc TimerInfo
tmi

updateLossDetectionTimer' :: LDCC -> TimerInfo -> IO ()
updateLossDetectionTimer' :: LDCC -> TimerInfo -> IO ()
updateLossDetectionTimer' ldcc :: LDCC
ldcc@LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
..} TimerInfo
tmi = do
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar TimerInfoQ -> TimerInfoQ -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TimerInfoQ
timerInfoQ TimerInfoQ
Empty
    let tim :: TimeMicrosecond
tim = TimerInfo -> TimeMicrosecond
timerTime TimerInfo
tmi
    Microseconds PacketNumber
us0 <- TimeMicrosecond -> IO Microseconds
getTimeoutInMicrosecond TimeMicrosecond
tim
    let us :: PacketNumber
us | PacketNumber
us0 PacketNumber -> PacketNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= PacketNumber
0  = PacketNumber
10000 -- fixme
           | Bool
otherwise = PacketNumber
us0
    PacketNumber -> IO ()
update PacketNumber
us
    LDCC -> (TimerInfo, Microseconds) -> IO ()
forall q. KeepQlog q => q -> (TimerInfo, Microseconds) -> IO ()
qlogLossTimerUpdated LDCC
ldcc (TimerInfo
tmi, PacketNumber -> Microseconds
Microseconds PacketNumber
us) -- fixme tmi
  where
    update :: PacketNumber -> IO ()
update PacketNumber
us = do
        TimerManager
mgr <- IO TimerManager
getSystemTimerManager
        TimeoutKey
key <- TimerManager -> PacketNumber -> IO () -> IO TimeoutKey
registerTimeout TimerManager
mgr PacketNumber
us (LDCC -> IO ()
onLossDetectionTimeout LDCC
ldcc)
        Maybe TimeoutKey
mk <- IORef (Maybe TimeoutKey)
-> (Maybe TimeoutKey -> (Maybe TimeoutKey, Maybe TimeoutKey))
-> IO (Maybe TimeoutKey)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Maybe TimeoutKey)
timerKey (TimeoutKey -> Maybe TimeoutKey
forall a. a -> Maybe a
Just TimeoutKey
key,)
        Maybe TimeoutKey -> (TimeoutKey -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe TimeoutKey
mk ((TimeoutKey -> IO ()) -> IO ()) -> (TimeoutKey -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ TimerManager -> TimeoutKey -> IO ()
unregisterTimeout TimerManager
mgr
        IORef (Maybe TimerInfo) -> Maybe TimerInfo -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe TimerInfo)
timerInfo (Maybe TimerInfo -> IO ()) -> Maybe TimerInfo -> IO ()
forall a b. (a -> b) -> a -> b
$ TimerInfo -> Maybe TimerInfo
forall a. a -> Maybe a
Just TimerInfo
tmi

----------------------------------------------------------------

setLossDetectionTimer :: LDCC -> EncryptionLevel -> IO ()
setLossDetectionTimer :: LDCC -> EncryptionLevel -> IO ()
setLossDetectionTimer ldcc :: LDCC
ldcc@LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
..} EncryptionLevel
lvl0 = do
    Maybe (TimeMicrosecond, EncryptionLevel)
mtl <- LDCC -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
getLossTimeAndSpace LDCC
ldcc
    case Maybe (TimeMicrosecond, EncryptionLevel)
mtl of
      Just (TimeMicrosecond
earliestLossTime,EncryptionLevel
lvl) -> do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl0 EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
lvl) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              -- Time threshold loss detection.
              let tmi :: TimerInfo
tmi = TimeMicrosecond -> EncryptionLevel -> TimerType -> TimerInfo
TimerInfo TimeMicrosecond
earliestLossTime EncryptionLevel
lvl TimerType
LossTime
              LDCC -> TimerInfo -> IO ()
updateLossDetectionTimer LDCC
ldcc TimerInfo
tmi
      Maybe (TimeMicrosecond, EncryptionLevel)
Nothing -> do
          -- See beforeAntiAmp
          CC{PacketNumber
Maybe TimeMicrosecond
CCMode
ccMode :: CCMode
numOfAckEliciting :: PacketNumber
bytesAcked :: PacketNumber
ssthresh :: PacketNumber
congestionRecoveryStartTime :: Maybe TimeMicrosecond
congestionWindow :: PacketNumber
bytesInFlight :: PacketNumber
ccMode :: CC -> CCMode
numOfAckEliciting :: CC -> PacketNumber
bytesAcked :: CC -> PacketNumber
ssthresh :: CC -> PacketNumber
congestionRecoveryStartTime :: CC -> Maybe TimeMicrosecond
congestionWindow :: CC -> PacketNumber
bytesInFlight :: CC -> PacketNumber
..} <- TVar CC -> IO CC
forall a. TVar a -> IO a
readTVarIO TVar CC
recoveryCC
          Bool
validated <- LDCC -> IO Bool
peerCompletedAddressValidation LDCC
ldcc
          if PacketNumber
numOfAckEliciting PacketNumber -> PacketNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= PacketNumber
0 Bool -> Bool -> Bool
&& Bool
validated then
              -- There is nothing to detect lost, so no timer is
              -- set. However, we only do this if the peer has
              -- been validated, to prevent the server from being
              -- blocked by the anti-amplification limit.
              LDCC -> IO ()
cancelLossDetectionTimer LDCC
ldcc
            else do
              -- Determine which PN space to arm PTO for.
              Maybe (TimeMicrosecond, EncryptionLevel)
mx <- LDCC -> IO (Maybe (TimeMicrosecond, EncryptionLevel))
getPtoTimeAndSpace LDCC
ldcc
              case Maybe (TimeMicrosecond, EncryptionLevel)
mx of
                Maybe (TimeMicrosecond, EncryptionLevel)
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just (TimeMicrosecond
ptoTime, EncryptionLevel
lvl) -> do
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl0 EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
lvl) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        let tmi :: TimerInfo
tmi = TimeMicrosecond -> EncryptionLevel -> TimerType -> TimerInfo
TimerInfo TimeMicrosecond
ptoTime EncryptionLevel
lvl TimerType
PTO
                        LDCC -> TimerInfo -> IO ()
updateLossDetectionTimer LDCC
ldcc TimerInfo
tmi

beforeAntiAmp :: LDCC -> IO ()
beforeAntiAmp :: LDCC -> IO ()
beforeAntiAmp LDCC
ldcc = LDCC -> IO ()
cancelLossDetectionTimer LDCC
ldcc

----------------------------------------------------------------

-- The only time the PTO is armed when there are no bytes in flight is
-- when it's a client and it's unsure if the server has completed
-- address validation.
onLossDetectionTimeout :: LDCC -> IO ()
onLossDetectionTimeout :: LDCC -> IO ()
onLossDetectionTimeout ldcc :: LDCC
ldcc@LDCC{Array EncryptionLevel (IORef Bool)
Array EncryptionLevel (IORef PeerPacketNumbers)
Array EncryptionLevel (IORef LossDetection)
Array EncryptionLevel (IORef SentPackets)
TVar (Maybe EncryptionLevel)
TVar TimerInfoQ
TVar CC
TVar SentPackets
IORef Bool
IORef PacketNumber
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef PacketNumber
speedingUp :: IORef Bool
ptoPing :: TVar (Maybe EncryptionLevel)
lostCandidates :: TVar SentPackets
timerInfo :: IORef (Maybe TimerInfo)
timerKey :: IORef (Maybe TimeoutKey)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
recoveryCC :: TVar CC
recoveryRTT :: IORef RTT
putRetrans :: PlainPacket -> IO ()
ldccQlogger :: QLogger
ldccState :: ConnState
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef PacketNumber
speedingUp :: LDCC -> IORef Bool
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
lostCandidates :: LDCC -> TVar SentPackets
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
recoveryCC :: LDCC -> TVar CC
recoveryRTT :: LDCC -> IORef RTT
putRetrans :: LDCC -> PlainPacket -> IO ()
ldccQlogger :: LDCC -> QLogger
ldccState :: LDCC -> ConnState
..} = do
    Bool
alive <- LDCC -> IO Bool
forall a. Connector a => a -> IO Bool
getAlive LDCC
ldcc
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alive (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe TimerInfo
mtmi <- IORef (Maybe TimerInfo) -> IO (Maybe TimerInfo)
forall a. IORef a -> IO a
readIORef IORef (Maybe TimerInfo)
timerInfo
        case Maybe TimerInfo
mtmi of
          Maybe TimerInfo
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just TimerInfo
tmi -> do
            let lvl :: EncryptionLevel
lvl = TimerInfo -> EncryptionLevel
timerLevel TimerInfo
tmi
            Bool
discarded <- LDCC -> EncryptionLevel -> IO Bool
getPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
lvl
            if Bool
discarded then
                LDCC -> IO ()
updateWithNext LDCC
ldcc
              else
                EncryptionLevel -> TimerInfo -> IO ()
lossTimeOrPTO EncryptionLevel
lvl TimerInfo
tmi
  where
    lossTimeOrPTO :: EncryptionLevel -> TimerInfo -> IO ()
lossTimeOrPTO EncryptionLevel
lvl TimerInfo
tmi = do
        LDCC -> IO ()
forall q. KeepQlog q => q -> IO ()
qlogLossTimerExpired LDCC
ldcc
        case TimerInfo -> TimerType
timerType TimerInfo
tmi of
          TimerType
LossTime -> do
              -- Time threshold loss Detection
              Seq SentPacket
lostPackets <- LDCC -> EncryptionLevel -> IO (Seq SentPacket)
detectAndRemoveLostPackets LDCC
ldcc EncryptionLevel
lvl
              Seq SentPacket
lostPackets' <- LDCC -> Seq SentPacket -> IO (Seq SentPacket)
mergeLostCandidatesAndClear LDCC
ldcc Seq SentPacket
lostPackets
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Seq SentPacket -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq SentPacket
lostPackets') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LDCC -> Debug -> IO ()
forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug LDCC
ldcc (Debug -> IO ()) -> Debug -> IO ()
forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"onLossDetectionTimeout: null"
              LDCC -> Seq SentPacket -> IO ()
onPacketsLost LDCC
ldcc Seq SentPacket
lostPackets'
              LDCC -> Seq SentPacket -> IO ()
retransmit LDCC
ldcc Seq SentPacket
lostPackets'
              LDCC -> EncryptionLevel -> IO ()
setLossDetectionTimer LDCC
ldcc EncryptionLevel
lvl
          TimerType
PTO -> do
              CC{PacketNumber
Maybe TimeMicrosecond
CCMode
ccMode :: CCMode
numOfAckEliciting :: PacketNumber
bytesAcked :: PacketNumber
ssthresh :: PacketNumber
congestionRecoveryStartTime :: Maybe TimeMicrosecond
congestionWindow :: PacketNumber
bytesInFlight :: PacketNumber
ccMode :: CC -> CCMode
numOfAckEliciting :: CC -> PacketNumber
bytesAcked :: CC -> PacketNumber
ssthresh :: CC -> PacketNumber
congestionRecoveryStartTime :: CC -> Maybe TimeMicrosecond
congestionWindow :: CC -> PacketNumber
bytesInFlight :: CC -> PacketNumber
..} <- TVar CC -> IO CC
forall a. TVar a -> IO a
readTVarIO TVar CC
recoveryCC
              if PacketNumber
bytesInFlight PacketNumber -> PacketNumber -> Bool
forall a. Ord a => a -> a -> Bool
> PacketNumber
0 then do
                  -- PTO. Send new data if available, else retransmit old data.
                  -- If neither is available, send a single PING frame.
                  LDCC -> EncryptionLevel -> IO ()
sendPing LDCC
ldcc EncryptionLevel
lvl
                else do
                  -- Client sends an anti-deadlock packet: Initial is padded
                  -- to earn more anti-amplification credit,
                  -- a Handshake packet proves address ownership.
                  Bool
validated <- LDCC -> IO Bool
peerCompletedAddressValidation LDCC
ldcc
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
validated (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LDCC -> Debug -> IO ()
forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug LDCC
ldcc (Debug -> IO ()) -> Debug -> IO ()
forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"onLossDetectionTimeout: RTT1"
                  EncryptionLevel
lvl' <- LDCC -> IO EncryptionLevel
forall a. Connector a => a -> IO EncryptionLevel
getEncryptionLevel LDCC
ldcc -- fixme
                  LDCC -> EncryptionLevel -> IO ()
sendPing LDCC
ldcc EncryptionLevel
lvl'

              LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  IORef RTT -> (RTT -> RTT) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' IORef RTT
recoveryRTT ((RTT -> RTT) -> IO ()) -> (RTT -> RTT) -> IO ()
forall a b. (a -> b) -> a -> b
$
                      \RTT
rtt -> RTT
rtt { ptoCount :: PacketNumber
ptoCount = RTT -> PacketNumber
ptoCount RTT
rtt PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
+ PacketNumber
1 }
              LDCC -> EncryptionLevel -> IO ()
setLossDetectionTimer LDCC
ldcc EncryptionLevel
lvl