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

module Network.QUIC.Recovery.LossRecovery (
    onPacketSent
  , onPacketReceived
  , onAckReceived
  , onPacketNumberSpaceDiscarded
  ) where

import Control.Concurrent.STM
import Data.Sequence (Seq, (|>), ViewR(..))
import qualified Data.Sequence as Seq

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 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
..} 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 :: TimeMicrosecond
timeOfLastAckElicitingPacket = SentPacket -> TimeMicrosecond
spTimeSent SentPacket
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 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
..} SentPacket
sentPacket = LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    STM () -> IO ()
forall a. STM a -> IO 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 :: PacketNumber
bytesInFlight = CC -> PacketNumber
bytesInFlight CC
cc PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
+ PacketNumber
sentBytes
      , numOfAckEliciting :: PacketNumber
numOfAckEliciting = CC -> PacketNumber
numOfAckEliciting CC
cc PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
+ SentPacket -> PacketNumber
countAckEli SentPacket
sentPacket
      }
  where
    sentBytes :: PacketNumber
sentBytes = SentPacket -> PacketNumber
spSentBytes SentPacket
sentPacket

----------------------------------------------------------------

onPacketReceived :: LDCC -> EncryptionLevel -> PacketNumber -> IO ()
onPacketReceived :: LDCC -> EncryptionLevel -> PacketNumber -> IO ()
onPacketReceived LDCC
ldcc EncryptionLevel
lvl PacketNumber
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 -> PacketNumber -> IO ()
addPeerPacketNumbers LDCC
ldcc EncryptionLevel
lvl PacketNumber
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 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
..} EncryptionLevel
lvl ackInfo :: AckInfo
ackInfo@(AckInfo PacketNumber
largestAcked PacketNumber
_ [(PacketNumber, PacketNumber)]
_) 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 -> PacketNumber -> Bool
fromAckInfoToPred AckInfo
ackInfo (PacketNumber -> Bool)
-> (SentPacket -> PacketNumber) -> SentPacket -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SentPacket -> PacketNumber
spPacketNumber
        LDCC
-> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)
releaseLostCandidates LDCC
ldcc EncryptionLevel
lvl SentPacket -> Bool
predicate IO (Seq SentPacket) -> (Seq SentPacket -> IO ()) -> IO ()
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 (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{PacketNumber
Maybe TimeMicrosecond
TimeMicrosecond
AckInfo
lossTime :: LossDetection -> Maybe TimeMicrosecond
previousAckInfo :: LossDetection -> AckInfo
largestAckedPacket :: LossDetection -> PacketNumber
lossTime :: Maybe TimeMicrosecond
timeOfLastAckElicitingPacket :: TimeMicrosecond
previousAckInfo :: AckInfo
largestAckedPacket :: PacketNumber
timeOfLastAckElicitingPacket :: LossDetection -> TimeMicrosecond
..} = (LossDetection
ld', Bool
changed)
      where
        ld' :: LossDetection
ld' = LossDetection
ld { largestAckedPacket :: PacketNumber
largestAckedPacket = PacketNumber -> PacketNumber -> PacketNumber
forall a. Ord a => a -> a -> a
max PacketNumber
largestAckedPacket PacketNumber
largestAcked
                 , previousAckInfo :: AckInfo
previousAckInfo = AckInfo
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 (m :: * -> *) a. Monad m => a -> m a
return ()
      Seq SentPacket
_ :> SentPacket
lastPkt -> do
          -- If the largest acknowledged is newly acked and
          -- at least one ack-eliciting was newly acked, update the RTT.
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SentPacket -> PacketNumber
spPacketNumber SentPacket
lastPkt PacketNumber -> PacketNumber -> Bool
forall a. Eq a => a -> a -> Bool
== PacketNumber
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

          {- fimxe
          -- Process ECN information if present.
          if (ACK frame contains ECN information):
             ProcessECN(ack, lvl)
          -}

          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 (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 a. TVar a -> IO 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
                  -- just in case
                  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'
          -- setLossDetectionTimer in updateCConAck
          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 (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = do
          LDCC -> Seq SentPacket -> IO ()
onPacketsAcked LDCC
ldcc Seq SentPacket
newlyAckedPackets

          -- Sec 6.2.1. Computing PTO
          -- "The PTO backoff factor is reset when an acknowledgement is
          --  received, except in the following case. A server might
          --  take longer to respond to packets during the handshake
          --  than otherwise. To protect such a server from repeated
          --  client probes, the PTO backoff is not reset at a client
          --  that is not yet certain that the server has finished
          --  validating the client's address."
          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 :: PacketNumber
ptoCount = PacketNumber
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 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
..} EncryptionLevel
lvl SentPacket -> Bool
predicate = do
    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
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 (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 (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 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
ackedPackets = LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    PacketNumber
maxPktSiz <- LDCC -> IO PacketNumber
forall a. Connector a => a -> IO PacketNumber
getMaxPacketSize LDCC
ldcc
    CC
oldcc <- TVar CC -> IO CC
forall a. TVar a -> IO a
readTVarIO TVar CC
recoveryCC
    STM () -> IO ()
forall a. STM a -> IO 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
$ PacketNumber -> CC -> CC
modify PacketNumber
maxPktSiz
    CC
newcc <- TVar CC -> IO CC
forall a. TVar a -> IO 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 :: PacketNumber -> CC -> CC
modify PacketNumber
maxPktSiz cc :: CC
cc@CC{PacketNumber
Maybe TimeMicrosecond
CCMode
bytesAcked :: CC -> PacketNumber
ssthresh :: CC -> PacketNumber
congestionRecoveryStartTime :: CC -> Maybe TimeMicrosecond
congestionWindow :: CC -> PacketNumber
ccMode :: CCMode
numOfAckEliciting :: PacketNumber
bytesAcked :: PacketNumber
ssthresh :: PacketNumber
congestionRecoveryStartTime :: Maybe TimeMicrosecond
congestionWindow :: PacketNumber
bytesInFlight :: PacketNumber
ccMode :: CC -> CCMode
numOfAckEliciting :: CC -> PacketNumber
bytesInFlight :: CC -> PacketNumber
..} = CC
cc {
           bytesInFlight :: PacketNumber
bytesInFlight = PacketNumber
bytesInFlight'
         , congestionWindow :: PacketNumber
congestionWindow = PacketNumber
congestionWindow'
         , bytesAcked :: PacketNumber
bytesAcked = PacketNumber
bytesAcked'
         , ccMode :: CCMode
ccMode = CCMode
ccMode'
         , numOfAckEliciting :: PacketNumber
numOfAckEliciting = PacketNumber
numOfAckEliciting'
         }
      where
        (PacketNumber
bytesInFlight',PacketNumber
congestionWindow',PacketNumber
bytesAcked',CCMode
ccMode',PacketNumber
numOfAckEliciting') =
              ((PacketNumber, PacketNumber, PacketNumber, CCMode, PacketNumber)
 -> SentPacket
 -> (PacketNumber, PacketNumber, PacketNumber, CCMode,
     PacketNumber))
-> (PacketNumber, PacketNumber, PacketNumber, CCMode, PacketNumber)
-> Seq SentPacket
-> (PacketNumber, PacketNumber, PacketNumber, CCMode, PacketNumber)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (PacketNumber, PacketNumber, PacketNumber, CCMode, PacketNumber)
-> SentPacket
-> (PacketNumber, PacketNumber, PacketNumber, CCMode, PacketNumber)
forall d.
(PacketNumber, PacketNumber, PacketNumber, d, PacketNumber)
-> SentPacket
-> (PacketNumber, PacketNumber, PacketNumber, CCMode, PacketNumber)
(.+) (PacketNumber
bytesInFlight,PacketNumber
congestionWindow,PacketNumber
bytesAcked,CCMode
ccMode,PacketNumber
numOfAckEliciting) Seq SentPacket
ackedPackets
        (PacketNumber
bytes,PacketNumber
cwin,PacketNumber
acked,d
_,PacketNumber
cnt) .+ :: (PacketNumber, PacketNumber, PacketNumber, d, PacketNumber)
-> SentPacket
-> (PacketNumber, PacketNumber, PacketNumber, CCMode, PacketNumber)
.+ sp :: SentPacket
sp@SentPacket{Bool
PacketNumber
TimeMicrosecond
PeerPacketNumbers
EncryptionLevel
PlainPacket
spPeerPacketNumbers :: SentPacket -> PeerPacketNumbers
spPlainPacket :: SentPacket -> PlainPacket
spAckEliciting :: Bool
spPeerPacketNumbers :: PeerPacketNumbers
spPacketNumber :: PacketNumber
spEncryptionLevel :: EncryptionLevel
spSentBytes :: PacketNumber
spTimeSent :: TimeMicrosecond
spPlainPacket :: PlainPacket
spPacketNumber :: SentPacket -> PacketNumber
spSentBytes :: SentPacket -> PacketNumber
spTimeSent :: SentPacket -> TimeMicrosecond
spAckEliciting :: SentPacket -> Bool
spEncryptionLevel :: SentPacket -> EncryptionLevel
..} = (PacketNumber
bytes',PacketNumber
cwin',PacketNumber
acked',CCMode
mode',PacketNumber
cnt')
          where
            isRecovery :: Bool
isRecovery = TimeMicrosecond -> Maybe TimeMicrosecond -> Bool
inCongestionRecovery TimeMicrosecond
spTimeSent Maybe TimeMicrosecond
congestionRecoveryStartTime
            bytes' :: PacketNumber
bytes' = PacketNumber
bytes PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
- PacketNumber
spSentBytes
            ackedA :: PacketNumber
ackedA = PacketNumber
acked PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
+ PacketNumber
spSentBytes
            cnt' :: PacketNumber
cnt' = PacketNumber
cnt PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
- SentPacket -> PacketNumber
countAckEli SentPacket
sp
            (PacketNumber
cwin',PacketNumber
acked',CCMode
mode')
              -- Do not increase congestion window in recovery period.
              | Bool
isRecovery      = (PacketNumber
cwin, PacketNumber
acked, CCMode
Recovery)
              -- fixme: Do not increase congestion_window if application
              -- limited or flow control limited.
              --
              -- Slow start.
              | PacketNumber
cwin PacketNumber -> PacketNumber -> Bool
forall a. Ord a => a -> a -> Bool
< PacketNumber
ssthresh = (PacketNumber
cwin PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
+ PacketNumber
spSentBytes, PacketNumber
acked, CCMode
SlowStart)
              -- Congestion avoidance.
              -- In this implementation, maxPktSiz == spSentBytes.
              -- spSentBytes is large enough, so we don't care
              -- the roundup issue of `div`.
              | PacketNumber
ackedA PacketNumber -> PacketNumber -> Bool
forall a. Ord a => a -> a -> Bool
>= PacketNumber
cwin  = (PacketNumber
cwin PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
+ PacketNumber
maxPktSiz, PacketNumber
ackedA PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
- PacketNumber
cwin, CCMode
Avoidance)
              | Bool
otherwise       = (PacketNumber
cwin, PacketNumber
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'