{-# 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 <- 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) ->
       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
       in (Seq SentPacket -> SentPackets
SentPackets Seq SentPacket
db', 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

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 (LossDetection -> TimeMicrosecond)
-> IO LossDetection -> IO TimeMicrosecond
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef LossDetection -> IO LossDetection
forall a. IORef a -> IO a
readIORef (Array EncryptionLevel (IORef LossDetection)
lossDetection Array EncryptionLevel (IORef LossDetection)
-> EncryptionLevel -> IORef LossDetection
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeMicrosecond
lae TimeMicrosecond -> TimeMicrosecond -> Bool
forall a. Eq a => a -> a -> Bool
== TimeMicrosecond
timeMicrosecond0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        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
"detectAndRemoveLostPackets: timeOfLastAckElicitingPacket: 0"
    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 {
          lossTime :: Maybe TimeMicrosecond
lossTime = Maybe TimeMicrosecond
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
..} <- IORef RTT -> IO RTT
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
..} <- IORef LossDetection -> IO LossDetection
forall a. IORef a -> IO a
readIORef (Array EncryptionLevel (IORef LossDetection)
lossDetection Array EncryptionLevel (IORef LossDetection)
-> EncryptionLevel -> IORef LossDetection
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PacketNumber
largestAckedPacket PacketNumber -> PacketNumber -> Bool
forall a. Eq a => a -> a -> Bool
== -PacketNumber
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        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
"detectAndRemoveLostPackets: largestAckedPacket: -1"
    -- Sec 6.1.2. Time Threshold
    -- max(kTimeThreshold * max(smoothed_rtt, latest_rtt), kGranularity)
    let lossDelay0 :: Microseconds
lossDelay0 = Microseconds -> Microseconds
kTimeThreshold (Microseconds -> Microseconds) -> Microseconds -> Microseconds
forall a b. (a -> b) -> a -> b
$ Microseconds -> Microseconds -> Microseconds
forall a. Ord a => a -> a -> a
max Microseconds
latestRTT Microseconds
smoothedRTT
    let lossDelay :: Microseconds
lossDelay = Microseconds -> Microseconds -> Microseconds
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 PacketNumber -> PacketNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= PacketNumber
largestAckedPacket PacketNumber -> PacketNumber -> PacketNumber
forall a. Num a => a -> a -> a
- PacketNumber
kPacketThreshold)
                     Bool -> Bool -> Bool
|| (SentPacket -> PacketNumber
spPacketNumber SentPacket
ent PacketNumber -> PacketNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= PacketNumber
largestAckedPacket Bool -> Bool -> Bool
&& SentPacket -> TimeMicrosecond
spTimeSent SentPacket
ent TimeMicrosecond -> TimeMicrosecond -> Bool
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 PacketNumber -> PacketNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= PacketNumber
largestAckedPacket)
    case Maybe SentPacket
mx of
      -- No gap packet. PTO turn.
      Maybe SentPacket
Nothing -> () -> IO ()
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
          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 {
                lossTime :: Maybe TimeMicrosecond
lossTime = TimeMicrosecond -> Maybe TimeMicrosecond
forall a. a -> Maybe a
Just TimeMicrosecond
next
              }

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

removePacketNumbers :: Foldable t => LDCC -> EncryptionLevel -> t SentPacket -> IO ()
removePacketNumbers :: LDCC -> EncryptionLevel -> t SentPacket -> IO ()
removePacketNumbers LDCC
ldcc EncryptionLevel
lvl t SentPacket
packets = (SentPacket -> IO ()) -> t SentPacket -> IO ()
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