{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.QPACK (
QEncoderConfig (..),
defaultQEncoderConfig,
QEncoder,
newQEncoder,
QDecoderConfig (..),
defaultQDecoderConfig,
QDecoder,
newQDecoder,
QDecoderS,
newQDecoderS,
EncodedEncoderInstruction,
EncoderInstructionHandler,
EncoderInstructionHandlerS,
EncodedDecoderInstruction,
DecoderInstructionHandler,
InstructionHandler,
Size,
EncodeStrategy (..),
CompressionAlgo (..),
TokenHeaderTable,
TokenHeaderList,
ValueTable,
Header,
getFieldValue,
toTokenHeaderTable,
original,
foldedCase,
mk,
) where
import Control.Concurrent
import Control.Concurrent.STM
import qualified Data.ByteString as B
import Data.CaseInsensitive
import Network.ByteOrder
import Network.HPACK.Internal (
GCBuffer,
Size,
entryToken,
toEntryToken,
toTokenHeaderTable,
)
import Network.HTTP.Types
import Network.QUIC.Internal (stdoutLogger)
import qualified UnliftIO.Exception as E
import Imports
import Network.QPACK.Error
import Network.QPACK.HeaderBlock
import Network.QPACK.Instruction
import Network.QPACK.Table
import Network.QPACK.Types
type QEncoder =
TokenHeaderList -> IO (EncodedFieldSection, EncodedEncoderInstruction)
type QDecoder = EncodedFieldSection -> IO TokenHeaderTable
type QDecoderS = EncodedFieldSection -> IO [Header]
type EncoderInstructionHandler = (Int -> IO EncodedEncoderInstruction) -> IO ()
type EncoderInstructionHandlerS = EncodedEncoderInstruction -> IO ()
type EncodedDecoderInstruction = ByteString
type DecoderInstructionHandler = (Int -> IO EncodedDecoderInstruction) -> IO ()
type InstructionHandler = (Int -> IO ByteString) -> IO ()
data QEncoderConfig = QEncoderConfig
{ QEncoderConfig -> Size
ecDynamicTableSize :: Size
, :: Size
, QEncoderConfig -> Size
ecPrefixBufferSize :: Size
, QEncoderConfig -> Size
ecInstructionBufferSize :: Size
, QEncoderConfig -> EncodeStrategy
encStrategy :: EncodeStrategy
}
deriving (Size -> QEncoderConfig -> ShowS
[QEncoderConfig] -> ShowS
QEncoderConfig -> String
(Size -> QEncoderConfig -> ShowS)
-> (QEncoderConfig -> String)
-> ([QEncoderConfig] -> ShowS)
-> Show QEncoderConfig
forall a.
(Size -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Size -> QEncoderConfig -> ShowS
showsPrec :: Size -> QEncoderConfig -> ShowS
$cshow :: QEncoderConfig -> String
show :: QEncoderConfig -> String
$cshowList :: [QEncoderConfig] -> ShowS
showList :: [QEncoderConfig] -> ShowS
Show)
defaultQEncoderConfig :: QEncoderConfig
defaultQEncoderConfig :: QEncoderConfig
defaultQEncoderConfig =
QEncoderConfig
{ ecDynamicTableSize :: Size
ecDynamicTableSize = Size
4096
, ecHeaderBlockBufferSize :: Size
ecHeaderBlockBufferSize = Size
4096
, ecPrefixBufferSize :: Size
ecPrefixBufferSize = Size
128
, ecInstructionBufferSize :: Size
ecInstructionBufferSize = Size
4096
, encStrategy :: EncodeStrategy
encStrategy = CompressionAlgo -> Bool -> EncodeStrategy
EncodeStrategy CompressionAlgo
Static Bool
True
}
newQEncoder :: QEncoderConfig -> IO (QEncoder, DecoderInstructionHandler)
newQEncoder :: QEncoderConfig -> IO (QEncoder, DecoderInstructionHandler)
newQEncoder QEncoderConfig{Size
EncodeStrategy
ecDynamicTableSize :: QEncoderConfig -> Size
ecHeaderBlockBufferSize :: QEncoderConfig -> Size
ecPrefixBufferSize :: QEncoderConfig -> Size
ecInstructionBufferSize :: QEncoderConfig -> Size
encStrategy :: QEncoderConfig -> EncodeStrategy
ecDynamicTableSize :: Size
ecHeaderBlockBufferSize :: Size
ecPrefixBufferSize :: Size
ecInstructionBufferSize :: Size
encStrategy :: EncodeStrategy
..} = do
let bufsiz1 :: Size
bufsiz1 = Size
ecHeaderBlockBufferSize
bufsiz2 :: Size
bufsiz2 = Size
ecPrefixBufferSize
bufsiz3 :: Size
bufsiz3 = Size
ecInstructionBufferSize
ForeignPtr Word8
gcbuf1 <- Size -> IO (ForeignPtr Word8)
forall a. Size -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Size
bufsiz1
ForeignPtr Word8
gcbuf2 <- Size -> IO (ForeignPtr Word8)
forall a. Size -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Size
bufsiz2
ForeignPtr Word8
gcbuf3 <- Size -> IO (ForeignPtr Word8)
forall a. Size -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Size
bufsiz3
DynamicTable
dyntbl <- Size -> IO DynamicTable
newDynamicTableForEncoding Size
ecDynamicTableSize
MVar ()
lock <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
let enc :: QEncoder
enc =
EncodeStrategy
-> ForeignPtr Word8
-> Size
-> ForeignPtr Word8
-> Size
-> ForeignPtr Word8
-> Size
-> DynamicTable
-> MVar ()
-> QEncoder
qpackEncoder
EncodeStrategy
encStrategy
ForeignPtr Word8
gcbuf1
Size
bufsiz1
ForeignPtr Word8
gcbuf2
Size
bufsiz2
ForeignPtr Word8
gcbuf3
Size
bufsiz3
DynamicTable
dyntbl
MVar ()
lock
handler :: DecoderInstructionHandler
handler = DynamicTable -> DecoderInstructionHandler
decoderInstructionHandler DynamicTable
dyntbl
(QEncoder, DecoderInstructionHandler)
-> IO (QEncoder, DecoderInstructionHandler)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (QEncoder
enc, DecoderInstructionHandler
handler)
qpackEncoder
:: EncodeStrategy
-> GCBuffer
-> Int
-> GCBuffer
-> Int
-> GCBuffer
-> Int
-> DynamicTable
-> MVar ()
-> TokenHeaderList
-> IO (EncodedFieldSection, EncodedEncoderInstruction)
qpackEncoder :: EncodeStrategy
-> ForeignPtr Word8
-> Size
-> ForeignPtr Word8
-> Size
-> ForeignPtr Word8
-> Size
-> DynamicTable
-> MVar ()
-> QEncoder
qpackEncoder EncodeStrategy
stgy ForeignPtr Word8
gcbuf1 Size
bufsiz1 ForeignPtr Word8
gcbuf2 Size
bufsiz2 ForeignPtr Word8
gcbuf3 Size
bufsiz3 DynamicTable
dyntbl MVar ()
lock TokenHeaderList
ts =
MVar ()
-> (()
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
lock ((() -> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> (()
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
ForeignPtr Word8
-> (Ptr Word8
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
gcbuf1 ((Ptr Word8
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> (Ptr Word8
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf1 ->
ForeignPtr Word8
-> (Ptr Word8
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
gcbuf2 ((Ptr Word8
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> (Ptr Word8
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf2 ->
ForeignPtr Word8
-> (Ptr Word8
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
gcbuf3 ((Ptr Word8
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> (Ptr Word8
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction))
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf3 -> do
WriteBuffer
wbuf1 <- Ptr Word8 -> Size -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf1 Size
bufsiz1
WriteBuffer
wbuf2 <- Ptr Word8 -> Size -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf2 Size
bufsiz2
WriteBuffer
wbuf3 <- Ptr Word8 -> Size -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf3 Size
bufsiz3
TokenHeaderList
thl <- WriteBuffer
-> WriteBuffer
-> EncodeStrategy
-> DynamicTable
-> TokenHeaderList
-> IO TokenHeaderList
encodeTokenHeader WriteBuffer
wbuf1 WriteBuffer
wbuf3 EncodeStrategy
stgy DynamicTable
dyntbl TokenHeaderList
ts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TokenHeaderList
thl TokenHeaderList -> TokenHeaderList -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DebugLogger
stdoutLogger Builder
"qpackEncoder: leftover"
EncodedEncoderInstruction
hb0 <- WriteBuffer -> IO EncodedEncoderInstruction
toByteString WriteBuffer
wbuf1
EncodedEncoderInstruction
ins <- WriteBuffer -> IO EncodedEncoderInstruction
toByteString WriteBuffer
wbuf3
WriteBuffer -> DynamicTable -> IO ()
encodePrefix WriteBuffer
wbuf2 DynamicTable
dyntbl
EncodedEncoderInstruction
prefix <- WriteBuffer -> IO EncodedEncoderInstruction
toByteString WriteBuffer
wbuf2
let hb :: EncodedEncoderInstruction
hb = EncodedEncoderInstruction
prefix EncodedEncoderInstruction
-> EncodedEncoderInstruction -> EncodedEncoderInstruction
`B.append` EncodedEncoderInstruction
hb0
(EncodedEncoderInstruction, EncodedEncoderInstruction)
-> IO (EncodedEncoderInstruction, EncodedEncoderInstruction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodedEncoderInstruction
hb, EncodedEncoderInstruction
ins)
decoderInstructionHandler
:: DynamicTable -> (Int -> IO EncodedDecoderInstruction) -> IO ()
decoderInstructionHandler :: DynamicTable -> DecoderInstructionHandler
decoderInstructionHandler DynamicTable
dyntbl Size -> IO EncodedEncoderInstruction
recv = IO ()
loop
where
loop :: IO ()
loop = do
InsertionPoint
_ <- DynamicTable -> IO InsertionPoint
getInsertionPoint DynamicTable
dyntbl
EncodedEncoderInstruction
bs <- Size -> IO EncodedEncoderInstruction
recv Size
1024
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncodedEncoderInstruction
bs EncodedEncoderInstruction -> EncodedEncoderInstruction -> Bool
forall a. Eq a => a -> a -> Bool
/= EncodedEncoderInstruction
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
([DecoderInstruction]
ins, EncodedEncoderInstruction
leftover) <- EncodedEncoderInstruction
-> IO ([DecoderInstruction], EncodedEncoderInstruction)
decodeDecoderInstructions EncodedEncoderInstruction
bs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncodedEncoderInstruction
leftover EncodedEncoderInstruction -> EncodedEncoderInstruction -> Bool
forall a. Eq a => a -> a -> Bool
/= EncodedEncoderInstruction
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DebugLogger
stdoutLogger Builder
"decoderInstructionHandler: leftover"
DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (DecoderInstruction -> IO ()) -> [DecoderInstruction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DecoderInstruction -> IO ()
forall a. Show a => a -> IO ()
print [DecoderInstruction]
ins
(DecoderInstruction -> IO ()) -> [DecoderInstruction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DecoderInstruction -> IO ()
forall {m :: * -> *}. MonadIO m => DecoderInstruction -> m ()
handle [DecoderInstruction]
ins
IO ()
loop
handle :: DecoderInstruction -> m ()
handle (SectionAcknowledgement Size
_n) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handle (StreamCancellation Size
_n) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handle (InsertCountIncrement Size
n)
| Size
n Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
0 = DecoderInstructionError -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO DecoderInstructionError
DecoderInstructionError
| Bool
otherwise = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data QDecoderConfig = QDecoderConfig
{ QDecoderConfig -> Size
dcDynamicTableSize :: Size
, QDecoderConfig -> Size
dcHuffmanBufferSize :: Size
}
deriving (Size -> QDecoderConfig -> ShowS
[QDecoderConfig] -> ShowS
QDecoderConfig -> String
(Size -> QDecoderConfig -> ShowS)
-> (QDecoderConfig -> String)
-> ([QDecoderConfig] -> ShowS)
-> Show QDecoderConfig
forall a.
(Size -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Size -> QDecoderConfig -> ShowS
showsPrec :: Size -> QDecoderConfig -> ShowS
$cshow :: QDecoderConfig -> String
show :: QDecoderConfig -> String
$cshowList :: [QDecoderConfig] -> ShowS
showList :: [QDecoderConfig] -> ShowS
Show)
defaultQDecoderConfig :: QDecoderConfig
defaultQDecoderConfig :: QDecoderConfig
defaultQDecoderConfig =
QDecoderConfig
{ dcDynamicTableSize :: Size
dcDynamicTableSize = Size
4096
, dcHuffmanBufferSize :: Size
dcHuffmanBufferSize = Size
4096
}
newQDecoder :: QDecoderConfig -> IO (QDecoder, EncoderInstructionHandler)
newQDecoder :: QDecoderConfig -> IO (QDecoder, DecoderInstructionHandler)
newQDecoder QDecoderConfig{Size
dcDynamicTableSize :: QDecoderConfig -> Size
dcHuffmanBufferSize :: QDecoderConfig -> Size
dcDynamicTableSize :: Size
dcHuffmanBufferSize :: Size
..} = do
DynamicTable
dyntbl <- Size -> Size -> IO DynamicTable
newDynamicTableForDecoding Size
dcDynamicTableSize Size
dcHuffmanBufferSize
let dec :: QDecoder
dec = DynamicTable -> QDecoder
qpackDecoder DynamicTable
dyntbl
handler :: DecoderInstructionHandler
handler = DynamicTable -> DecoderInstructionHandler
encoderInstructionHandler DynamicTable
dyntbl
(QDecoder, DecoderInstructionHandler)
-> IO (QDecoder, DecoderInstructionHandler)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (QDecoder
dec, DecoderInstructionHandler
handler)
newQDecoderS
:: QDecoderConfig -> Bool -> IO (QDecoderS, EncoderInstructionHandlerS)
newQDecoderS :: QDecoderConfig
-> Bool -> IO (QDecoderS, EncoderInstructionHandlerS)
newQDecoderS QDecoderConfig{Size
dcDynamicTableSize :: QDecoderConfig -> Size
dcHuffmanBufferSize :: QDecoderConfig -> Size
dcDynamicTableSize :: Size
dcHuffmanBufferSize :: Size
..} Bool
debug = do
DynamicTable
dyntbl <- Size -> Size -> IO DynamicTable
newDynamicTableForDecoding Size
dcDynamicTableSize Size
dcHuffmanBufferSize
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicTable -> IO ()
setDebugQPACK DynamicTable
dyntbl
let dec :: QDecoderS
dec = DynamicTable -> QDecoderS
qpackDecoderS DynamicTable
dyntbl
handler :: EncoderInstructionHandlerS
handler = DynamicTable -> EncoderInstructionHandlerS
encoderInstructionHandlerS DynamicTable
dyntbl
(QDecoderS, EncoderInstructionHandlerS)
-> IO (QDecoderS, EncoderInstructionHandlerS)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (QDecoderS
dec, EncoderInstructionHandlerS
handler)
qpackDecoder :: DynamicTable -> EncodedFieldSection -> IO TokenHeaderTable
qpackDecoder :: DynamicTable -> QDecoder
qpackDecoder DynamicTable
dyntbl EncodedEncoderInstruction
bs = EncodedEncoderInstruction
-> (ReadBuffer -> IO TokenHeaderTable) -> IO TokenHeaderTable
forall a. EncodedEncoderInstruction -> (ReadBuffer -> IO a) -> IO a
withReadBuffer EncodedEncoderInstruction
bs ((ReadBuffer -> IO TokenHeaderTable) -> IO TokenHeaderTable)
-> (ReadBuffer -> IO TokenHeaderTable) -> IO TokenHeaderTable
forall a b. (a -> b) -> a -> b
$ \ReadBuffer
rbuf -> DynamicTable -> ReadBuffer -> IO TokenHeaderTable
decodeTokenHeader DynamicTable
dyntbl ReadBuffer
rbuf
qpackDecoderS :: DynamicTable -> EncodedFieldSection -> IO [Header]
qpackDecoderS :: DynamicTable -> QDecoderS
qpackDecoderS DynamicTable
dyntbl EncodedEncoderInstruction
bs = EncodedEncoderInstruction
-> (ReadBuffer -> IO [Header]) -> IO [Header]
forall a. EncodedEncoderInstruction -> (ReadBuffer -> IO a) -> IO a
withReadBuffer EncodedEncoderInstruction
bs ((ReadBuffer -> IO [Header]) -> IO [Header])
-> (ReadBuffer -> IO [Header]) -> IO [Header]
forall a b. (a -> b) -> a -> b
$ \ReadBuffer
rbuf -> DynamicTable -> ReadBuffer -> IO [Header]
decodeTokenHeaderS DynamicTable
dyntbl ReadBuffer
rbuf
encoderInstructionHandler
:: DynamicTable -> (Int -> IO EncodedEncoderInstruction) -> IO ()
encoderInstructionHandler :: DynamicTable -> DecoderInstructionHandler
encoderInstructionHandler DynamicTable
dyntbl Size -> IO EncodedEncoderInstruction
recv = IO ()
loop
where
loop :: IO ()
loop = do
EncodedEncoderInstruction
bs <- Size -> IO EncodedEncoderInstruction
recv Size
1024
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncodedEncoderInstruction
bs EncodedEncoderInstruction -> EncodedEncoderInstruction -> Bool
forall a. Eq a => a -> a -> Bool
/= EncodedEncoderInstruction
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
DynamicTable -> EncoderInstructionHandlerS
encoderInstructionHandlerS DynamicTable
dyntbl EncodedEncoderInstruction
bs
IO ()
loop
encoderInstructionHandlerS :: DynamicTable -> EncodedEncoderInstruction -> IO ()
encoderInstructionHandlerS :: DynamicTable -> EncoderInstructionHandlerS
encoderInstructionHandlerS DynamicTable
dyntbl EncodedEncoderInstruction
bs = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncodedEncoderInstruction
bs EncodedEncoderInstruction -> EncodedEncoderInstruction -> Bool
forall a. Eq a => a -> a -> Bool
/= EncodedEncoderInstruction
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
([EncoderInstruction]
ins, EncodedEncoderInstruction
leftover) <- HuffmanDecoder
-> EncodedEncoderInstruction
-> IO ([EncoderInstruction], EncodedEncoderInstruction)
decodeEncoderInstructions HuffmanDecoder
hufdec EncodedEncoderInstruction
bs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncodedEncoderInstruction
leftover EncodedEncoderInstruction -> EncodedEncoderInstruction -> Bool
forall a. Eq a => a -> a -> Bool
/= EncodedEncoderInstruction
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DebugLogger
stdoutLogger Builder
"encoderInstructionHandler: leftover"
DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (EncoderInstruction -> IO ()) -> [EncoderInstruction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EncoderInstruction -> IO ()
forall a. Show a => a -> IO ()
print [EncoderInstruction]
ins
(EncoderInstruction -> IO ()) -> [EncoderInstruction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EncoderInstruction -> IO ()
handle [EncoderInstruction]
ins
where
hufdec :: HuffmanDecoder
hufdec = DynamicTable -> HuffmanDecoder
getHuffmanDecoder DynamicTable
dyntbl
handle :: EncoderInstruction -> IO ()
handle (SetDynamicTableCapacity Size
n)
| Size
n Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
4096 = EncoderInstructionError -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO EncoderInstructionError
EncoderInstructionError
| Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handle (InsertWithNameReference InsIndex
ii EncodedEncoderInstruction
val) = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
HIndex
idx <- case InsIndex
ii of
Left AbsoluteIndex
ai -> HIndex -> STM HIndex
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HIndex -> STM HIndex) -> HIndex -> STM HIndex
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> HIndex
SIndex AbsoluteIndex
ai
Right InsRelativeIndex
ri -> do
InsertionPoint
ip <- DynamicTable -> STM InsertionPoint
getInsertionPointSTM DynamicTable
dyntbl
HIndex -> STM HIndex
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HIndex -> STM HIndex) -> HIndex -> STM HIndex
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> HIndex
DIndex (AbsoluteIndex -> HIndex) -> AbsoluteIndex -> HIndex
forall a b. (a -> b) -> a -> b
$ InsRelativeIndex -> InsertionPoint -> AbsoluteIndex
fromInsRelativeIndex InsRelativeIndex
ri InsertionPoint
ip
Entry
ent0 <- DynamicTable -> HIndex -> STM Entry
toIndexedEntry DynamicTable
dyntbl HIndex
idx
let ent :: Entry
ent = Token -> EncodedEncoderInstruction -> Entry
toEntryToken (Entry -> Token
entryToken Entry
ent0) EncodedEncoderInstruction
val
Entry -> DynamicTable -> STM ()
insertEntryToDecoder Entry
ent DynamicTable
dyntbl
handle (InsertWithoutNameReference Token
t EncodedEncoderInstruction
val) = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let ent :: Entry
ent = Token -> EncodedEncoderInstruction -> Entry
toEntryToken Token
t EncodedEncoderInstruction
val
Entry -> DynamicTable -> STM ()
insertEntryToDecoder Entry
ent DynamicTable
dyntbl
handle (Duplicate InsRelativeIndex
ri) = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
InsertionPoint
ip <- DynamicTable -> STM InsertionPoint
getInsertionPointSTM DynamicTable
dyntbl
let idx :: HIndex
idx = AbsoluteIndex -> HIndex
DIndex (AbsoluteIndex -> HIndex) -> AbsoluteIndex -> HIndex
forall a b. (a -> b) -> a -> b
$ InsRelativeIndex -> InsertionPoint -> AbsoluteIndex
fromInsRelativeIndex InsRelativeIndex
ri InsertionPoint
ip
Entry
ent <- DynamicTable -> HIndex -> STM Entry
toIndexedEntry DynamicTable
dyntbl HIndex
idx
Entry -> DynamicTable -> STM ()
insertEntryToDecoder Entry
ent DynamicTable
dyntbl