{-# 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 -> String
show (Debug LogStr
msg) = LogStr -> String
forall a. Show a => a -> String
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
plainMarks :: Plain -> Int
plainFrames :: Plain -> [Frame]
plainPacketNumber :: Plain -> Int
plainFlags :: Plain -> Flags Raw
plainMarks :: Int
plainFrames :: [Frame]
plainPacketNumber :: Int
plainFlags :: Flags Raw
..}) = 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 (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 CryptoData
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 (CryptoData -> Int
BS.length CryptoData
dat)
frameExtra (NewToken CryptoData
_Token) = LogStr
""
frameExtra (StreamF Int
sid Int
off [CryptoData]
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
$ (CryptoData -> Int) -> [CryptoData] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CryptoData -> Int
BS.length [CryptoData]
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
<> CryptoData -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ReasonPhrase -> CryptoData
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
<> CryptoData -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ReasonPhrase -> CryptoData
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, String) -> LogStr
qlog (Parameters{Fin
Int
Maybe CryptoData
Maybe StatelessResetToken
Maybe CID
Delay
greaseQuicBit :: Parameters -> Fin
grease :: Parameters -> Maybe CryptoData
retrySourceConnectionId :: Parameters -> Maybe CID
initialSourceConnectionId :: Parameters -> Maybe CID
activeConnectionIdLimit :: Parameters -> Int
preferredAddress :: Parameters -> Maybe CryptoData
disableActiveMigration :: Parameters -> Fin
maxAckDelay :: Parameters -> Delay
ackDelayExponent :: Parameters -> Int
initialMaxStreamsUni :: Parameters -> Int
initialMaxStreamsBidi :: Parameters -> Int
initialMaxStreamDataUni :: Parameters -> Int
initialMaxStreamDataBidiRemote :: Parameters -> Int
initialMaxStreamDataBidiLocal :: Parameters -> Int
initialMaxData :: Parameters -> Int
maxUdpPayloadSize :: Parameters -> Int
statelessResetToken :: Parameters -> Maybe StatelessResetToken
maxIdleTimeout :: Parameters -> Delay
originalDestinationConnectionId :: Parameters -> Maybe CID
greaseQuicBit :: Fin
grease :: Maybe CryptoData
retrySourceConnectionId :: Maybe CID
initialSourceConnectionId :: Maybe CID
activeConnectionIdLimit :: Int
preferredAddress :: Maybe CryptoData
disableActiveMigration :: Fin
maxAckDelay :: Delay
ackDelayExponent :: Int
initialMaxStreamsUni :: Int
initialMaxStreamsBidi :: Int
initialMaxStreamDataUni :: Int
initialMaxStreamDataBidiRemote :: Int
initialMaxStreamDataBidiLocal :: Int
initialMaxData :: Int
maxUdpPayloadSize :: Int
statelessResetToken :: Maybe StatelessResetToken
maxIdleTimeout :: Delay
originalDestinationConnectionId :: Maybe CID
..},String
owner) =
               LogStr
"{\"owner\":\"" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr String
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 :: a -> LogStr
sw = String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (String -> LogStr) -> (a -> String) -> a -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

{-# INLINE swtim #-}
swtim :: TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim :: TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base = String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Int -> String
forall a. Show a => a -> String
show Int
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
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 -> CryptoData -> CID -> FastLogger -> IO QLogger
newQlogger TimeMicrosecond
base CryptoData
rl CID
ocid FastLogger
fastLogger = do
    let ocid' :: LogStr
ocid' = CryptoData -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (CryptoData -> LogStr) -> CryptoData -> LogStr
forall a b. (a -> b) -> a -> b
$ CryptoData -> CryptoData
enc16 (CryptoData -> CryptoData) -> CryptoData -> CryptoData
forall a b. (a -> b) -> a -> b
$ CID -> CryptoData
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
<> CryptoData -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr CryptoData
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 (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 :: 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 :: 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 :: q -> IO ()
qlogRecvInitial q
q = q -> QLogger
forall a. KeepQlog a => a -> QLogger
keepQlog q
q QlogMsg
QRecvInitial

qlogSentRetry :: KeepQlog q => q -> IO ()
qlogSentRetry :: 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 :: q -> (Parameters, String) -> IO ()
qlogParamsSet q
q (Parameters, String)
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, String) -> LogStr
forall a. Qlog a => a -> LogStr
qlog (Parameters, String)
params) TimeMicrosecond
tim

qlogDebug :: KeepQlog q => q -> Debug -> IO ()
qlogDebug :: 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 :: 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