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

module Network.QUIC.Recovery.Interface (
    checkWindowOpenSTM,
    takePingSTM,
    speedup,
    resender,
) where

import qualified Data.Sequence as Seq
import System.Log.FastLogger (LogStr)
import UnliftIO.STM

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
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
..} Int
siz = do
    CC{Int
Maybe TimeMicrosecond
CCMode
bytesInFlight :: Int
congestionWindow :: Int
congestionRecoveryStartTime :: Maybe TimeMicrosecond
ssthresh :: Int
bytesAcked :: Int
numOfAckEliciting :: Int
ccMode :: CCMode
bytesInFlight :: CC -> Int
congestionWindow :: CC -> Int
congestionRecoveryStartTime :: CC -> Maybe TimeMicrosecond
ssthresh :: CC -> Int
bytesAcked :: CC -> Int
numOfAckEliciting :: CC -> Int
ccMode :: CC -> CCMode
..} <- TVar CC -> STM CC
forall a. TVar a -> STM a
readTVar TVar CC
recoveryCC
    Bool -> STM ()
checkSTM (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
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
..} = do
    Maybe EncryptionLevel
mx <- TVar (Maybe EncryptionLevel) -> STM (Maybe EncryptionLevel)
forall a. TVar a -> STM a
readTVar TVar (Maybe EncryptionLevel)
ptoPing
    Bool -> STM ()
checkSTM (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 a. a -> STM a
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
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 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)
    -- don't clear PeerPacketNumbers.
    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
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
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
..} = 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 (m :: * -> *) a. MonadIO m => STM a -> m 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 ()
checkSTM (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 -- fixme
    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
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 a. a -> STM a
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