{-# 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)
    -- don't clear PeerPacketNumbers.
    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 -- fixme
    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