{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.QUIC.Recovery.LossRecovery (
onPacketSent,
onPacketReceived,
onAckReceived,
onPacketNumberSpaceDiscarded,
) where
import Data.Sequence (Seq, ViewR (..), (|>))
import qualified Data.Sequence as Seq
import UnliftIO.STM
import Network.QUIC.Connector
import Network.QUIC.Imports
import Network.QUIC.Qlog
import Network.QUIC.Recovery.Constants
import Network.QUIC.Recovery.Detect
import Network.QUIC.Recovery.Metrics
import Network.QUIC.Recovery.Misc
import Network.QUIC.Recovery.PeerPacketNumbers
import Network.QUIC.Recovery.Release
import Network.QUIC.Recovery.Timer
import Network.QUIC.Recovery.Types
import Network.QUIC.Recovery.Utils
import Network.QUIC.Types
onPacketSent :: LDCC -> SentPacket -> IO ()
onPacketSent :: LDCC -> SentPacket -> IO ()
onPacketSent 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 Int
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
ldccState :: ConnState
ldccQlogger :: QLogger
putRetrans :: PlainPacket -> IO ()
recoveryRTT :: IORef RTT
recoveryCC :: TVar CC
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
timerKey :: IORef (Maybe TimeoutKey)
timerInfo :: IORef (Maybe TimerInfo)
lostCandidates :: TVar SentPackets
ptoPing :: TVar (Maybe EncryptionLevel)
speedingUp :: IORef Bool
pktNumPersistent :: IORef Int
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: IORef PeerPacketNumbers
timerInfoQ :: TVar TimerInfoQ
ldccState :: LDCC -> ConnState
ldccQlogger :: LDCC -> QLogger
putRetrans :: LDCC -> PlainPacket -> IO ()
recoveryRTT :: LDCC -> IORef RTT
recoveryCC :: LDCC -> TVar CC
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
lostCandidates :: LDCC -> TVar SentPackets
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
speedingUp :: LDCC -> IORef Bool
pktNumPersistent :: LDCC -> IORef Int
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
timerInfoQ :: LDCC -> TVar TimerInfoQ
..} SentPacket
sentPacket = do
let lvl0 :: EncryptionLevel
lvl0 = SentPacket -> EncryptionLevel
spEncryptionLevel SentPacket
sentPacket
let lvl :: EncryptionLevel
lvl
| EncryptionLevel
lvl0 EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT0Level = EncryptionLevel
RTT1Level
| Bool
otherwise = EncryptionLevel
lvl0
Bool
discarded <- LDCC -> EncryptionLevel -> IO Bool
getPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
lvl
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
discarded (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
LDCC -> SentPacket -> IO ()
onPacketSentCC LDCC
ldcc SentPacket
sentPacket
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SentPacket -> Bool
spAckEliciting SentPacket
sentPacket) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IORef LossDetection -> (LossDetection -> LossDetection) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' (Array EncryptionLevel (IORef LossDetection)
lossDetection Array EncryptionLevel (IORef LossDetection)
-> EncryptionLevel -> IORef LossDetection
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl) ((LossDetection -> LossDetection) -> IO ())
-> (LossDetection -> LossDetection) -> IO ()
forall a b. (a -> b) -> a -> b
$ \LossDetection
ld ->
LossDetection
ld
{ timeOfLastAckElicitingPacket = spTimeSent sentPacket
}
IORef SentPackets -> (SentPackets -> SentPackets) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' (Array EncryptionLevel (IORef SentPackets)
sentPackets Array EncryptionLevel (IORef SentPackets)
-> EncryptionLevel -> IORef SentPackets
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl) ((SentPackets -> SentPackets) -> IO ())
-> (SentPackets -> SentPackets) -> IO ()
forall a b. (a -> b) -> a -> b
$
\(SentPackets Seq SentPacket
db) -> Seq SentPacket -> SentPackets
SentPackets (Seq SentPacket
db Seq SentPacket -> SentPacket -> Seq SentPacket
forall a. Seq a -> a -> Seq a
|> SentPacket
sentPacket)
LDCC -> EncryptionLevel -> IO ()
setLossDetectionTimer LDCC
ldcc EncryptionLevel
lvl
onPacketSentCC :: LDCC -> SentPacket -> IO ()
onPacketSentCC :: LDCC -> SentPacket -> IO ()
onPacketSentCC 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 Int
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
ldccState :: LDCC -> ConnState
ldccQlogger :: LDCC -> QLogger
putRetrans :: LDCC -> PlainPacket -> IO ()
recoveryRTT :: LDCC -> IORef RTT
recoveryCC :: LDCC -> TVar CC
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
lostCandidates :: LDCC -> TVar SentPackets
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
speedingUp :: LDCC -> IORef Bool
pktNumPersistent :: LDCC -> IORef Int
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
timerInfoQ :: LDCC -> TVar TimerInfoQ
ldccState :: ConnState
ldccQlogger :: QLogger
putRetrans :: PlainPacket -> IO ()
recoveryRTT :: IORef RTT
recoveryCC :: TVar CC
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
timerKey :: IORef (Maybe TimeoutKey)
timerInfo :: IORef (Maybe TimerInfo)
lostCandidates :: TVar SentPackets
ptoPing :: TVar (Maybe EncryptionLevel)
speedingUp :: IORef Bool
pktNumPersistent :: IORef Int
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: IORef PeerPacketNumbers
timerInfoQ :: TVar TimerInfoQ
..} SentPacket
sentPacket = LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
TVar CC -> (CC -> CC) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CC
recoveryCC ((CC -> CC) -> STM ()) -> (CC -> CC) -> STM ()
forall a b. (a -> b) -> a -> b
$ \CC
cc ->
CC
cc
{ bytesInFlight = bytesInFlight cc + sentBytes
, numOfAckEliciting = numOfAckEliciting cc + countAckEli sentPacket
}
where
sentBytes :: Int
sentBytes = SentPacket -> Int
spSentBytes SentPacket
sentPacket
onPacketReceived :: LDCC -> EncryptionLevel -> PacketNumber -> IO ()
onPacketReceived :: LDCC -> EncryptionLevel -> Int -> IO ()
onPacketReceived LDCC
ldcc EncryptionLevel
lvl Int
pn = do
Bool
discarded <- LDCC -> EncryptionLevel -> IO Bool
getPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
lvl
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
discarded (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LDCC -> EncryptionLevel -> Int -> IO ()
addPeerPacketNumbers LDCC
ldcc EncryptionLevel
lvl Int
pn
onAckReceived :: LDCC -> EncryptionLevel -> AckInfo -> Microseconds -> IO ()
onAckReceived :: LDCC -> EncryptionLevel -> AckInfo -> Microseconds -> IO ()
onAckReceived 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 Int
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
ldccState :: LDCC -> ConnState
ldccQlogger :: LDCC -> QLogger
putRetrans :: LDCC -> PlainPacket -> IO ()
recoveryRTT :: LDCC -> IORef RTT
recoveryCC :: LDCC -> TVar CC
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
lostCandidates :: LDCC -> TVar SentPackets
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
speedingUp :: LDCC -> IORef Bool
pktNumPersistent :: LDCC -> IORef Int
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
timerInfoQ :: LDCC -> TVar TimerInfoQ
ldccState :: ConnState
ldccQlogger :: QLogger
putRetrans :: PlainPacket -> IO ()
recoveryRTT :: IORef RTT
recoveryCC :: TVar CC
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
timerKey :: IORef (Maybe TimeoutKey)
timerInfo :: IORef (Maybe TimerInfo)
lostCandidates :: TVar SentPackets
ptoPing :: TVar (Maybe EncryptionLevel)
speedingUp :: IORef Bool
pktNumPersistent :: IORef Int
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: IORef PeerPacketNumbers
timerInfoQ :: TVar TimerInfoQ
..} EncryptionLevel
lvl ackInfo :: AckInfo
ackInfo@(AckInfo Int
largestAcked Int
_ [(Int, Int)]
_) Microseconds
ackDelay = do
Bool
changed <- IORef LossDetection
-> (LossDetection -> (LossDetection, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Array EncryptionLevel (IORef LossDetection)
lossDetection Array EncryptionLevel (IORef LossDetection)
-> EncryptionLevel -> IORef LossDetection
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl) LossDetection -> (LossDetection, Bool)
update
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let predicate :: SentPacket -> Bool
predicate = AckInfo -> Int -> Bool
fromAckInfoToPred AckInfo
ackInfo (Int -> Bool) -> (SentPacket -> Int) -> SentPacket -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SentPacket -> Int
spPacketNumber
LDCC
-> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)
releaseLostCandidates LDCC
ldcc EncryptionLevel
lvl SentPacket -> Bool
predicate IO (Seq SentPacket) -> (Seq SentPacket -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Seq SentPacket -> IO ()
updateCConAck
LDCC
-> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)
releaseByPredicate LDCC
ldcc EncryptionLevel
lvl SentPacket -> Bool
predicate IO (Seq SentPacket) -> (Seq SentPacket -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Seq SentPacket -> IO ()
detectLossUpdateCC
where
update :: LossDetection -> (LossDetection, Bool)
update ld :: LossDetection
ld@LossDetection{Int
Maybe TimeMicrosecond
TimeMicrosecond
AckInfo
timeOfLastAckElicitingPacket :: LossDetection -> TimeMicrosecond
largestAckedPacket :: Int
previousAckInfo :: AckInfo
timeOfLastAckElicitingPacket :: TimeMicrosecond
lossTime :: Maybe TimeMicrosecond
largestAckedPacket :: LossDetection -> Int
previousAckInfo :: LossDetection -> AckInfo
lossTime :: LossDetection -> Maybe TimeMicrosecond
..} = (LossDetection
ld', Bool
changed)
where
ld' :: LossDetection
ld' =
LossDetection
ld
{ largestAckedPacket = max largestAckedPacket largestAcked
, previousAckInfo = ackInfo
}
changed :: Bool
changed = AckInfo
previousAckInfo AckInfo -> AckInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= AckInfo
ackInfo
detectLossUpdateCC :: Seq SentPacket -> IO ()
detectLossUpdateCC Seq SentPacket
newlyAckedPackets = case Seq SentPacket -> ViewR SentPacket
forall a. Seq a -> ViewR a
Seq.viewr Seq SentPacket
newlyAckedPackets of
ViewR SentPacket
EmptyR -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Seq SentPacket
_ :> SentPacket
lastPkt -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
( SentPacket -> Int
spPacketNumber SentPacket
lastPkt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
largestAcked
Bool -> Bool -> Bool
&& (SentPacket -> Bool) -> Seq SentPacket -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SentPacket -> Bool
spAckEliciting Seq SentPacket
newlyAckedPackets
)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Microseconds
rtt <- TimeMicrosecond -> IO Microseconds
getElapsedTimeMicrosecond (TimeMicrosecond -> IO Microseconds)
-> TimeMicrosecond -> IO Microseconds
forall a b. (a -> b) -> a -> b
$ SentPacket -> TimeMicrosecond
spTimeSent SentPacket
lastPkt
let latestRtt :: Microseconds
latestRtt = Microseconds -> Microseconds -> Microseconds
forall a. Ord a => a -> a -> a
max Microseconds
rtt Microseconds
kGranularity
LDCC -> EncryptionLevel -> Microseconds -> Microseconds -> IO ()
updateRTT LDCC
ldcc EncryptionLevel
lvl Microseconds
latestRtt Microseconds
ackDelay
Seq SentPacket
lostPackets <- LDCC -> EncryptionLevel -> IO (Seq SentPacket)
detectAndRemoveLostPackets LDCC
ldcc EncryptionLevel
lvl
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Seq SentPacket -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq SentPacket
lostPackets) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
CCMode
mode <- CC -> CCMode
ccMode (CC -> CCMode) -> IO CC -> IO CCMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar CC -> IO CC
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar CC
recoveryCC
if EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT1Level Bool -> Bool -> Bool
&& CCMode
mode CCMode -> CCMode -> Bool
forall a. Eq a => a -> a -> Bool
/= CCMode
SlowStart
then LDCC -> Seq SentPacket -> IO ()
mergeLostCandidates LDCC
ldcc Seq SentPacket
lostPackets
else do
Seq SentPacket
lostPackets' <- LDCC -> Seq SentPacket -> IO (Seq SentPacket)
mergeLostCandidatesAndClear LDCC
ldcc Seq SentPacket
lostPackets
LDCC -> Seq SentPacket -> IO ()
onPacketsLost LDCC
ldcc Seq SentPacket
lostPackets'
LDCC -> Seq SentPacket -> IO ()
retransmit LDCC
ldcc Seq SentPacket
lostPackets'
Seq SentPacket -> IO ()
updateCConAck Seq SentPacket
newlyAckedPackets
updateCConAck :: Seq SentPacket -> IO ()
updateCConAck Seq SentPacket
newlyAckedPackets
| Seq SentPacket
newlyAckedPackets Seq SentPacket -> Seq SentPacket -> Bool
forall a. Eq a => a -> a -> Bool
== Seq SentPacket
forall a. Seq a
Seq.empty = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
LDCC -> Seq SentPacket -> IO ()
onPacketsAcked LDCC
ldcc Seq SentPacket
newlyAckedPackets
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 -> 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 = 0}
LDCC -> EncryptionLevel -> IO ()
setLossDetectionTimer LDCC
ldcc EncryptionLevel
lvl
releaseLostCandidates
:: LDCC -> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)
releaseLostCandidates :: LDCC
-> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)
releaseLostCandidates 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 Int
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
ldccState :: LDCC -> ConnState
ldccQlogger :: LDCC -> QLogger
putRetrans :: LDCC -> PlainPacket -> IO ()
recoveryRTT :: LDCC -> IORef RTT
recoveryCC :: LDCC -> TVar CC
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
lostCandidates :: LDCC -> TVar SentPackets
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
speedingUp :: LDCC -> IORef Bool
pktNumPersistent :: LDCC -> IORef Int
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
timerInfoQ :: LDCC -> TVar TimerInfoQ
ldccState :: ConnState
ldccQlogger :: QLogger
putRetrans :: PlainPacket -> IO ()
recoveryRTT :: IORef RTT
recoveryCC :: TVar CC
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
timerKey :: IORef (Maybe TimeoutKey)
timerInfo :: IORef (Maybe TimerInfo)
lostCandidates :: TVar SentPackets
ptoPing :: TVar (Maybe EncryptionLevel)
speedingUp :: IORef Bool
pktNumPersistent :: IORef Int
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: IORef PeerPacketNumbers
timerInfoQ :: TVar TimerInfoQ
..} EncryptionLevel
lvl SentPacket -> Bool
predicate = do
Seq SentPacket
packets <- STM (Seq SentPacket) -> IO (Seq SentPacket)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Seq SentPacket) -> IO (Seq SentPacket))
-> STM (Seq SentPacket) -> IO (Seq SentPacket)
forall a b. (a -> b) -> a -> b
$ do
SentPackets Seq SentPacket
db <- TVar SentPackets -> STM SentPackets
forall a. TVar a -> STM a
readTVar TVar SentPackets
lostCandidates
let (Seq SentPacket
pkts, Seq SentPacket
db') = (SentPacket -> Bool)
-> Seq SentPacket -> (Seq SentPacket, Seq SentPacket)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.partition SentPacket -> Bool
predicate Seq SentPacket
db
TVar SentPackets -> SentPackets -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar SentPackets
lostCandidates (SentPackets -> STM ()) -> SentPackets -> STM ()
forall a b. (a -> b) -> a -> b
$ Seq SentPacket -> SentPackets
SentPackets Seq SentPacket
db'
Seq SentPacket -> STM (Seq SentPacket)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Seq SentPacket
pkts
LDCC -> EncryptionLevel -> Seq SentPacket -> IO ()
forall (t :: * -> *).
Foldable t =>
LDCC -> EncryptionLevel -> t SentPacket -> IO ()
removePacketNumbers LDCC
ldcc EncryptionLevel
lvl Seq SentPacket
packets
Seq SentPacket -> IO (Seq SentPacket)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Seq SentPacket
packets
onPacketsAcked :: LDCC -> Seq SentPacket -> IO ()
onPacketsAcked :: LDCC -> Seq SentPacket -> IO ()
onPacketsAcked 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 Int
IORef (Maybe TimeoutKey)
IORef (Maybe TimerInfo)
IORef PeerPacketNumbers
IORef RTT
ConnState
PlainPacket -> IO ()
QLogger
ldccState :: LDCC -> ConnState
ldccQlogger :: LDCC -> QLogger
putRetrans :: LDCC -> PlainPacket -> IO ()
recoveryRTT :: LDCC -> IORef RTT
recoveryCC :: LDCC -> TVar CC
spaceDiscarded :: LDCC -> Array EncryptionLevel (IORef Bool)
sentPackets :: LDCC -> Array EncryptionLevel (IORef SentPackets)
lossDetection :: LDCC -> Array EncryptionLevel (IORef LossDetection)
timerKey :: LDCC -> IORef (Maybe TimeoutKey)
timerInfo :: LDCC -> IORef (Maybe TimerInfo)
lostCandidates :: LDCC -> TVar SentPackets
ptoPing :: LDCC -> TVar (Maybe EncryptionLevel)
speedingUp :: LDCC -> IORef Bool
pktNumPersistent :: LDCC -> IORef Int
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
timerInfoQ :: LDCC -> TVar TimerInfoQ
ldccState :: ConnState
ldccQlogger :: QLogger
putRetrans :: PlainPacket -> IO ()
recoveryRTT :: IORef RTT
recoveryCC :: TVar CC
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
timerKey :: IORef (Maybe TimeoutKey)
timerInfo :: IORef (Maybe TimerInfo)
lostCandidates :: TVar SentPackets
ptoPing :: TVar (Maybe EncryptionLevel)
speedingUp :: IORef Bool
pktNumPersistent :: IORef Int
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: IORef PeerPacketNumbers
timerInfoQ :: TVar TimerInfoQ
..} Seq SentPacket
ackedPackets = LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Int
maxPktSiz <- LDCC -> IO Int
forall a. Connector a => a -> IO Int
getMaxPacketSize LDCC
ldcc
CC
oldcc <- TVar CC -> IO CC
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar CC
recoveryCC
STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar CC -> (CC -> CC) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CC
recoveryCC ((CC -> CC) -> STM ()) -> (CC -> CC) -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> CC -> CC
modify Int
maxPktSiz
CC
newcc <- TVar CC -> IO CC
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar CC
recoveryCC
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CC -> CCMode
ccMode CC
oldcc CCMode -> CCMode -> Bool
forall a. Eq a => a -> a -> Bool
/= CC -> CCMode
ccMode CC
newcc) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
LDCC -> CCMode -> IO ()
forall q. KeepQlog q => q -> CCMode -> IO ()
qlogContestionStateUpdated LDCC
ldcc (CCMode -> IO ()) -> CCMode -> IO ()
forall a b. (a -> b) -> a -> b
$
CC -> CCMode
ccMode CC
newcc
where
modify :: Int -> CC -> CC
modify Int
maxPktSiz cc :: CC
cc@CC{Int
Maybe TimeMicrosecond
CCMode
bytesInFlight :: CC -> Int
numOfAckEliciting :: CC -> Int
ccMode :: CC -> CCMode
bytesInFlight :: Int
congestionWindow :: Int
congestionRecoveryStartTime :: Maybe TimeMicrosecond
ssthresh :: Int
bytesAcked :: Int
numOfAckEliciting :: Int
ccMode :: CCMode
congestionWindow :: CC -> Int
congestionRecoveryStartTime :: CC -> Maybe TimeMicrosecond
ssthresh :: CC -> Int
bytesAcked :: CC -> Int
..} =
CC
cc
{ bytesInFlight = bytesInFlight'
, congestionWindow = congestionWindow'
, bytesAcked = bytesAcked'
, ccMode = ccMode'
, numOfAckEliciting = numOfAckEliciting'
}
where
(Int
bytesInFlight', Int
congestionWindow', Int
bytesAcked', CCMode
ccMode', Int
numOfAckEliciting') =
((Int, Int, Int, CCMode, Int)
-> SentPacket -> (Int, Int, Int, CCMode, Int))
-> (Int, Int, Int, CCMode, Int)
-> Seq SentPacket
-> (Int, Int, Int, CCMode, Int)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
(Int, Int, Int, CCMode, Int)
-> SentPacket -> (Int, Int, Int, CCMode, Int)
forall {d}.
(Int, Int, Int, d, Int)
-> SentPacket -> (Int, Int, Int, CCMode, Int)
(.+)
(Int
bytesInFlight, Int
congestionWindow, Int
bytesAcked, CCMode
ccMode, Int
numOfAckEliciting)
Seq SentPacket
ackedPackets
(Int
bytes, Int
cwin, Int
acked, d
_, Int
cnt) .+ :: (Int, Int, Int, d, Int)
-> SentPacket -> (Int, Int, Int, CCMode, Int)
.+ sp :: SentPacket
sp@SentPacket{Bool
Int
TimeMicrosecond
PeerPacketNumbers
EncryptionLevel
PlainPacket
spEncryptionLevel :: SentPacket -> EncryptionLevel
spAckEliciting :: SentPacket -> Bool
spTimeSent :: SentPacket -> TimeMicrosecond
spSentBytes :: SentPacket -> Int
spPacketNumber :: SentPacket -> Int
spPlainPacket :: PlainPacket
spTimeSent :: TimeMicrosecond
spSentBytes :: Int
spEncryptionLevel :: EncryptionLevel
spPacketNumber :: Int
spPeerPacketNumbers :: PeerPacketNumbers
spAckEliciting :: Bool
spPlainPacket :: SentPacket -> PlainPacket
spPeerPacketNumbers :: SentPacket -> PeerPacketNumbers
..} = (Int
bytes', Int
cwin', Int
acked', CCMode
mode', Int
cnt')
where
isRecovery :: Bool
isRecovery = TimeMicrosecond -> Maybe TimeMicrosecond -> Bool
inCongestionRecovery TimeMicrosecond
spTimeSent Maybe TimeMicrosecond
congestionRecoveryStartTime
bytes' :: Int
bytes' = Int
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spSentBytes
ackedA :: Int
ackedA = Int
acked Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spSentBytes
cnt' :: Int
cnt' = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- SentPacket -> Int
countAckEli SentPacket
sp
(Int
cwin', Int
acked', CCMode
mode')
| Bool
isRecovery = (Int
cwin, Int
acked, CCMode
Recovery)
| Int
cwin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ssthresh = (Int
cwin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spSentBytes, Int
acked, CCMode
SlowStart)
| Int
ackedA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
cwin = (Int
cwin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxPktSiz, Int
ackedA Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cwin, CCMode
Avoidance)
| Bool
otherwise = (Int
cwin, Int
ackedA, CCMode
Avoidance)
onPacketNumberSpaceDiscarded :: LDCC -> EncryptionLevel -> IO ()
onPacketNumberSpaceDiscarded :: LDCC -> EncryptionLevel -> IO ()
onPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
lvl = do
let (EncryptionLevel
lvl', LogStr
label) = case EncryptionLevel
lvl of
EncryptionLevel
InitialLevel -> (EncryptionLevel
HandshakeLevel, LogStr
"initial")
EncryptionLevel
_ -> (EncryptionLevel
RTT1Level, LogStr
"handshake")
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
label LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
" discarded")
IO (Seq SentPacket) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Seq SentPacket) -> IO ()) -> IO (Seq SentPacket) -> IO ()
forall a b. (a -> b) -> a -> b
$ LDCC -> EncryptionLevel -> IO (Seq SentPacket)
discard LDCC
ldcc EncryptionLevel
lvl
LDCC -> EncryptionLevel -> IO ()
setLossDetectionTimer LDCC
ldcc EncryptionLevel
lvl'