{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.QUIC.Recovery.Interface (
checkWindowOpenSTM
, takePingSTM
, speedup
, resender
) where
import Control.Concurrent.STM
import qualified Data.Sequence as Seq
import System.Log.FastLogger (LogStr)
import Network.QUIC.Imports
import Network.QUIC.Qlog
import Network.QUIC.Recovery.Misc
import Network.QUIC.Recovery.Release
import Network.QUIC.Recovery.Timer
import Network.QUIC.Recovery.Types
import Network.QUIC.Recovery.Utils
import Network.QUIC.Types
checkWindowOpenSTM :: LDCC -> Int -> STM ()
checkWindowOpenSTM :: LDCC -> Int -> STM ()
checkWindowOpenSTM 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
timerInfoQ :: LDCC -> TVar TimerInfoQ
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: LDCC -> IORef Int
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 Int
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
..} Int
siz = do
CC{Int
Maybe TimeMicrosecond
CCMode
ccMode :: CC -> CCMode
numOfAckEliciting :: CC -> Int
bytesAcked :: CC -> Int
ssthresh :: CC -> Int
congestionRecoveryStartTime :: CC -> Maybe TimeMicrosecond
congestionWindow :: CC -> Int
bytesInFlight :: CC -> Int
ccMode :: CCMode
numOfAckEliciting :: Int
bytesAcked :: Int
ssthresh :: Int
congestionRecoveryStartTime :: Maybe TimeMicrosecond
congestionWindow :: Int
bytesInFlight :: Int
..} <- TVar CC -> STM CC
forall a. TVar a -> STM a
readTVar TVar CC
recoveryCC
Bool -> STM ()
check (Int
siz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
congestionWindow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bytesInFlight)
takePingSTM :: LDCC -> STM EncryptionLevel
takePingSTM :: LDCC -> STM EncryptionLevel
takePingSTM 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
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef Int
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 Int
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
Maybe EncryptionLevel
mx <- TVar (Maybe EncryptionLevel) -> STM (Maybe EncryptionLevel)
forall a. TVar a -> STM a
readTVar TVar (Maybe EncryptionLevel)
ptoPing
Bool -> STM ()
check (Bool -> STM ()) -> Bool -> STM ()
forall a b. (a -> b) -> a -> b
$ Maybe EncryptionLevel -> Bool
forall a. Maybe a -> Bool
isJust Maybe EncryptionLevel
mx
TVar (Maybe EncryptionLevel) -> Maybe EncryptionLevel -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe EncryptionLevel)
ptoPing Maybe EncryptionLevel
forall a. Maybe a
Nothing
EncryptionLevel -> STM EncryptionLevel
forall (m :: * -> *) a. Monad m => a -> m a
return (EncryptionLevel -> STM EncryptionLevel)
-> EncryptionLevel -> STM EncryptionLevel
forall a b. (a -> b) -> a -> b
$ Maybe EncryptionLevel -> EncryptionLevel
forall a. HasCallStack => Maybe a -> a
fromJust Maybe EncryptionLevel
mx
speedup :: LDCC -> EncryptionLevel -> LogStr -> IO ()
speedup :: LDCC -> EncryptionLevel -> LogStr -> IO ()
speedup 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
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef Int
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 Int
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
lvl LogStr
desc = do
LDCC -> IO ()
setSpeedingUp LDCC
ldcc
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
desc
Seq SentPacket
packets <- IORef SentPackets
-> (SentPackets -> (SentPackets, Seq SentPacket))
-> IO (Seq SentPacket)
forall a b. IORef a -> (a -> (a, b)) -> IO b
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, Seq SentPacket))
-> IO (Seq SentPacket))
-> (SentPackets -> (SentPackets, Seq SentPacket))
-> IO (Seq SentPacket)
forall a b. (a -> b) -> a -> b
$
\(SentPackets Seq SentPacket
db) -> (SentPackets
emptySentPackets, Seq SentPacket
db)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Seq SentPacket -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq SentPacket
packets) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
LDCC -> Seq SentPacket -> IO ()
onPacketsLost LDCC
ldcc Seq SentPacket
packets
LDCC -> Seq SentPacket -> IO ()
retransmit LDCC
ldcc Seq SentPacket
packets
LDCC -> EncryptionLevel -> IO ()
setLossDetectionTimer LDCC
ldcc EncryptionLevel
lvl
resender :: LDCC -> IO ()
resender :: LDCC -> IO ()
resender 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
timerInfoQ :: TVar TimerInfoQ
previousRTT1PPNs :: IORef PeerPacketNumbers
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
pktNumPersistent :: IORef Int
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 Int
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
SentPackets
lostPackets <- TVar SentPackets -> STM SentPackets
forall a. TVar a -> STM a
readTVar TVar SentPackets
lostCandidates
Bool -> STM ()
check (SentPackets
lostPackets SentPackets -> SentPackets -> Bool
forall a. Eq a => a -> a -> Bool
/= SentPackets
emptySentPackets)
Microseconds -> IO ()
delay (Microseconds -> IO ()) -> Microseconds -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Microseconds
Microseconds Int
10000
Seq SentPacket
packets <- STM (Seq SentPacket) -> IO (Seq SentPacket)
forall a. STM a -> IO 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
pkts <- TVar SentPackets -> STM SentPackets
forall a. TVar a -> STM a
readTVar TVar SentPackets
lostCandidates
TVar SentPackets -> SentPackets -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar SentPackets
lostCandidates SentPackets
emptySentPackets
Seq SentPacket -> STM (Seq SentPacket)
forall (m :: * -> *) a. Monad m => a -> m a
return Seq SentPacket
pkts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Seq SentPacket
packets Seq SentPacket -> Seq SentPacket -> Bool
forall a. Eq a => a -> a -> Bool
/= Seq SentPacket
forall a. Seq a
Seq.empty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
LDCC -> Seq SentPacket -> IO ()
onPacketsLost LDCC
ldcc Seq SentPacket
packets
LDCC -> Seq SentPacket -> IO ()
retransmit LDCC
ldcc Seq SentPacket
packets