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

module Network.QUIC.Recovery.Release (
    releaseByRetry,
    releaseOldest,
    discard,
    onPacketsLost,
) where

import Data.Sequence (Seq, ViewL (..), ViewR (..), (><))
import qualified Data.Sequence as Seq
import UnliftIO.STM

import Network.QUIC.Imports
import Network.QUIC.Recovery.Metrics
import Network.QUIC.Recovery.PeerPacketNumbers
import Network.QUIC.Recovery.Types
import Network.QUIC.Recovery.Utils
import Network.QUIC.Types

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

discard :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)
discard :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)
discard 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 = do
    Seq SentPacket
packets <- LDCC -> EncryptionLevel -> IO (Seq SentPacket)
releaseByClear LDCC
ldcc EncryptionLevel
lvl
    forall (m :: * -> *).
(Functor m, Foldable m) =>
LDCC -> m SentPacket -> IO ()
decreaseCC LDCC
ldcc Seq SentPacket
packets
    forall a. IORef a -> a -> IO ()
writeIORef (Array EncryptionLevel (IORef LossDetection)
lossDetection forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl) LossDetection
initialLossDetection
    LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc forall a b. (a -> b) -> a -> b
$
        forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' IORef RTT
recoveryRTT forall a b. (a -> b) -> a -> b
$
            \RTT
rtt -> RTT
rtt{ptoCount :: PacketNumber
ptoCount = PacketNumber
0}
    forall (m :: * -> *) a. Monad m => a -> m a
return Seq SentPacket
packets

releaseByClear :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)
releaseByClear :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)
releaseByClear 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
    LDCC -> EncryptionLevel -> IO ()
clearPeerPacketNumbers LDCC
ldcc EncryptionLevel
lvl
    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) ->
        (SentPackets
emptySentPackets, Seq SentPacket
db)

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

releaseByRetry :: LDCC -> IO (Seq PlainPacket)
releaseByRetry :: LDCC -> IO (Seq PlainPacket)
releaseByRetry LDCC
ldcc = do
    Seq SentPacket
packets <- LDCC -> EncryptionLevel -> IO (Seq SentPacket)
discard LDCC
ldcc EncryptionLevel
InitialLevel
    forall (m :: * -> *) a. Monad m => a -> m a
return (SentPacket -> PlainPacket
spPlainPacket forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq SentPacket
packets)

-- Returning the oldest if it is ack-eliciting.
releaseOldest :: LDCC -> EncryptionLevel -> IO (Maybe SentPacket)
releaseOldest :: LDCC -> EncryptionLevel -> IO (Maybe SentPacket)
releaseOldest 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
    Maybe SentPacket
mr <- 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) SentPackets -> (SentPackets, Maybe SentPacket)
oldest
    case Maybe SentPacket
mr of
        Maybe SentPacket
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just SentPacket
spkt -> do
            LDCC -> EncryptionLevel -> PacketNumber -> IO ()
delPeerPacketNumbers LDCC
ldcc EncryptionLevel
lvl forall a b. (a -> b) -> a -> b
$ SentPacket -> PacketNumber
spPacketNumber SentPacket
spkt
            forall (m :: * -> *).
(Functor m, Foldable m) =>
LDCC -> m SentPacket -> IO ()
decreaseCC LDCC
ldcc [SentPacket
spkt]
    forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SentPacket
mr
  where
    oldest :: SentPackets -> (SentPackets, Maybe SentPacket)
oldest (SentPackets Seq SentPacket
db) = case forall a. Seq a -> ViewL a
Seq.viewl Seq SentPacket
db2 of
        SentPacket
x :< Seq SentPacket
db2' ->
            let db' :: Seq SentPacket
db' = Seq SentPacket
db1 forall a. Seq a -> Seq a -> Seq a
>< Seq SentPacket
db2'
             in (Seq SentPacket -> SentPackets
SentPackets Seq SentPacket
db', forall a. a -> Maybe a
Just SentPacket
x)
        ViewL SentPacket
_ -> (Seq SentPacket -> SentPackets
SentPackets Seq SentPacket
db, forall a. Maybe a
Nothing)
      where
        (Seq SentPacket
db1, Seq SentPacket
db2) = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl SentPacket -> Bool
spAckEliciting Seq SentPacket
db

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

onPacketsLost :: LDCC -> Seq SentPacket -> IO ()
onPacketsLost :: LDCC -> Seq SentPacket -> IO ()
onPacketsLost 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
lostPackets = case forall a. Seq a -> ViewR a
Seq.viewr Seq SentPacket
lostPackets of
    ViewR SentPacket
EmptyR -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Seq SentPacket
_ :> SentPacket
lastPkt -> do
        forall (m :: * -> *).
(Functor m, Foldable m) =>
LDCC -> m SentPacket -> IO ()
decreaseCC LDCC
ldcc Seq SentPacket
lostPackets
        Bool
isRecovery <-
            TimeMicrosecond -> Maybe TimeMicrosecond -> Bool
inCongestionRecovery (SentPacket -> TimeMicrosecond
spTimeSent SentPacket
lastPkt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CC -> Maybe TimeMicrosecond
congestionRecoveryStartTime
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar CC
recoveryCC
        LDCC -> Seq SentPacket -> Bool -> IO ()
onCongestionEvent LDCC
ldcc Seq SentPacket
lostPackets Bool
isRecovery
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall q. KeepQlog q => q -> LostPacket -> IO ()
qlogPacketLost LDCC
ldcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. SentPacket -> LostPacket
LostPacket) Seq SentPacket
lostPackets
  where
    onCongestionEvent :: LDCC -> Seq SentPacket -> Bool -> IO ()
onCongestionEvent = LDCC -> Seq SentPacket -> Bool -> IO ()
updateCC

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

decreaseCC :: (Functor m, Foldable m) => LDCC -> m SentPacket -> IO ()
decreaseCC :: forall (m :: * -> *).
(Functor m, Foldable m) =>
LDCC -> m SentPacket -> IO ()
decreaseCC 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
..} m SentPacket
packets = do
    let sentBytes :: PacketNumber
sentBytes = forall (f :: * -> *).
(Functor f, Foldable f) =>
f PacketNumber -> PacketNumber
sum' (SentPacket -> PacketNumber
spSentBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SentPacket
packets)
        num :: PacketNumber
num = forall (f :: * -> *).
(Functor f, Foldable f) =>
f PacketNumber -> PacketNumber
sum' (SentPacket -> PacketNumber
countAckEli forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SentPacket
packets)
    LDCC -> IO () -> IO ()
metricsUpdated LDCC
ldcc forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$
            forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CC
recoveryCC forall a b. (a -> b) -> a -> b
$ \CC
cc ->
                CC
cc
                    { bytesInFlight :: PacketNumber
bytesInFlight = CC -> PacketNumber
bytesInFlight CC
cc forall a. Num a => a -> a -> a
- PacketNumber
sentBytes
                    , numOfAckEliciting :: PacketNumber
numOfAckEliciting = CC -> PacketNumber
numOfAckEliciting CC
cc forall a. Num a => a -> a -> a
- PacketNumber
num
                    }