{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.QUIC.Recovery.Metrics (
updateRTT,
updateCC,
metricsUpdated,
setInitialCongestionWindow,
) where
import Data.Sequence (Seq)
import UnliftIO.STM
import Network.QUIC.Imports
import Network.QUIC.Qlog
import Network.QUIC.Recovery.Constants
import Network.QUIC.Recovery.Misc
import Network.QUIC.Recovery.Persistent
import Network.QUIC.Recovery.Types
import Network.QUIC.Types
updateRTT :: LDCC -> EncryptionLevel -> Microseconds -> Microseconds -> IO ()
updateRTT :: LDCC -> EncryptionLevel -> Microseconds -> Microseconds -> IO ()
updateRTT 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 :: 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 Microseconds
latestRTT0 Microseconds
ackDelay0 = LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc forall a b. (a -> b) -> a -> b
$ do
Bool
firstTime <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef RTT
recoveryRTT RTT -> (RTT, Bool)
update
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
firstTime forall a b. (a -> b) -> a -> b
$ do
LDCC -> IO ()
setPktNumPersistent LDCC
ldcc
forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug LDCC
ldcc forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"RTT first sample"
where
update :: RTT -> (RTT, Bool)
update rtt :: RTT
rtt@RTT{PacketNumber
Microseconds
ptoCount :: RTT -> PacketNumber
maxAckDelay1RTT :: RTT -> Microseconds
minRTT :: RTT -> Microseconds
rttvar :: RTT -> Microseconds
smoothedRTT :: RTT -> Microseconds
latestRTT :: RTT -> Microseconds
ptoCount :: PacketNumber
maxAckDelay1RTT :: Microseconds
minRTT :: Microseconds
rttvar :: Microseconds
smoothedRTT :: Microseconds
latestRTT :: Microseconds
..}
| Microseconds
latestRTT forall a. Eq a => a -> a -> Bool
== PacketNumber -> Microseconds
Microseconds PacketNumber
0 =
( RTT
rtt
{ latestRTT :: Microseconds
latestRTT = Microseconds
latestRTT0
, minRTT :: Microseconds
minRTT = Microseconds
latestRTT0
, smoothedRTT :: Microseconds
smoothedRTT = Microseconds
latestRTT0
, rttvar :: Microseconds
rttvar = Microseconds
latestRTT0 forall a. Bits a => a -> PacketNumber -> a
`unsafeShiftR` PacketNumber
1
}
, Bool
True
)
update rtt :: RTT
rtt@RTT{PacketNumber
Microseconds
ptoCount :: PacketNumber
maxAckDelay1RTT :: Microseconds
minRTT :: Microseconds
rttvar :: Microseconds
smoothedRTT :: Microseconds
latestRTT :: Microseconds
ptoCount :: RTT -> PacketNumber
maxAckDelay1RTT :: RTT -> Microseconds
minRTT :: RTT -> Microseconds
rttvar :: RTT -> Microseconds
smoothedRTT :: RTT -> Microseconds
latestRTT :: RTT -> Microseconds
..} =
( RTT
rtt
{ latestRTT :: Microseconds
latestRTT = Microseconds
latestRTT0
, minRTT :: Microseconds
minRTT = Microseconds
minRTT'
, smoothedRTT :: Microseconds
smoothedRTT = Microseconds
smoothedRTT'
, rttvar :: Microseconds
rttvar = Microseconds
rttvar'
}
, Bool
False
)
where
minRTT' :: Microseconds
minRTT' = forall a. Ord a => a -> a -> a
min Microseconds
minRTT Microseconds
latestRTT0
ackDelay :: Microseconds
ackDelay = forall a. Ord a => a -> a -> a
min Microseconds
ackDelay0 forall a b. (a -> b) -> a -> b
$ Maybe EncryptionLevel -> Microseconds -> Microseconds
getMaxAckDelay (forall a. a -> Maybe a
Just EncryptionLevel
lvl) Microseconds
maxAckDelay1RTT
adjustedRTT :: Microseconds
adjustedRTT
| Microseconds
latestRTT0 forall a. Ord a => a -> a -> Bool
>= Microseconds
minRTT forall a. Num a => a -> a -> a
+ Microseconds
ackDelay = Microseconds
latestRTT0 forall a. Num a => a -> a -> a
- Microseconds
ackDelay
| Bool
otherwise = Microseconds
latestRTT0
rttvar' :: Microseconds
rttvar' =
Microseconds
rttvar
forall a. Num a => a -> a -> a
- (Microseconds
rttvar forall a. Bits a => a -> PacketNumber -> a
!>>. PacketNumber
2)
forall a. Num a => a -> a -> a
+ (forall a. Num a => a -> a
abs (Microseconds
smoothedRTT forall a. Num a => a -> a -> a
- Microseconds
adjustedRTT) forall a. Bits a => a -> PacketNumber -> a
!>>. PacketNumber
2)
smoothedRTT' :: Microseconds
smoothedRTT' =
Microseconds
smoothedRTT
forall a. Num a => a -> a -> a
- (Microseconds
smoothedRTT forall a. Bits a => a -> PacketNumber -> a
!>>. PacketNumber
3)
forall a. Num a => a -> a -> a
+ (Microseconds
adjustedRTT forall a. Bits a => a -> PacketNumber -> a
!>>. PacketNumber
3)
updateCC :: LDCC -> Seq SentPacket -> Bool -> IO ()
updateCC :: LDCC -> Seq SentPacket -> Bool -> IO ()
updateCC 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
..} Seq SentPacket
lostPackets Bool
isRecovery = do
Bool
persistent <- LDCC -> Seq SentPacket -> IO Bool
inPersistentCongestion LDCC
ldcc Seq SentPacket
lostPackets
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
persistent Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isRecovery) forall a b. (a -> b) -> a -> b
$ do
PacketNumber
minWindow <- LDCC -> IO PacketNumber
kMinimumWindow LDCC
ldcc
TimeMicrosecond
now <- IO TimeMicrosecond
getTimeMicrosecond
LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CC
recoveryCC forall a b. (a -> b) -> a -> b
$ \cc :: CC
cc@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
..} ->
let halfWindow :: PacketNumber
halfWindow = forall a. Ord a => a -> a -> a
max PacketNumber
minWindow forall a b. (a -> b) -> a -> b
$ PacketNumber -> PacketNumber
kLossReductionFactor PacketNumber
congestionWindow
cwin :: PacketNumber
cwin
| Bool
persistent = PacketNumber
minWindow
| Bool
otherwise = PacketNumber
halfWindow
sst :: PacketNumber
sst = PacketNumber
halfWindow
mode :: CCMode
mode
| PacketNumber
cwin forall a. Ord a => a -> a -> Bool
< PacketNumber
sst = CCMode
SlowStart
| Bool
otherwise = CCMode
Recovery
in CC
cc
{ congestionRecoveryStartTime :: Maybe TimeMicrosecond
congestionRecoveryStartTime = forall a. a -> Maybe a
Just TimeMicrosecond
now
, congestionWindow :: PacketNumber
congestionWindow = PacketNumber
cwin
, ssthresh :: PacketNumber
ssthresh = PacketNumber
sst
, ccMode :: CCMode
ccMode = CCMode
mode
, bytesAcked :: PacketNumber
bytesAcked = PacketNumber
0
}
CC{CCMode
ccMode :: CCMode
ccMode :: CC -> CCMode
ccMode} <- forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar CC
recoveryCC
forall q. KeepQlog q => q -> CCMode -> IO ()
qlogContestionStateUpdated LDCC
ldcc CCMode
ccMode
setInitialCongestionWindow :: LDCC -> Int -> IO ()
setInitialCongestionWindow :: LDCC -> PacketNumber -> IO ()
setInitialCongestionWindow 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
..} PacketNumber
pktSiz = LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CC
recoveryCC forall a b. (a -> b) -> a -> b
$ \CC
cc ->
CC
cc
{ congestionWindow :: PacketNumber
congestionWindow = PacketNumber -> PacketNumber
kInitialWindow PacketNumber
pktSiz
}
metricsUpdated :: LDCC -> IO () -> IO ()
metricsUpdated :: LDCC -> IO () -> IO ()
metricsUpdated 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 ()
body = do
RTT
rtt0 <- forall a. IORef a -> IO a
readIORef IORef RTT
recoveryRTT
CC
cc0 <- forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar CC
recoveryCC
IO ()
body
RTT
rtt1 <- forall a. IORef a -> IO a
readIORef IORef RTT
recoveryRTT
CC
cc1 <- forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar CC
recoveryCC
let ~[(String, PacketNumber)]
diff =
forall a. [Maybe a] -> [a]
catMaybes
[ forall {a}.
a -> Microseconds -> Microseconds -> Maybe (a, PacketNumber)
time String
"min_rtt" (RTT -> Microseconds
minRTT RTT
rtt0) (RTT -> Microseconds
minRTT RTT
rtt1)
, forall {a}.
a -> Microseconds -> Microseconds -> Maybe (a, PacketNumber)
time String
"smoothed_rtt" (RTT -> Microseconds
smoothedRTT RTT
rtt0) (RTT -> Microseconds
smoothedRTT RTT
rtt1)
, forall {a}.
a -> Microseconds -> Microseconds -> Maybe (a, PacketNumber)
time String
"latest_rtt" (RTT -> Microseconds
latestRTT RTT
rtt0) (RTT -> Microseconds
latestRTT RTT
rtt1)
, forall {a}.
a -> Microseconds -> Microseconds -> Maybe (a, PacketNumber)
time String
"rtt_variance" (RTT -> Microseconds
rttvar RTT
rtt0) (RTT -> Microseconds
rttvar RTT
rtt1)
, forall {b} {a}. Eq b => a -> b -> b -> Maybe (a, b)
numb String
"pto_count" (RTT -> PacketNumber
ptoCount RTT
rtt0) (RTT -> PacketNumber
ptoCount RTT
rtt1)
, forall {b} {a}. Eq b => a -> b -> b -> Maybe (a, b)
numb String
"bytes_in_flight" (CC -> PacketNumber
bytesInFlight CC
cc0) (CC -> PacketNumber
bytesInFlight CC
cc1)
, forall {b} {a}. Eq b => a -> b -> b -> Maybe (a, b)
numb String
"congestion_window" (CC -> PacketNumber
congestionWindow CC
cc0) (CC -> PacketNumber
congestionWindow CC
cc1)
, forall {b} {a}. Eq b => a -> b -> b -> Maybe (a, b)
numb String
"ssthresh" (CC -> PacketNumber
ssthresh CC
cc0) (CC -> PacketNumber
ssthresh CC
cc1)
]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, PacketNumber)]
diff) forall a b. (a -> b) -> a -> b
$ forall q. KeepQlog q => q -> MetricsDiff -> IO ()
qlogMetricsUpdated LDCC
ldcc forall a b. (a -> b) -> a -> b
$ [(String, PacketNumber)] -> MetricsDiff
MetricsDiff [(String, PacketNumber)]
diff
where
time :: a -> Microseconds -> Microseconds -> Maybe (a, PacketNumber)
time a
tag (Microseconds PacketNumber
v0) (Microseconds PacketNumber
v1)
| PacketNumber
v0 forall a. Eq a => a -> a -> Bool
== PacketNumber
v1 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (a
tag, PacketNumber
v1)
numb :: a -> b -> b -> Maybe (a, b)
numb a
tag b
v0 b
v1
| b
v0 forall a. Eq a => a -> a -> Bool
== b
v1 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (a
tag, b
v1)