{-# 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 {
  -- | The most recent RTT measurement made when receiving an ack for
  --   a previously unacked packet.
    RTT -> Microseconds
latestRTT   :: Microseconds
  -- | The smoothed RTT of the connection.
  , RTT -> Microseconds
smoothedRTT :: Microseconds
  -- | The RTT variation.
  , RTT -> Microseconds
rttvar      :: Microseconds
  -- | The minimum RTT seen in the connection, ignoring ack delay.
  , RTT -> Microseconds
minRTT      :: 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 -> Microseconds
maxAckDelay1RTT :: Microseconds
  -- | The number of times a PTO has been sent without receiving
  --  an ack.
  , RTT -> Int
ptoCount :: Int
  } 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 {
  -- | 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
bytesInFlight :: Int
  -- | Maximum number of bytes-in-flight that may be sent.
  , CC -> Int
congestionWindow :: Int
  -- | 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 -> Maybe TimeMicrosecond
congestionRecoveryStartTime :: Maybe TimeMicrosecond
  -- | 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
ssthresh :: Int
  -- | Records number of bytes acked, and used for incrementing
  --   the congestion window during congestion avoidance.
  , CC -> Int
bytesAcked :: Int
  , 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