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

module Network.QUIC.Qlog (
    QLogger,
    newQlogger,
    Qlog (..),
    KeepQlog (..),
    QlogMsg (..),
    qlogReceived,
    qlogDropped,
    qlogRecvInitial,
    qlogSentRetry,
    qlogParamsSet,
    qlogDebug,
    qlogCIDUpdate,
    Debug (..),
    LR (..),
    packetType,
    sw,
) where

import qualified Data.ByteString as BS

import qualified Data.ByteString.Short as Short
import Data.List (intersperse)
import System.Log.FastLogger

import Network.QUIC.Imports
import Network.QUIC.Parameters
import Network.QUIC.Types

class Qlog a where
    qlog :: a -> LogStr

newtype Debug = Debug LogStr
data LR = Local CID | Remote CID

instance Show Debug where
    show :: Debug -> [Char]
show (Debug LogStr
msg) = LogStr -> [Char]
forall a. Show a => a -> [Char]
show LogStr
msg

instance Qlog Debug where
    qlog :: Debug -> LogStr
qlog (Debug LogStr
msg) = LogStr
"{\"message\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\"}"

instance Qlog LR where
    qlog :: LR -> LogStr
qlog (Local CID
cid) = LogStr
"{\"owner\":\"local\",\"new\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> CID -> LogStr
forall a. Show a => a -> LogStr
sw CID
cid LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\"}"
    qlog (Remote CID
cid) = LogStr
"{\"owner\":\"remote\",\"new\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> CID -> LogStr
forall a. Show a => a -> LogStr
sw CID
cid LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\"}"

instance Qlog RetryPacket where
    qlog :: RetryPacket -> LogStr
qlog RetryPacket{} = LogStr
"{\"header\":{\"packet_type\":\"retry\",\"packet_number\":\"\"}}"

instance Qlog VersionNegotiationPacket where
    qlog :: VersionNegotiationPacket -> LogStr
qlog VersionNegotiationPacket{} =
        LogStr
"{\"header\":{\"packet_type\":\"version_negotiation\",\"packet_number\":\"\"}}"

instance Qlog Header where
    qlog :: Header -> LogStr
qlog Header
hdr = LogStr
"{\"header\":{\"packet_type\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Header -> LogStr
packetType Header
hdr LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\"}}"

instance Qlog CryptPacket where
    qlog :: CryptPacket -> LogStr
qlog (CryptPacket Header
hdr Crypt
_) = Header -> LogStr
forall a. Qlog a => a -> LogStr
qlog Header
hdr

instance Qlog PlainPacket where
    qlog :: PlainPacket -> LogStr
qlog (PlainPacket Header
hdr Plain{Int
[Frame]
Flags Raw
plainFlags :: Flags Raw
plainPacketNumber :: Int
plainFrames :: [Frame]
plainMarks :: Int
plainFlags :: Plain -> Flags Raw
plainPacketNumber :: Plain -> Int
plainFrames :: Plain -> [Frame]
plainMarks :: Plain -> Int
..}) =
        LogStr
"{\"header\":{\"packet_type\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Header -> LogStr
packetType Header
hdr)
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"packet_number\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
plainPacketNumber
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"dcid\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> CID -> LogStr
forall a. Show a => a -> LogStr
sw (Header -> CID
headerMyCID Header
hdr)
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\"},\"frames\":["
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> (LogStr -> LogStr -> LogStr) -> LogStr -> [LogStr] -> LogStr
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
(<>) LogStr
"" (LogStr -> [LogStr] -> [LogStr]
forall a. a -> [a] -> [a]
intersperse LogStr
"," ((Frame -> LogStr) -> [Frame] -> [LogStr]
forall a b. (a -> b) -> [a] -> [b]
map Frame -> LogStr
forall a. Qlog a => a -> LogStr
qlog [Frame]
plainFrames))
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"]}"

instance Qlog StatelessReset where
    qlog :: StatelessReset -> LogStr
qlog StatelessReset
StatelessReset = LogStr
"{\"header\":{\"packet_type\":\"stateless_reset\",\"packet_number\":\"\"}}"

packetType :: Header -> LogStr
packetType :: Header -> LogStr
packetType Initial{} = LogStr
"initial"
packetType RTT0{} = LogStr
"0RTT"
packetType Handshake{} = LogStr
"handshake"
packetType Short{} = LogStr
"1RTT"

instance Qlog Frame where
    qlog :: Frame -> LogStr
qlog Frame
frame = LogStr
"{\"frame_type\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Frame -> LogStr
frameType Frame
frame LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Frame -> LogStr
frameExtra Frame
frame LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}"

frameType :: Frame -> LogStr
frameType :: Frame -> LogStr
frameType Padding{} = LogStr
"padding"
frameType Frame
Ping = LogStr
"ping"
frameType Ack{} = LogStr
"ack"
frameType ResetStream{} = LogStr
"reset_stream"
frameType StopSending{} = LogStr
"stop_sending"
frameType CryptoF{} = LogStr
"crypto"
frameType NewToken{} = LogStr
"new_token"
frameType StreamF{} = LogStr
"stream"
frameType MaxData{} = LogStr
"max_data"
frameType MaxStreamData{} = LogStr
"max_stream_data"
frameType MaxStreams{} = LogStr
"max_streams"
frameType DataBlocked{} = LogStr
"data_blocked"
frameType StreamDataBlocked{} = LogStr
"stream_data_blocked"
frameType StreamsBlocked{} = LogStr
"streams_blocked"
frameType NewConnectionID{} = LogStr
"new_connection_id"
frameType RetireConnectionID{} = LogStr
"retire_connection_id"
frameType PathChallenge{} = LogStr
"path_challenge"
frameType PathResponse{} = LogStr
"path_response"
frameType ConnectionClose{} = LogStr
"connection_close"
frameType ConnectionCloseApp{} = LogStr
"connection_close"
frameType HandshakeDone{} = LogStr
"handshake_done"
frameType UnknownFrame{} = LogStr
"unknown"

{-# INLINE frameExtra #-}
frameExtra :: Frame -> LogStr
frameExtra :: Frame -> LogStr
frameExtra (Padding Int
n) = LogStr
",\"payload_length\":" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
n
frameExtra Frame
Ping = LogStr
""
frameExtra (Ack AckInfo
ai Delay
_Delay) = LogStr
",\"acked_ranges\":" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> AckInfo -> LogStr
ack AckInfo
ai
frameExtra ResetStream{} = LogStr
""
frameExtra (StopSending Int
_StreamId ApplicationProtocolError
_ApplicationError) = LogStr
""
frameExtra (CryptoF Int
off ByteString
dat) = LogStr
",\"offset\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
off LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"length\":" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw (ByteString -> Int
BS.length ByteString
dat)
frameExtra (NewToken ByteString
_Token) = LogStr
""
frameExtra (StreamF Int
sid Int
off [ByteString]
dat Fin
fin) =
    LogStr
",\"stream_id\":\""
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
sid
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"offset\":\""
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
off
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"length\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw ([Int] -> Int
forall (f :: * -> *). (Functor f, Foldable f) => f Int -> Int
sum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
BS.length [ByteString]
dat)
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"fin\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> if Fin
fin then LogStr
"true" else LogStr
"false"
frameExtra (MaxData Int
mx) = LogStr
",\"maximum\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
mx LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra (MaxStreamData Int
sid Int
mx) = LogStr
",\"stream_id\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
sid LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"maximum\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
mx LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra (MaxStreams Direction
_Direction Int
ms) = LogStr
",\"maximum\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
ms LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra DataBlocked{} = LogStr
""
frameExtra StreamDataBlocked{} = LogStr
""
frameExtra StreamsBlocked{} = LogStr
""
frameExtra (NewConnectionID (CIDInfo Int
sn CID
cid StatelessResetToken
_) Int
rpt) =
    LogStr
",\"sequence_number\":\""
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
sn
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"connection_id:\":\""
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> CID -> LogStr
forall a. Show a => a -> LogStr
sw CID
cid
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"retire_prior_to\":\""
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
rpt
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra (RetireConnectionID Int
sn) = LogStr
",\"sequence_number\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
sn LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra (PathChallenge PathData
_PathData) = LogStr
""
frameExtra (PathResponse PathData
_PathData) = LogStr
""
frameExtra (ConnectionClose TransportError
err Int
_FrameType ReasonPhrase
reason) =
    LogStr
",\"error_space\":\"transport\",\"error_code\":\""
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TransportError -> LogStr
transportError TransportError
err
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"raw_error_code\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TransportError -> LogStr
transportError' TransportError
err
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"reason\":\""
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ReasonPhrase -> ByteString
Short.fromShort ReasonPhrase
reason)
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra (ConnectionCloseApp ApplicationProtocolError
err ReasonPhrase
reason) =
    LogStr
",\"error_space\":\"application\",\"error_code\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ApplicationProtocolError -> LogStr
applicationProtoclError ApplicationProtocolError
err
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"reason\":\""
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ReasonPhrase -> ByteString
Short.fromShort ReasonPhrase
reason)
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\"" -- fixme
frameExtra HandshakeDone{} = LogStr
""
frameExtra (UnknownFrame Int
_Int) = LogStr
""

transportError :: TransportError -> LogStr
transportError :: TransportError -> LogStr
transportError TransportError
NoError = LogStr
"no_error"
transportError TransportError
InternalError = LogStr
"internal_error"
transportError TransportError
ConnectionRefused = LogStr
"connection_refused"
transportError TransportError
FlowControlError = LogStr
"flow_control_error"
transportError TransportError
StreamLimitError = LogStr
"stream_limit_error"
transportError TransportError
StreamStateError = LogStr
"stream_state_error"
transportError TransportError
FinalSizeError = LogStr
"final_size_error"
transportError TransportError
FrameEncodingError = LogStr
"frame_encoding_error"
transportError TransportError
TransportParameterError = LogStr
"transport_parameter_err"
transportError TransportError
ConnectionIdLimitError = LogStr
"connection_id_limit_error"
transportError TransportError
ProtocolViolation = LogStr
"protocol_violation"
transportError TransportError
InvalidToken = LogStr
"invalid_migration"
transportError TransportError
CryptoBufferExceeded = LogStr
"crypto_buffer_exceeded"
transportError TransportError
KeyUpdateError = LogStr
"key_update_error"
transportError TransportError
AeadLimitReached = LogStr
"aead_limit_reached"
transportError TransportError
NoViablePath = LogStr
"no_viablpath"
transportError (TransportError Int
n) = Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
n

transportError' :: TransportError -> LogStr
transportError' :: TransportError -> LogStr
transportError' (TransportError Int
n) = Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
n

applicationProtoclError :: ApplicationProtocolError -> LogStr
applicationProtoclError :: ApplicationProtocolError -> LogStr
applicationProtoclError (ApplicationProtocolError Int
n) = Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
n

{-# INLINE ack #-}
ack :: AckInfo -> LogStr
ack :: AckInfo -> LogStr
ack (AckInfo Int
lpn Int
r [(Int, Int)]
rs) = LogStr
"[" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr -> Int -> [(Int, Int)] -> LogStr
ack1 LogStr
fr Int
fpn [(Int, Int)]
rs LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"]"
  where
    fpn :: Int
fpn = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lpn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
    fr :: LogStr
fr
        | Int
r Int -> Int -> Fin
forall a. Eq a => a -> a -> Fin
== Int
0 = LogStr
"[" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
lpn LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"]"
        | Fin
otherwise = LogStr
"[" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
fpn LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"," LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
lpn LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"]"

ack1 :: LogStr -> Range -> [(Gap, Range)] -> LogStr
ack1 :: LogStr -> Int -> [(Int, Int)] -> LogStr
ack1 LogStr
ret Int
_ [] = LogStr
ret
ack1 LogStr
ret Int
fpn ((Int
g, Int
r) : [(Int, Int)]
grs) = LogStr -> Int -> [(Int, Int)] -> LogStr
ack1 LogStr
ret' Int
f [(Int, Int)]
grs
  where
    ret' :: LogStr
ret' = LogStr
"[" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
f LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"," LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
l LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"]," LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
ret
    l :: Int
l = Int
fpn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
g Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
    f :: Int
f = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r

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

instance Qlog (Parameters, String) where
    qlog :: (Parameters, [Char]) -> LogStr
qlog (Parameters{Fin
Int
Maybe ByteString
Maybe StatelessResetToken
Maybe CID
Maybe VersionInfo
Delay
originalDestinationConnectionId :: Maybe CID
maxIdleTimeout :: Delay
statelessResetToken :: Maybe StatelessResetToken
maxUdpPayloadSize :: Int
initialMaxData :: Int
initialMaxStreamDataBidiLocal :: Int
initialMaxStreamDataBidiRemote :: Int
initialMaxStreamDataUni :: Int
initialMaxStreamsBidi :: Int
initialMaxStreamsUni :: Int
ackDelayExponent :: Int
maxAckDelay :: Delay
disableActiveMigration :: Fin
preferredAddress :: Maybe ByteString
activeConnectionIdLimit :: Int
initialSourceConnectionId :: Maybe CID
retrySourceConnectionId :: Maybe CID
grease :: Maybe ByteString
greaseQuicBit :: Fin
versionInformation :: Maybe VersionInfo
originalDestinationConnectionId :: Parameters -> Maybe CID
maxIdleTimeout :: Parameters -> Delay
statelessResetToken :: Parameters -> Maybe StatelessResetToken
maxUdpPayloadSize :: Parameters -> Int
initialMaxData :: Parameters -> Int
initialMaxStreamDataBidiLocal :: Parameters -> Int
initialMaxStreamDataBidiRemote :: Parameters -> Int
initialMaxStreamDataUni :: Parameters -> Int
initialMaxStreamsBidi :: Parameters -> Int
initialMaxStreamsUni :: Parameters -> Int
ackDelayExponent :: Parameters -> Int
maxAckDelay :: Parameters -> Delay
disableActiveMigration :: Parameters -> Fin
preferredAddress :: Parameters -> Maybe ByteString
activeConnectionIdLimit :: Parameters -> Int
initialSourceConnectionId :: Parameters -> Maybe CID
retrySourceConnectionId :: Parameters -> Maybe CID
grease :: Parameters -> Maybe ByteString
greaseQuicBit :: Parameters -> Fin
versionInformation :: Parameters -> Maybe VersionInfo
..}, [Char]
owner) =
        LogStr
"{\"owner\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> [Char] -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr [Char]
owner
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"initial_max_data\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
initialMaxData
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"initial_max_stream_data_bidi_local\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
initialMaxStreamDataBidiLocal
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"initial_max_stream_data_bidi_remote\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
initialMaxStreamDataBidiRemote
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"initial_max_stream_data_uni\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Int -> LogStr
forall a. Show a => a -> LogStr
sw Int
initialMaxStreamDataUni
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\"}"

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

data QlogMsg
    = QRecvInitial
    | QSentRetry
    | QSent LogStr TimeMicrosecond
    | QReceived LogStr TimeMicrosecond
    | QDropped LogStr TimeMicrosecond
    | QMetricsUpdated LogStr TimeMicrosecond
    | QPacketLost LogStr TimeMicrosecond
    | QCongestionStateUpdated LogStr TimeMicrosecond
    | QLossTimerUpdated LogStr TimeMicrosecond
    | QDebug LogStr TimeMicrosecond
    | QParamsSet LogStr TimeMicrosecond
    | QCIDUpdate LogStr TimeMicrosecond

{-# INLINE toLogStrTime #-}
toLogStrTime :: QlogMsg -> TimeMicrosecond -> LogStr
toLogStrTime :: QlogMsg -> TimeMicrosecond -> LogStr
toLogStrTime QlogMsg
QRecvInitial TimeMicrosecond
_ =
    LogStr
"{\"time\":0,\"name\":\"transport:packet_received\",\"data\":{\"header\":{\"packet_type\":\"initial\",\"packet_number\":\"\"}}}\n"
toLogStrTime QlogMsg
QSentRetry TimeMicrosecond
_ =
    LogStr
"{\"time\":0,\"name\":\"transport:packet_sent\",\"data\":{\"header\":{\"packet_type\":\"retry\",\"packet_number\":\"\"}}}\n"
toLogStrTime (QReceived LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"transport:packet_received\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QSent LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"transport:packet_sent\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QDropped LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"transport:packet_dropped\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QParamsSet LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"transport:parameters_set\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QMetricsUpdated LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"recovery:metrics_updated\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QPacketLost LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"recovery:packet_lost\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QCongestionStateUpdated LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"recovery:congestion_state_updated\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QLossTimerUpdated LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"recovery:loss_timer_updated\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QDebug LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"debug\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QCIDUpdate LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"connectivity:connection_id_updated\",\"data\":"
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"

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

{-# INLINE sw #-}
sw :: Show a => a -> LogStr
sw :: forall a. Show a => a -> LogStr
sw = [Char] -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr ([Char] -> LogStr) -> (a -> [Char]) -> a -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show

{-# INLINE swtim #-}
swtim :: TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim :: TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base = [Char] -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
m [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
u)
  where
    Microseconds Int
x = TimeMicrosecond -> TimeMicrosecond -> Microseconds
elapsedTimeMicrosecond TimeMicrosecond
tim TimeMicrosecond
base
    (Int
m, Int
u) = Int
x Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
1000

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

type QLogger = QlogMsg -> IO ()

newQlogger :: TimeMicrosecond -> ByteString -> CID -> FastLogger -> IO QLogger
newQlogger :: TimeMicrosecond -> ByteString -> CID -> FastLogger -> IO QLogger
newQlogger TimeMicrosecond
base ByteString
rl CID
ocid FastLogger
fastLogger = do
    let ocid' :: LogStr
ocid' = ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ByteString -> LogStr) -> ByteString -> LogStr
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
enc16 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CID -> ByteString
fromCID CID
ocid
    FastLogger
fastLogger FastLogger -> FastLogger
forall a b. (a -> b) -> a -> b
$
        LogStr
"{\"qlog_format\":\"NDJSON\",\"qlog_version\":\"draft-02\",\"title\":\"Haskell quic qlog\",\"trace\":{\"vantage_point\":{\"type\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr ByteString
rl
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\"},\"common_fields\":{\"ODCID\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
ocid'
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"group_id\":\""
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
ocid'
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"reference_time\":"
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
base TimeMicrosecond
timeMicrosecond0
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}}}\n"
    let qlogger :: QLogger
qlogger QlogMsg
qmsg = do
            let msg :: LogStr
msg = QlogMsg -> TimeMicrosecond -> LogStr
toLogStrTime QlogMsg
qmsg TimeMicrosecond
base
            FastLogger
fastLogger LogStr
msg
    QLogger -> IO QLogger
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return QLogger
qlogger

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

class KeepQlog a where
    keepQlog :: a -> QLogger

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

qlogDropped :: (KeepQlog q, Qlog a) => q -> a -> IO ()
qlogDropped :: forall q a. (KeepQlog q, Qlog a) => q -> a -> IO ()
qlogDropped q
q a
pkt = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    q -> QLogger
forall a. KeepQlog a => a -> QLogger
keepQlog q
q QLogger -> QLogger
forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QDropped (a -> LogStr
forall a. Qlog a => a -> LogStr
qlog a
pkt) TimeMicrosecond
tim

qlogRecvInitial :: KeepQlog q => q -> IO ()
qlogRecvInitial :: forall q. KeepQlog q => q -> IO ()
qlogRecvInitial q
q = q -> QLogger
forall a. KeepQlog a => a -> QLogger
keepQlog q
q QlogMsg
QRecvInitial

qlogSentRetry :: KeepQlog q => q -> IO ()
qlogSentRetry :: forall q. KeepQlog q => q -> IO ()
qlogSentRetry q
q = q -> QLogger
forall a. KeepQlog a => a -> QLogger
keepQlog q
q QlogMsg
QSentRetry

qlogParamsSet :: KeepQlog q => q -> (Parameters, String) -> IO ()
qlogParamsSet :: forall q. KeepQlog q => q -> (Parameters, [Char]) -> IO ()
qlogParamsSet q
q (Parameters, [Char])
params = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    q -> QLogger
forall a. KeepQlog a => a -> QLogger
keepQlog q
q QLogger -> QLogger
forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QParamsSet ((Parameters, [Char]) -> LogStr
forall a. Qlog a => a -> LogStr
qlog (Parameters, [Char])
params) TimeMicrosecond
tim

qlogDebug :: KeepQlog q => q -> Debug -> IO ()
qlogDebug :: forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug q
q Debug
msg = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    q -> QLogger
forall a. KeepQlog a => a -> QLogger
keepQlog q
q QLogger -> QLogger
forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QDebug (Debug -> LogStr
forall a. Qlog a => a -> LogStr
qlog Debug
msg) TimeMicrosecond
tim

qlogCIDUpdate :: KeepQlog q => q -> LR -> IO ()
qlogCIDUpdate :: forall q. KeepQlog q => q -> LR -> IO ()
qlogCIDUpdate q
q LR
lr = do
    TimeMicrosecond
tim <- IO TimeMicrosecond
getTimeMicrosecond
    q -> QLogger
forall a. KeepQlog a => a -> QLogger
keepQlog q
q QLogger -> QLogger
forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QCIDUpdate (LR -> LogStr
forall a. Qlog a => a -> LogStr
qlog LR
lr) TimeMicrosecond
tim