Release.hs

{-# LANGUAGE RecordWildCards #-}

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

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

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@LDCC{..} lvl = do
    packets <- releaseByClear ldcc lvl
    decreaseCC ldcc packets
    writeIORef (lossDetection ! lvl) initialLossDetection
    metricsUpdated ldcc $
        atomicModifyIORef'' recoveryRTT $
            \rtt -> rtt{ptoCount = 0}
    return packets

releaseByClear :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)
releaseByClear ldcc@LDCC{..} lvl = do
    clearPeerPacketNumbers ldcc lvl
    atomicModifyIORef' (sentPackets ! lvl) $ \(SentPackets db) ->
        (emptySentPackets, db)

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

releaseByRetry :: LDCC -> IO (Seq PlainPacket)
releaseByRetry ldcc = do
    packets <- discard ldcc InitialLevel
    return (spPlainPacket <$> packets)

-- Returning the oldest if it is ack-eliciting.
releaseOldest :: LDCC -> EncryptionLevel -> IO (Maybe SentPacket)
releaseOldest ldcc@LDCC{..} lvl = do
    mr <- atomicModifyIORef' (sentPackets ! lvl) oldest
    case mr of
        Nothing -> return ()
        Just spkt -> decreaseCC ldcc [spkt]
    return mr
  where
    oldest (SentPackets db) = case Seq.viewl db2 of
        x :< db2' ->
            let db' = db1 >< db2'
             in (SentPackets db', Just x)
        _ -> (SentPackets db, Nothing)
      where
        (db1, db2) = Seq.breakl spAckEliciting db

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

onPacketsLost :: LDCC -> Seq SentPacket -> IO ()
onPacketsLost ldcc@LDCC{..} lostPackets = case Seq.viewr lostPackets of
    EmptyR -> return ()
    _ :> lastPkt -> do
        decreaseCC ldcc lostPackets
        isRecovery <-
            inCongestionRecovery (spTimeSent lastPkt) . congestionRecoveryStartTime
                <$> readTVarIO recoveryCC
        onCongestionEvent ldcc lostPackets isRecovery
        mapM_ (qlogPacketLost ldcc . LostPacket) lostPackets
  where
    onCongestionEvent = updateCC

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

decreaseCC :: (Functor m, Foldable m) => LDCC -> m SentPacket -> IO ()
decreaseCC ldcc@LDCC{..} packets = do
    let sentBytes = sum' (spSentBytes <$> packets)
        num = sum' (countAckEli <$> packets)
    metricsUpdated ldcc $
        atomically $
            modifyTVar' recoveryCC $ \cc ->
                cc
                    { bytesInFlight = bytesInFlight cc - sentBytes
                    , numOfAckEliciting = numOfAckEliciting cc - num
                    }