{-# 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
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 PacketNumber
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 PacketNumber
peerPacketNumbers :: LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: LDCC -> IORef PeerPacketNumbers
timerInfoQ :: LDCC -> TVar TimerInfoQ
..} 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 a. a -> IO a
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
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 PacketNumber
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 PacketNumber
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: IORef PeerPacketNumbers
timerInfoQ :: TVar TimerInfoQ
..} 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 = Nothing
            }
    RTT{PacketNumber
Microseconds
latestRTT :: Microseconds
smoothedRTT :: Microseconds
rttvar :: Microseconds
minRTT :: Microseconds
maxAckDelay1RTT :: Microseconds
ptoCount :: PacketNumber
latestRTT :: RTT -> Microseconds
smoothedRTT :: RTT -> Microseconds
rttvar :: RTT -> Microseconds
minRTT :: RTT -> Microseconds
maxAckDelay1RTT :: RTT -> Microseconds
ptoCount :: RTT -> PacketNumber
..} <- IORef RTT -> IO RTT
forall a. IORef a -> IO a
readIORef IORef RTT
recoveryRTT
    LossDetection{PacketNumber
Maybe TimeMicrosecond
TimeMicrosecond
AckInfo
timeOfLastAckElicitingPacket :: LossDetection -> TimeMicrosecond
lossTime :: LossDetection -> Maybe TimeMicrosecond
largestAckedPacket :: PacketNumber
previousAckInfo :: AckInfo
timeOfLastAckElicitingPacket :: TimeMicrosecond
lossTime :: Maybe TimeMicrosecond
largestAckedPacket :: LossDetection -> PacketNumber
previousAckInfo :: LossDetection -> AckInfo
..} <- 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 a. a -> IO a
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 = Just 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 a. a -> IO a
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
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 PacketNumber
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 PacketNumber
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
previousRTT1PPNs :: IORef PeerPacketNumbers
timerInfoQ :: TVar TimerInfoQ
..} 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 :: forall (t :: * -> *).
Foldable t =>
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