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

module Network.QUIC.Recovery.Detect (
    releaseByPredicate
  , detectAndRemoveLostPackets
  , removePacketNumbers
  ) where

import Data.Sequence (Seq, ViewL(..))
import qualified Data.Sequence as Seq

import Network.QUIC.Imports
import Network.QUIC.Qlog
import Network.QUIC.Recovery.Constants
import Network.QUIC.Recovery.PeerPacketNumbers
import Network.QUIC.Recovery.Types
import Network.QUIC.Types

releaseByPredicate :: LDCC -> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)
releaseByPredicate :: LDCC
-> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)
releaseByPredicate 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 SentPacket -> Bool
predicate = do
    Seq SentPacket
packets <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Array EncryptionLevel (IORef SentPackets)
sentPackets forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl) forall a b. (a -> b) -> a -> b
$ \(SentPackets Seq SentPacket
db) ->
       let (Seq SentPacket
pkts, Seq SentPacket
db') = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.partition SentPacket -> Bool
predicate Seq SentPacket
db
       in (Seq SentPacket -> SentPackets
SentPackets Seq SentPacket
db', Seq SentPacket
pkts)
    forall (t :: * -> *).
Foldable t =>
LDCC -> EncryptionLevel -> t SentPacket -> IO ()
removePacketNumbers LDCC
ldcc EncryptionLevel
lvl Seq SentPacket
packets
    forall (m :: * -> *) a. Monad m => a -> m a
return Seq SentPacket
packets

detectAndRemoveLostPackets :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)
detectAndRemoveLostPackets :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)
detectAndRemoveLostPackets 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 = do
    TimeMicrosecond
lae <- LossDetection -> TimeMicrosecond
timeOfLastAckElicitingPacket forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef (Array EncryptionLevel (IORef LossDetection)
lossDetection forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeMicrosecond
lae forall a. Eq a => a -> a -> Bool
== TimeMicrosecond
timeMicrosecond0) forall a b. (a -> b) -> a -> b
$
        forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug LDCC
ldcc forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"detectAndRemoveLostPackets: timeOfLastAckElicitingPacket: 0"
    forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' (Array EncryptionLevel (IORef LossDetection)
lossDetection forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl) forall a b. (a -> b) -> a -> b
$ \LossDetection
ld -> LossDetection
ld {
          lossTime :: Maybe TimeMicrosecond
lossTime = forall a. Maybe a
Nothing
        }
    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
..} <- forall a. IORef a -> IO a
readIORef IORef RTT
recoveryRTT
    LossDetection{PacketNumber
Maybe TimeMicrosecond
TimeMicrosecond
AckInfo
previousAckInfo :: LossDetection -> AckInfo
largestAckedPacket :: LossDetection -> PacketNumber
lossTime :: Maybe TimeMicrosecond
timeOfLastAckElicitingPacket :: TimeMicrosecond
previousAckInfo :: AckInfo
largestAckedPacket :: PacketNumber
lossTime :: LossDetection -> Maybe TimeMicrosecond
timeOfLastAckElicitingPacket :: LossDetection -> TimeMicrosecond
..} <- forall a. IORef a -> IO a
readIORef (Array EncryptionLevel (IORef LossDetection)
lossDetection forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PacketNumber
largestAckedPacket forall a. Eq a => a -> a -> Bool
== -PacketNumber
1) forall a b. (a -> b) -> a -> b
$
        forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug LDCC
ldcc forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"detectAndRemoveLostPackets: largestAckedPacket: -1"
    -- Sec 6.1.2. Time Threshold
    -- max(kTimeThreshold * max(smoothed_rtt, latest_rtt), kGranularity)
    let lossDelay0 :: Microseconds
lossDelay0 = Microseconds -> Microseconds
kTimeThreshold forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Microseconds
latestRTT Microseconds
smoothedRTT
    let lossDelay :: Microseconds
lossDelay = forall a. Ord a => a -> a -> a
max Microseconds
lossDelay0 Microseconds
kGranularity

    TimeMicrosecond
tm <- Microseconds -> IO TimeMicrosecond
getPastTimeMicrosecond Microseconds
lossDelay
    let predicate :: SentPacket -> Bool
predicate SentPacket
ent = (SentPacket -> PacketNumber
spPacketNumber SentPacket
ent forall a. Ord a => a -> a -> Bool
<= PacketNumber
largestAckedPacket forall a. Num a => a -> a -> a
- PacketNumber
kPacketThreshold)
                     Bool -> Bool -> Bool
|| (SentPacket -> PacketNumber
spPacketNumber SentPacket
ent forall a. Ord a => a -> a -> Bool
<= PacketNumber
largestAckedPacket Bool -> Bool -> Bool
&& SentPacket -> TimeMicrosecond
spTimeSent SentPacket
ent forall a. Ord a => a -> a -> Bool
<= TimeMicrosecond
tm)
    Seq SentPacket
lostPackets <- LDCC
-> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)
releaseByPredicate LDCC
ldcc EncryptionLevel
lvl SentPacket -> Bool
predicate

    Maybe SentPacket
mx <- LDCC
-> EncryptionLevel -> (SentPacket -> Bool) -> IO (Maybe SentPacket)
findOldest LDCC
ldcc EncryptionLevel
lvl (\SentPacket
x -> SentPacket -> PacketNumber
spPacketNumber SentPacket
x forall a. Ord a => a -> a -> Bool
<= PacketNumber
largestAckedPacket)
    case Maybe SentPacket
mx of
      -- No gap packet. PTO turn.
      Maybe SentPacket
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      -- There are gap packets which are not declared lost.
      -- Set lossTime to next.
      Just SentPacket
x  -> do
          let next :: TimeMicrosecond
next = SentPacket -> TimeMicrosecond
spTimeSent SentPacket
x TimeMicrosecond -> Microseconds -> TimeMicrosecond
`addMicroseconds` Microseconds
lossDelay
          forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' (Array EncryptionLevel (IORef LossDetection)
lossDetection forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl) forall a b. (a -> b) -> a -> b
$ \LossDetection
ld -> LossDetection
ld {
                lossTime :: Maybe TimeMicrosecond
lossTime = forall a. a -> Maybe a
Just TimeMicrosecond
next
              }

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Seq a -> Bool
Seq.null Seq SentPacket
lostPackets) forall a b. (a -> b) -> a -> b
$ forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug LDCC
ldcc forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"loss detected"
    forall (m :: * -> *) a. Monad m => a -> m a
return Seq SentPacket
lostPackets

findOldest :: LDCC -> EncryptionLevel -> (SentPacket -> Bool)
           -> IO (Maybe SentPacket)
findOldest :: LDCC
-> EncryptionLevel -> (SentPacket -> Bool) -> IO (Maybe SentPacket)
findOldest 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
p = SentPackets -> Maybe SentPacket
oldest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef (Array EncryptionLevel (IORef SentPackets)
sentPackets forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl)
  where
    oldest :: SentPackets -> Maybe SentPacket
oldest (SentPackets Seq SentPacket
db) = case forall a. Seq a -> ViewL a
Seq.viewl forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter SentPacket -> Bool
p Seq SentPacket
db of
      ViewL SentPacket
EmptyL -> forall a. Maybe a
Nothing
      SentPacket
x :< Seq SentPacket
_ -> forall a. a -> Maybe a
Just SentPacket
x

removePacketNumbers :: Foldable t => LDCC -> EncryptionLevel -> t SentPacket -> IO ()
removePacketNumbers :: forall (t :: * -> *).
Foldable t =>
LDCC -> EncryptionLevel -> t SentPacket -> IO ()
removePacketNumbers LDCC
ldcc EncryptionLevel
lvl t SentPacket
packets = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SentPacket -> IO ()
reduce t SentPacket
packets
  where
    reduce :: SentPacket -> IO ()
reduce SentPacket
x = LDCC -> EncryptionLevel -> PeerPacketNumbers -> IO ()
reducePeerPacketNumbers LDCC
ldcc EncryptionLevel
lvl PeerPacketNumbers
ppns
      where
        ppns :: PeerPacketNumbers
ppns = SentPacket -> PeerPacketNumbers
spPeerPacketNumbers SentPacket
x