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

module Network.QUIC.Recovery.Types (
    SentPacket (..),
    mkSentPacket,
    fixSentPacket,
    LostPacket (..),
    SentPackets (..),
    emptySentPackets,
    RTT (..),
    initialRTT,
    CCMode (..),
    CC (..),
    initialCC,
    LossDetection (..),
    initialLossDetection,
    MetricsDiff (..),
    TimerType (..),
    TimerInfo (..),
    TimerInfoQ (..),
    TimerCancelled,
    TimerExpired,
    makeSentPackets,
    makeLossDetection,
    LDCC (..),
    newLDCC,
    qlogSent,
    qlogMetricsUpdated,
    qlogPacketLost,
    qlogContestionStateUpdated,
    qlogLossTimerUpdated,
    qlogLossTimerCancelled,
    qlogLossTimerExpired,
) where

import Data.IORef
import Data.List (intersperse)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Network.QUIC.Event
import System.Log.FastLogger
import UnliftIO.STM

import Network.QUIC.Connector
import Network.QUIC.Imports
import Network.QUIC.Qlog
import Network.QUIC.Types

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

data SentPacket = SentPacket
    { SentPacket -> PlainPacket
spPlainPacket :: PlainPacket
    , SentPacket -> TimeMicrosecond
spTimeSent :: TimeMicrosecond
    , SentPacket -> Int
spSentBytes :: Int
    , SentPacket -> EncryptionLevel
spEncryptionLevel :: EncryptionLevel
    , SentPacket -> Int
spPacketNumber :: PacketNumber
    , SentPacket -> PeerPacketNumbers
spPeerPacketNumbers :: PeerPacketNumbers
    , SentPacket -> Bool
spAckEliciting :: Bool
    }
    deriving (SentPacket -> SentPacket -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SentPacket -> SentPacket -> Bool
$c/= :: SentPacket -> SentPacket -> Bool
== :: SentPacket -> SentPacket -> Bool
$c== :: SentPacket -> SentPacket -> Bool
Eq, Int -> SentPacket -> ShowS
[SentPacket] -> ShowS
SentPacket -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SentPacket] -> ShowS
$cshowList :: [SentPacket] -> ShowS
show :: SentPacket -> String
$cshow :: SentPacket -> String
showsPrec :: Int -> SentPacket -> ShowS
$cshowsPrec :: Int -> SentPacket -> ShowS
Show)

instance Ord SentPacket where
    SentPacket
x <= :: SentPacket -> SentPacket -> Bool
<= SentPacket
y = SentPacket -> Int
spPacketNumber SentPacket
x forall a. Ord a => a -> a -> Bool
<= SentPacket -> Int
spPacketNumber SentPacket
y

newtype LostPacket = LostPacket SentPacket

mkSentPacket
    :: PacketNumber
    -> EncryptionLevel
    -> PlainPacket
    -> PeerPacketNumbers
    -> Bool
    -> SentPacket
mkSentPacket :: Int
-> EncryptionLevel
-> PlainPacket
-> PeerPacketNumbers
-> Bool
-> SentPacket
mkSentPacket Int
mypn EncryptionLevel
lvl PlainPacket
ppkt PeerPacketNumbers
ppns Bool
ackeli =
    SentPacket
        { spPlainPacket :: PlainPacket
spPlainPacket = PlainPacket
ppkt
        , spTimeSent :: TimeMicrosecond
spTimeSent = TimeMicrosecond
timeMicrosecond0
        , spSentBytes :: Int
spSentBytes = Int
0
        , spEncryptionLevel :: EncryptionLevel
spEncryptionLevel = EncryptionLevel
lvl
        , spPacketNumber :: Int
spPacketNumber = Int
mypn
        , spPeerPacketNumbers :: PeerPacketNumbers
spPeerPacketNumbers = PeerPacketNumbers
ppns
        , spAckEliciting :: Bool
spAckEliciting = Bool
ackeli
        }

fixSentPacket :: SentPacket -> Int -> Int -> SentPacket
fixSentPacket :: SentPacket -> Int -> Int -> SentPacket
fixSentPacket SentPacket
spkt Int
bytes Int
padLen =
    SentPacket
spkt
        { spPlainPacket :: PlainPacket
spPlainPacket =
            if Int
padLen forall a. Eq a => a -> a -> Bool
/= Int
0
                then Int -> PlainPacket -> PlainPacket
addPadding Int
padLen forall a b. (a -> b) -> a -> b
$ SentPacket -> PlainPacket
spPlainPacket SentPacket
spkt
                else SentPacket -> PlainPacket
spPlainPacket SentPacket
spkt
        , spSentBytes :: Int
spSentBytes = Int
bytes
        }

addPadding :: Int -> PlainPacket -> PlainPacket
addPadding :: Int -> PlainPacket -> PlainPacket
addPadding Int
n (PlainPacket Header
hdr Plain
plain) = Header -> Plain -> PlainPacket
PlainPacket Header
hdr Plain
plain'
  where
    plain' :: Plain
plain' =
        Plain
plain
            { plainFrames :: [Frame]
plainFrames = Plain -> [Frame]
plainFrames Plain
plain forall a. [a] -> [a] -> [a]
++ [Int -> Frame
Padding Int
n]
            }

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

newtype SentPackets = SentPackets (Seq SentPacket) deriving (SentPackets -> SentPackets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SentPackets -> SentPackets -> Bool
$c/= :: SentPackets -> SentPackets -> Bool
== :: SentPackets -> SentPackets -> Bool
$c== :: SentPackets -> SentPackets -> Bool
Eq)

emptySentPackets :: SentPackets
emptySentPackets :: SentPackets
emptySentPackets = Seq SentPacket -> SentPackets
SentPackets forall a. Seq a
Seq.empty

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

data RTT = RTT
    { RTT -> Microseconds
latestRTT :: Microseconds
    -- ^ The most recent RTT measurement made when receiving an ack for
    --   a previously unacked packet.
    , RTT -> Microseconds
smoothedRTT :: Microseconds
    -- ^ The smoothed RTT of the connection.
    , RTT -> Microseconds
rttvar :: Microseconds
    -- ^ The RTT variation.
    , RTT -> Microseconds
minRTT :: Microseconds
    -- ^ The minimum RTT seen in the connection, ignoring ack delay.
    , RTT -> Microseconds
maxAckDelay1RTT :: Microseconds
    -- ^ The maximum amount of time by which the receiver intends to
    --   delay acknowledgments for packets in the ApplicationData packet
    --   number space.  The actual ack_delay in a received ACK frame may
    --   be larger due to late timers, reordering, or lost ACK frames.
    , RTT -> Int
ptoCount :: Int
    -- ^ The number of times a PTO has been sent without receiving
    --  an ack.
    }
    deriving (Int -> RTT -> ShowS
[RTT] -> ShowS
RTT -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RTT] -> ShowS
$cshowList :: [RTT] -> ShowS
show :: RTT -> String
$cshow :: RTT -> String
showsPrec :: Int -> RTT -> ShowS
$cshowsPrec :: Int -> RTT -> ShowS
Show)

-- | The RTT used before an RTT sample is taken.
kInitialRTT :: Microseconds
kInitialRTT :: Microseconds
kInitialRTT = Int -> Microseconds
Microseconds Int
333000

initialRTT :: RTT
initialRTT :: RTT
initialRTT =
    RTT
        { latestRTT :: Microseconds
latestRTT = Int -> Microseconds
Microseconds Int
0
        , smoothedRTT :: Microseconds
smoothedRTT = Microseconds
kInitialRTT
        , rttvar :: Microseconds
rttvar = Microseconds
kInitialRTT forall a. Bits a => a -> Int -> a
!>>. Int
1
        , minRTT :: Microseconds
minRTT = Int -> Microseconds
Microseconds Int
0
        , maxAckDelay1RTT :: Microseconds
maxAckDelay1RTT = Int -> Microseconds
Microseconds Int
0
        , ptoCount :: Int
ptoCount = Int
0
        }

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

data CCMode
    = SlowStart
    | Avoidance
    | Recovery
    deriving (CCMode -> CCMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CCMode -> CCMode -> Bool
$c/= :: CCMode -> CCMode -> Bool
== :: CCMode -> CCMode -> Bool
$c== :: CCMode -> CCMode -> Bool
Eq)

instance Show CCMode where
    show :: CCMode -> String
show CCMode
SlowStart = String
"slow_start"
    show CCMode
Avoidance = String
"avoidance"
    show CCMode
Recovery = String
"recovery"

data CC = CC
    { CC -> Int
bytesInFlight :: Int
    -- ^ The sum of the size in bytes of all sent packets that contain
    --   at least one ack-eliciting or PADDING frame, and have not been
    --   acked or declared lost.  The size does not include IP or UDP
    --   overhead, but does include the QUIC header and AEAD overhead.
    --   Packets only containing ACK frames do not count towards
    --   bytes_in_flight to ensure congestion control does not impede
    --   congestion feedback.
    , CC -> Int
congestionWindow :: Int
    -- ^ Maximum number of bytes-in-flight that may be sent.
    , CC -> Maybe TimeMicrosecond
congestionRecoveryStartTime :: Maybe TimeMicrosecond
    -- ^ The time when QUIC first detects congestion due to loss or ECN,
    --   causing it to enter congestion recovery.  When a packet sent
    --   after this time is acknowledged, QUIC exits congestion
    --   recovery.
    , CC -> Int
ssthresh :: Int
    -- ^ Slow start threshold in bytes.  When the congestion window is
    --   below ssthresh, the mode is slow start and the window grows by
    --   the number of bytes acknowledged.
    , CC -> Int
bytesAcked :: Int
    -- ^ Records number of bytes acked, and used for incrementing
    --   the congestion window during congestion avoidance.
    , CC -> Int
numOfAckEliciting :: Int
    , CC -> CCMode
ccMode :: CCMode
    }
    deriving (Int -> CC -> ShowS
[CC] -> ShowS
CC -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CC] -> ShowS
$cshowList :: [CC] -> ShowS
show :: CC -> String
$cshow :: CC -> String
showsPrec :: Int -> CC -> ShowS
$cshowsPrec :: Int -> CC -> ShowS
Show)

initialCC :: CC
initialCC :: CC
initialCC =
    CC
        { bytesInFlight :: Int
bytesInFlight = Int
0
        , congestionWindow :: Int
congestionWindow = Int
0
        , congestionRecoveryStartTime :: Maybe TimeMicrosecond
congestionRecoveryStartTime = forall a. Maybe a
Nothing
        , ssthresh :: Int
ssthresh = forall a. Bounded a => a
maxBound
        , bytesAcked :: Int
bytesAcked = Int
0
        , numOfAckEliciting :: Int
numOfAckEliciting = Int
0
        , ccMode :: CCMode
ccMode = CCMode
SlowStart
        }

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

data LossDetection = LossDetection
    { LossDetection -> Int
largestAckedPacket :: PacketNumber
    , LossDetection -> AckInfo
previousAckInfo :: AckInfo
    , LossDetection -> TimeMicrosecond
timeOfLastAckElicitingPacket :: TimeMicrosecond
    , LossDetection -> Maybe TimeMicrosecond
lossTime :: Maybe TimeMicrosecond
    }
    deriving (Int -> LossDetection -> ShowS
[LossDetection] -> ShowS
LossDetection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LossDetection] -> ShowS
$cshowList :: [LossDetection] -> ShowS
show :: LossDetection -> String
$cshow :: LossDetection -> String
showsPrec :: Int -> LossDetection -> ShowS
$cshowsPrec :: Int -> LossDetection -> ShowS
Show)

initialLossDetection :: LossDetection
initialLossDetection :: LossDetection
initialLossDetection = Int
-> AckInfo
-> TimeMicrosecond
-> Maybe TimeMicrosecond
-> LossDetection
LossDetection (-Int
1) AckInfo
ackInfo0 TimeMicrosecond
timeMicrosecond0 forall a. Maybe a
Nothing

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

newtype MetricsDiff = MetricsDiff [(String, Int)]

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

data TimerType
    = LossTime
    | PTO
    deriving (TimerType -> TimerType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimerType -> TimerType -> Bool
$c/= :: TimerType -> TimerType -> Bool
== :: TimerType -> TimerType -> Bool
$c== :: TimerType -> TimerType -> Bool
Eq)

instance Show TimerType where
    show :: TimerType -> String
show TimerType
LossTime = String
"loss_time"
    show TimerType
PTO = String
"pto"

data TimerExpired = TimerExpired

data TimerCancelled = TimerCancelled

data TimerInfo = TimerInfo
    { TimerInfo -> TimeMicrosecond
timerTime :: TimeMicrosecond
    , TimerInfo -> EncryptionLevel
timerLevel :: EncryptionLevel
    , TimerInfo -> TimerType
timerType :: TimerType
    }
    deriving (TimerInfo -> TimerInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimerInfo -> TimerInfo -> Bool
$c/= :: TimerInfo -> TimerInfo -> Bool
== :: TimerInfo -> TimerInfo -> Bool
$c== :: TimerInfo -> TimerInfo -> Bool
Eq, Int -> TimerInfo -> ShowS
[TimerInfo] -> ShowS
TimerInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimerInfo] -> ShowS
$cshowList :: [TimerInfo] -> ShowS
show :: TimerInfo -> String
$cshow :: TimerInfo -> String
showsPrec :: Int -> TimerInfo -> ShowS
$cshowsPrec :: Int -> TimerInfo -> ShowS
Show)

data TimerInfoQ
    = Empty
    | Next TimerInfo
    deriving (TimerInfoQ -> TimerInfoQ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimerInfoQ -> TimerInfoQ -> Bool
$c/= :: TimerInfoQ -> TimerInfoQ -> Bool
== :: TimerInfoQ -> TimerInfoQ -> Bool
$c== :: TimerInfoQ -> TimerInfoQ -> Bool
Eq)

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

makeSpaceDiscarded :: IO (Array EncryptionLevel (IORef Bool))
makeSpaceDiscarded :: IO (Array EncryptionLevel (IORef Bool))
makeSpaceDiscarded = do
    IORef Bool
i1 <- forall a. a -> IO (IORef a)
newIORef Bool
False
    IORef Bool
i2 <- forall a. a -> IO (IORef a)
newIORef Bool
False
    IORef Bool
i3 <- forall a. a -> IO (IORef a)
newIORef Bool
False
    IORef Bool
i4 <- forall a. a -> IO (IORef a)
newIORef Bool
False
    let lst :: [(EncryptionLevel, IORef Bool)]
lst = [(EncryptionLevel
InitialLevel, IORef Bool
i1), (EncryptionLevel
RTT0Level, IORef Bool
i2), (EncryptionLevel
HandshakeLevel, IORef Bool
i3), (EncryptionLevel
RTT1Level, IORef Bool
i4)]
        arr :: Array EncryptionLevel (IORef Bool)
arr = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (EncryptionLevel
InitialLevel, EncryptionLevel
RTT1Level) [(EncryptionLevel, IORef Bool)]
lst
    forall (m :: * -> *) a. Monad m => a -> m a
return Array EncryptionLevel (IORef Bool)
arr

makeSentPackets :: IO (Array EncryptionLevel (IORef SentPackets))
makeSentPackets :: IO (Array EncryptionLevel (IORef SentPackets))
makeSentPackets = do
    IORef SentPackets
i1 <- forall a. a -> IO (IORef a)
newIORef SentPackets
emptySentPackets
    IORef SentPackets
i2 <- forall a. a -> IO (IORef a)
newIORef SentPackets
emptySentPackets
    IORef SentPackets
i3 <- forall a. a -> IO (IORef a)
newIORef SentPackets
emptySentPackets
    let lst :: [(EncryptionLevel, IORef SentPackets)]
lst = [(EncryptionLevel
InitialLevel, IORef SentPackets
i1), (EncryptionLevel
HandshakeLevel, IORef SentPackets
i2), (EncryptionLevel
RTT1Level, IORef SentPackets
i3)]
        arr :: Array EncryptionLevel (IORef SentPackets)
arr = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (EncryptionLevel
InitialLevel, EncryptionLevel
RTT1Level) [(EncryptionLevel, IORef SentPackets)]
lst
    forall (m :: * -> *) a. Monad m => a -> m a
return Array EncryptionLevel (IORef SentPackets)
arr

makeLossDetection :: IO (Array EncryptionLevel (IORef LossDetection))
makeLossDetection :: IO (Array EncryptionLevel (IORef LossDetection))
makeLossDetection = do
    IORef LossDetection
i1 <- forall a. a -> IO (IORef a)
newIORef LossDetection
initialLossDetection
    IORef LossDetection
i2 <- forall a. a -> IO (IORef a)
newIORef LossDetection
initialLossDetection
    IORef LossDetection
i3 <- forall a. a -> IO (IORef a)
newIORef LossDetection
initialLossDetection
    let lst :: [(EncryptionLevel, IORef LossDetection)]
lst = [(EncryptionLevel
InitialLevel, IORef LossDetection
i1), (EncryptionLevel
HandshakeLevel, IORef LossDetection
i2), (EncryptionLevel
RTT1Level, IORef LossDetection
i3)]
        arr :: Array EncryptionLevel (IORef LossDetection)
arr = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (EncryptionLevel
InitialLevel, EncryptionLevel
RTT1Level) [(EncryptionLevel, IORef LossDetection)]
lst
    forall (m :: * -> *) a. Monad m => a -> m a
return Array EncryptionLevel (IORef LossDetection)
arr

data LDCC = LDCC
    { LDCC -> ConnState
ldccState :: ConnState
    , LDCC -> QLogger
ldccQlogger :: QLogger
    , LDCC -> PlainPacket -> IO ()
putRetrans :: PlainPacket -> IO ()
    , LDCC -> IORef RTT
recoveryRTT :: IORef RTT
    , LDCC -> TVar CC
recoveryCC :: TVar CC
    , LDCC -> Array EncryptionLevel (IORef Bool)
spaceDiscarded :: Array EncryptionLevel (IORef Bool)
    , LDCC -> Array EncryptionLevel (IORef SentPackets)
sentPackets :: Array EncryptionLevel (IORef SentPackets)
    , LDCC -> Array EncryptionLevel (IORef LossDetection)
lossDetection :: Array EncryptionLevel (IORef LossDetection)
    , -- The current timer key
      LDCC -> IORef (Maybe TimeoutKey)
timerKey :: IORef (Maybe TimeoutKey)
    , -- The current timer value
      LDCC -> IORef (Maybe TimerInfo)
timerInfo :: IORef (Maybe TimerInfo)
    , LDCC -> TVar SentPackets
lostCandidates :: TVar SentPackets
    , LDCC -> TVar (Maybe EncryptionLevel)
ptoPing :: TVar (Maybe EncryptionLevel)
    , LDCC -> IORef Bool
speedingUp :: IORef Bool
    , LDCC -> IORef Int
pktNumPersistent :: IORef PacketNumber
    , LDCC -> Array EncryptionLevel (IORef PeerPacketNumbers)
peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)
    , LDCC -> IORef PeerPacketNumbers
previousRTT1PPNs :: IORef PeerPacketNumbers -- for RTT1
    -- Pending timer value
    , LDCC -> TVar TimerInfoQ
timerInfoQ :: TVar TimerInfoQ
    }

makePPN :: IO (Array EncryptionLevel (IORef PeerPacketNumbers))
makePPN :: IO (Array EncryptionLevel (IORef PeerPacketNumbers))
makePPN = do
    IORef PeerPacketNumbers
ref1 <- forall a. a -> IO (IORef a)
newIORef PeerPacketNumbers
emptyPeerPacketNumbers
    IORef PeerPacketNumbers
ref2 <- forall a. a -> IO (IORef a)
newIORef PeerPacketNumbers
emptyPeerPacketNumbers
    IORef PeerPacketNumbers
ref3 <- forall a. a -> IO (IORef a)
newIORef PeerPacketNumbers
emptyPeerPacketNumbers
    -- using the ref for RTT0Level and RTT1Level
    let lst :: [(EncryptionLevel, IORef PeerPacketNumbers)]
lst =
            [ (EncryptionLevel
InitialLevel, IORef PeerPacketNumbers
ref1)
            , (EncryptionLevel
RTT0Level, IORef PeerPacketNumbers
ref3)
            , (EncryptionLevel
HandshakeLevel, IORef PeerPacketNumbers
ref2)
            , (EncryptionLevel
RTT1Level, IORef PeerPacketNumbers
ref3)
            ]
        arr :: Array EncryptionLevel (IORef PeerPacketNumbers)
arr = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (EncryptionLevel
InitialLevel, EncryptionLevel
RTT1Level) [(EncryptionLevel, IORef PeerPacketNumbers)]
lst
    forall (m :: * -> *) a. Monad m => a -> m a
return Array EncryptionLevel (IORef PeerPacketNumbers)
arr

newLDCC :: ConnState -> QLogger -> (PlainPacket -> IO ()) -> IO LDCC
newLDCC :: ConnState -> QLogger -> (PlainPacket -> IO ()) -> IO LDCC
newLDCC ConnState
cs QLogger
qLog PlainPacket -> IO ()
put =
    ConnState
-> QLogger
-> (PlainPacket -> IO ())
-> IORef RTT
-> TVar CC
-> Array EncryptionLevel (IORef Bool)
-> Array EncryptionLevel (IORef SentPackets)
-> Array EncryptionLevel (IORef LossDetection)
-> IORef (Maybe TimeoutKey)
-> IORef (Maybe TimerInfo)
-> TVar SentPackets
-> TVar (Maybe EncryptionLevel)
-> IORef Bool
-> IORef Int
-> Array EncryptionLevel (IORef PeerPacketNumbers)
-> IORef PeerPacketNumbers
-> TVar TimerInfoQ
-> LDCC
LDCC ConnState
cs QLogger
qLog PlainPacket -> IO ()
put
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef RTT
initialRTT
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO CC
initialCC
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Array EncryptionLevel (IORef Bool))
makeSpaceDiscarded
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Array EncryptionLevel (IORef SentPackets))
makeSentPackets
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Array EncryptionLevel (IORef LossDetection))
makeLossDetection
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO SentPackets
emptySentPackets
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO forall a. Maybe a
Nothing
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Bool
False
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef forall a. Bounded a => a
maxBound
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Array EncryptionLevel (IORef PeerPacketNumbers))
makePPN
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef PeerPacketNumbers
emptyPeerPacketNumbers
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO TimerInfoQ
Empty

instance KeepQlog LDCC where
    keepQlog :: LDCC -> QLogger
keepQlog = LDCC -> QLogger
ldccQlogger

instance Connector LDCC where
    getRole :: LDCC -> Role
getRole = ConnState -> Role
role forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDCC -> ConnState
ldccState
    getEncryptionLevel :: LDCC -> IO EncryptionLevel
getEncryptionLevel = forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> TVar EncryptionLevel
encryptionLevel forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDCC -> ConnState
ldccState
    getMaxPacketSize :: LDCC -> IO Int
getMaxPacketSize = forall a. IORef a -> IO a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Int
maxPacketSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDCC -> ConnState
ldccState
    getConnectionState :: LDCC -> IO ConnectionState
getConnectionState = forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> TVar ConnectionState
connectionState forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDCC -> ConnState
ldccState
    getPacketNumber :: LDCC -> IO Int
getPacketNumber = forall a. IORef a -> IO a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Int
packetNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDCC -> ConnState
ldccState
    getAlive :: LDCC -> IO Bool
getAlive = forall a. IORef a -> IO a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Bool
connectionAlive forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDCC -> ConnState
ldccState

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

instance Qlog SentPacket where
    qlog :: SentPacket -> LogStr
qlog SentPacket{Bool
Int
TimeMicrosecond
PeerPacketNumbers
EncryptionLevel
PlainPacket
spAckEliciting :: Bool
spPeerPacketNumbers :: PeerPacketNumbers
spPacketNumber :: Int
spEncryptionLevel :: EncryptionLevel
spSentBytes :: Int
spTimeSent :: TimeMicrosecond
spPlainPacket :: PlainPacket
spAckEliciting :: SentPacket -> Bool
spPeerPacketNumbers :: SentPacket -> PeerPacketNumbers
spPacketNumber :: SentPacket -> Int
spEncryptionLevel :: SentPacket -> EncryptionLevel
spSentBytes :: SentPacket -> Int
spTimeSent :: SentPacket -> TimeMicrosecond
spPlainPacket :: SentPacket -> PlainPacket
..} =
        LogStr
"{\"raw\":{\"length\":"
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
spSentBytes
            forall a. Semigroup a => a -> a -> a
<> LogStr
"},\"header\":{\"packet_type\":\""
            forall a. Semigroup a => a -> a -> a
<> forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Header -> LogStr
packetType Header
hdr)
            forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"packet_number\":\""
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
plainPacketNumber
            forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"dcid\":\""
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw (Header -> CID
headerMyCID Header
hdr)
            forall a. Semigroup a => a -> a -> a
<> LogStr
"\"},\"frames\":"
            forall a. Semigroup a => a -> a -> a
<> LogStr
"["
            forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Semigroup a => a -> a -> a
(<>) LogStr
"" (forall a. a -> [a] -> [a]
intersperse LogStr
"," (forall a b. (a -> b) -> [a] -> [b]
map forall a. Qlog a => a -> LogStr
qlog [Frame]
plainFrames))
            forall a. Semigroup a => a -> a -> a
<> LogStr
"]"
            forall a. Semigroup a => a -> a -> a
<> LogStr
"}"
      where
        PlainPacket Header
hdr Plain{Int
[Frame]
Flags Raw
plainMarks :: Plain -> Int
plainPacketNumber :: Plain -> Int
plainFlags :: Plain -> Flags Raw
plainMarks :: Int
plainFlags :: Flags Raw
plainFrames :: [Frame]
plainPacketNumber :: Int
plainFrames :: Plain -> [Frame]
..} = PlainPacket
spPlainPacket

instance Qlog LostPacket where
    qlog :: LostPacket -> LogStr
qlog (LostPacket SentPacket{Bool
Int
TimeMicrosecond
PeerPacketNumbers
EncryptionLevel
PlainPacket
spAckEliciting :: Bool
spPeerPacketNumbers :: PeerPacketNumbers
spPacketNumber :: Int
spEncryptionLevel :: EncryptionLevel
spSentBytes :: Int
spTimeSent :: TimeMicrosecond
spPlainPacket :: PlainPacket
spAckEliciting :: SentPacket -> Bool
spPeerPacketNumbers :: SentPacket -> PeerPacketNumbers
spPacketNumber :: SentPacket -> Int
spEncryptionLevel :: SentPacket -> EncryptionLevel
spSentBytes :: SentPacket -> Int
spTimeSent :: SentPacket -> TimeMicrosecond
spPlainPacket :: SentPacket -> PlainPacket
..}) =
        LogStr
"{\"header\":{\"packet_type\":\""
            forall a. Semigroup a => a -> a -> a
<> forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Header -> LogStr
packetType Header
hdr)
            forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
            forall a. Semigroup a => a -> a -> a
<> LogStr
",\"packet_number\":"
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
spPacketNumber
            forall a. Semigroup a => a -> a -> a
<> LogStr
"}}"
      where
        PlainPacket Header
hdr Plain
_ = PlainPacket
spPlainPacket

instance Qlog MetricsDiff where
    qlog :: MetricsDiff -> LogStr
qlog (MetricsDiff []) = LogStr
"{}"
    qlog (MetricsDiff ((String, Int)
x : [(String, Int)]
xs)) = LogStr
"{" forall a. Semigroup a => a -> a -> a
<> forall {msg} {a}. (ToLogStr msg, Show a) => (msg, a) -> LogStr
tv0 (String, Int)
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {msg} {a}.
(ToLogStr msg, Show a) =>
(msg, a) -> LogStr -> LogStr
tv LogStr
"" [(String, Int)]
xs forall a. Semigroup a => a -> a -> a
<> LogStr
"}"
      where
        tv0 :: (msg, a) -> LogStr
tv0 (msg
tag, a
val) = LogStr
"\"" forall a. Semigroup a => a -> a -> a
<> forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
tag forall a. Semigroup a => a -> a -> a
<> LogStr
"\":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw a
val
        tv :: (msg, a) -> LogStr -> LogStr
tv (msg
tag, a
val) LogStr
pre = LogStr
",\"" forall a. Semigroup a => a -> a -> a
<> forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
tag forall a. Semigroup a => a -> a -> a
<> LogStr
"\":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw a
val forall a. Semigroup a => a -> a -> a
<> LogStr
pre

instance Qlog CCMode where
    qlog :: CCMode -> LogStr
qlog CCMode
mode = LogStr
"{\"new\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw CCMode
mode forall a. Semigroup a => a -> a -> a
<> LogStr
"\"}"

instance Qlog TimerCancelled where
    qlog :: TimerCancelled -> LogStr
qlog TimerCancelled
TimerCancelled = LogStr
"{\"event_type\":\"cancelled\"}"

instance Qlog TimerExpired where
    qlog :: TimerExpired -> LogStr
qlog TimerExpired
TimerExpired = LogStr
"{\"event_type\":\"expired\"}"

instance Qlog (TimerInfo, Microseconds) where
    qlog :: (TimerInfo, Microseconds) -> LogStr
qlog (TimerInfo{TimeMicrosecond
EncryptionLevel
TimerType
timerType :: TimerType
timerLevel :: EncryptionLevel
timerTime :: TimeMicrosecond
timerType :: TimerInfo -> TimerType
timerLevel :: TimerInfo -> EncryptionLevel
timerTime :: TimerInfo -> TimeMicrosecond
..}, Microseconds
us) =
        LogStr
"{\"event_type\":\"set\""
            forall a. Semigroup a => a -> a -> a
<> LogStr
",\"timer_type\":\""
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw TimerType
timerType
            forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
            forall a. Semigroup a => a -> a -> a
<> LogStr
",\"packet_number_space\":\""
            forall a. Semigroup a => a -> a -> a
<> EncryptionLevel -> LogStr
packetNumberSpace EncryptionLevel
timerLevel
            forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
            forall a. Semigroup a => a -> a -> a
<> LogStr
",\"delta\":"
            forall a. Semigroup a => a -> a -> a
<> Microseconds -> LogStr
delta Microseconds
us
            forall a. Semigroup a => a -> a -> a
<> LogStr
"}"

packetNumberSpace :: EncryptionLevel -> LogStr
packetNumberSpace :: EncryptionLevel -> LogStr
packetNumberSpace EncryptionLevel
InitialLevel = LogStr
"initial"
packetNumberSpace EncryptionLevel
RTT0Level = LogStr
"application_data"
packetNumberSpace EncryptionLevel
HandshakeLevel = LogStr
"handshake"
packetNumberSpace EncryptionLevel
RTT1Level = LogStr
"application_data"

delta :: Microseconds -> LogStr
delta :: Microseconds -> LogStr
delta (Microseconds Int
n) = forall a. Show a => a -> LogStr
sw Int
n

qlogSent :: (KeepQlog q, Qlog pkt) => q -> pkt -> TimeMicrosecond -> IO ()
qlogSent :: forall q pkt.
(KeepQlog q, Qlog pkt) =>
q -> pkt -> TimeMicrosecond -> IO ()
qlogSent q
q pkt
pkt TimeMicrosecond
tim = forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QSent (forall a. Qlog a => a -> LogStr
qlog pkt
pkt) TimeMicrosecond
tim

qlogMetricsUpdated :: KeepQlog q => q -> MetricsDiff -> IO ()
qlogMetricsUpdated :: forall q. KeepQlog q => q -> MetricsDiff -> IO ()
qlogMetricsUpdated q
q MetricsDiff
m = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QMetricsUpdated (forall a. Qlog a => a -> LogStr
qlog MetricsDiff
m) TimeMicrosecond
tim

qlogPacketLost :: KeepQlog q => q -> LostPacket -> IO ()
qlogPacketLost :: forall q. KeepQlog q => q -> LostPacket -> IO ()
qlogPacketLost q
q LostPacket
lpkt = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QPacketLost (forall a. Qlog a => a -> LogStr
qlog LostPacket
lpkt) TimeMicrosecond
tim

qlogContestionStateUpdated :: KeepQlog q => q -> CCMode -> IO ()
qlogContestionStateUpdated :: forall q. KeepQlog q => q -> CCMode -> IO ()
qlogContestionStateUpdated q
q CCMode
mode = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QCongestionStateUpdated (forall a. Qlog a => a -> LogStr
qlog CCMode
mode) TimeMicrosecond
tim

qlogLossTimerUpdated :: KeepQlog q => q -> (TimerInfo, Microseconds) -> IO ()
qlogLossTimerUpdated :: forall q. KeepQlog q => q -> (TimerInfo, Microseconds) -> IO ()
qlogLossTimerUpdated q
q (TimerInfo, Microseconds)
tmi = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QLossTimerUpdated (forall a. Qlog a => a -> LogStr
qlog (TimerInfo, Microseconds)
tmi) TimeMicrosecond
tim

qlogLossTimerCancelled :: KeepQlog q => q -> IO ()
qlogLossTimerCancelled :: forall q. KeepQlog q => q -> IO ()
qlogLossTimerCancelled q
q = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QLossTimerUpdated (forall a. Qlog a => a -> LogStr
qlog TimerCancelled
TimerCancelled) TimeMicrosecond
tim

qlogLossTimerExpired :: KeepQlog q => q -> IO ()
qlogLossTimerExpired :: forall q. KeepQlog q => q -> IO ()
qlogLossTimerExpired q
q = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QLossTimerUpdated (forall a. Qlog a => a -> LogStr
qlog TimerExpired
TimerExpired) TimeMicrosecond
tim