{-# 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) = forall a. Show a => a -> [Char]
show LogStr
msg

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

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

instance Qlog CryptPacket where
    qlog :: CryptPacket -> LogStr
qlog (CryptPacket Header
hdr Crypt
_) = 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\":\"" 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
<> 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
"]}"

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\":\"" forall a. Semigroup a => a -> a -> a
<> Frame -> LogStr
frameType Frame
frame forall a. Semigroup a => a -> a -> a
<> LogStr
"\"" forall a. Semigroup a => a -> a -> a
<> Frame -> LogStr
frameExtra Frame
frame 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\":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
n
frameExtra  Frame
Ping = LogStr
""
frameExtra (Ack AckInfo
ai Delay
_Delay) = LogStr
",\"acked_ranges\":" 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\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
off forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"length\":" forall a. Semigroup a => a -> a -> a
<> 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\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
sid forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"offset\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
off forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"length\":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw (forall (f :: * -> *). (Functor f, Foldable f) => f Int -> Int
sum' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
BS.length [ByteString]
dat) forall a. Semigroup a => a -> a -> a
<> LogStr
",\"fin\":" forall a. Semigroup a => a -> a -> a
<> if Fin
fin then LogStr
"true" else LogStr
"false"
frameExtra (MaxData Int
mx) = LogStr
",\"maximum\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
mx forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra (MaxStreamData Int
sid Int
mx) = LogStr
",\"stream_id\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
sid forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"maximum\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
mx forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra (MaxStreams Direction
_Direction Int
ms) = LogStr
",\"maximum\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
ms 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\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
sn forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"connection_id:\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw CID
cid forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"retire_prior_to\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
rpt forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra (RetireConnectionID Int
sn) = LogStr
",\"sequence_number\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
sn 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\":\"" forall a. Semigroup a => a -> a -> a
<> TransportError -> LogStr
transportError TransportError
err forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"raw_error_code\":" forall a. Semigroup a => a -> a -> a
<> TransportError -> LogStr
transportError' TransportError
err forall a. Semigroup a => a -> a -> a
<> LogStr
",\"reason\":\"" forall a. Semigroup a => a -> a -> a
<> forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ReasonPhrase -> ByteString
Short.fromShort ReasonPhrase
reason) forall a. Semigroup a => a -> a -> a
<> LogStr
"\""
frameExtra (ConnectionCloseApp ApplicationProtocolError
err ReasonPhrase
reason) =  LogStr
",\"error_space\":\"application\",\"error_code\":" forall a. Semigroup a => a -> a -> a
<> ApplicationProtocolError -> LogStr
applicationProtoclError ApplicationProtocolError
err forall a. Semigroup a => a -> a -> a
<> LogStr
",\"reason\":\"" forall a. Semigroup a => a -> a -> a
<> forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ReasonPhrase -> ByteString
Short.fromShort ReasonPhrase
reason) 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)      = forall a. Show a => a -> LogStr
sw Int
n

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

applicationProtoclError :: ApplicationProtocolError -> LogStr
applicationProtoclError :: ApplicationProtocolError -> LogStr
applicationProtoclError (ApplicationProtocolError Int
n) = 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
"[" forall a. Semigroup a => a -> a -> a
<> LogStr -> Int -> [(Int, Int)] -> LogStr
ack1 LogStr
fr Int
fpn [(Int, Int)]
rs forall a. Semigroup a => a -> a -> a
<> LogStr
"]"
  where
    fpn :: Int
fpn = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lpn forall a. Num a => a -> a -> a
- Int
r
    fr :: LogStr
fr | Int
r forall a. Eq a => a -> a -> Fin
== Int
0    = LogStr
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
lpn forall a. Semigroup a => a -> a -> a
<> LogStr
"]"
       | Fin
otherwise = LogStr
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
fpn forall a. Semigroup a => a -> a -> a
<> LogStr
"," forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
lpn 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
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
f forall a. Semigroup a => a -> a -> a
<> LogStr
"," forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
l forall a. Semigroup a => a -> a -> a
<> LogStr
"]," forall a. Semigroup a => a -> a -> a
<> LogStr
ret
    l :: Int
l = Int
fpn forall a. Num a => a -> a -> a
- Int
g forall a. Num a => a -> a -> a
- Int
2
    f :: Int
f = Int
l 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
versionInformation :: Parameters -> Maybe VersionInfo
greaseQuicBit :: Parameters -> Fin
grease :: Parameters -> Maybe ByteString
retrySourceConnectionId :: Parameters -> Maybe CID
initialSourceConnectionId :: Parameters -> Maybe CID
activeConnectionIdLimit :: Parameters -> Int
preferredAddress :: Parameters -> Maybe ByteString
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
versionInformation :: Maybe VersionInfo
greaseQuicBit :: Fin
grease :: Maybe ByteString
retrySourceConnectionId :: Maybe CID
initialSourceConnectionId :: Maybe CID
activeConnectionIdLimit :: Int
preferredAddress :: Maybe ByteString
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
..},[Char]
owner) =
               LogStr
"{\"owner\":\"" forall a. Semigroup a => a -> a -> a
<> forall msg. ToLogStr msg => msg -> LogStr
toLogStr [Char]
owner
          forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"initial_max_data\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
initialMaxData
          forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"initial_max_stream_data_bidi_local\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
initialMaxStreamDataBidiLocal
          forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"initial_max_stream_data_bidi_remote\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
initialMaxStreamDataBidiRemote
          forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"initial_max_stream_data_uni\":\"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> LogStr
sw Int
initialMaxStreamDataUni
          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\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"transport:packet_received\",\"data\":" forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QSent LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"transport:packet_sent\",\"data\":"     forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QDropped LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"transport:packet_dropped\",\"data\":"  forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QParamsSet LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"transport:parameters_set\",\"data\":"  forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QMetricsUpdated LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"recovery:metrics_updated\",\"data\":"  forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QPacketLost LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"recovery:packet_lost\",\"data\":"      forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QCongestionStateUpdated LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"recovery:congestion_state_updated\",\"data\":" forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QLossTimerUpdated LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"recovery:loss_timer_updated\",\"data\":" forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QDebug LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"debug\",\"data\":" forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
toLogStrTime (QCIDUpdate LogStr
msg TimeMicrosecond
tim) TimeMicrosecond
base =
    LogStr
"{\"time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base forall a. Semigroup a => a -> a -> a
<> LogStr
",\"name\":\"connectivity:connection_id_updated\",\"data\":" forall a. Semigroup a => a -> a -> a
<> LogStr
msg forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"

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

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

{-# INLINE swtim #-}
swtim :: TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim :: TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
tim TimeMicrosecond
base = forall msg. ToLogStr msg => msg -> LogStr
toLogStr (forall a. Show a => a -> [Char]
show Int
m forall a. [a] -> [a] -> [a]
++ [Char]
"." forall a. [a] -> [a] -> [a]
++ 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 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' = forall msg. ToLogStr msg => msg -> LogStr
toLogStr forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
enc16 forall a b. (a -> b) -> a -> b
$ CID -> ByteString
fromCID CID
ocid
    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\":\"" forall a. Semigroup a => a -> a -> a
<> forall msg. ToLogStr msg => msg -> LogStr
toLogStr ByteString
rl forall a. Semigroup a => a -> a -> a
<> LogStr
"\"},\"common_fields\":{\"ODCID\":\"" forall a. Semigroup a => a -> a -> a
<> LogStr
ocid' forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"group_id\":\"" forall a. Semigroup a => a -> a -> a
<> LogStr
ocid' forall a. Semigroup a => a -> a -> a
<> LogStr
"\",\"reference_time\":" forall a. Semigroup a => a -> a -> a
<> TimeMicrosecond -> TimeMicrosecond -> LogStr
swtim TimeMicrosecond
base TimeMicrosecond
timeMicrosecond0 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
    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 = forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QReceived (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
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QDropped (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 = 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 = 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
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QParamsSet (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
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QDebug (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
    forall a. KeepQlog a => a -> QLogger
keepQlog q
q forall a b. (a -> b) -> a -> b
$ LogStr -> TimeMicrosecond -> QlogMsg
QCIDUpdate (forall a. Qlog a => a -> LogStr
qlog LR
lr) TimeMicrosecond
tim