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

-- | Thread-safe QPACK encoder/decoder.
module Network.QPACK (
    -- * Encoder
    QEncoderConfig (..),
    defaultQEncoderConfig,
    QEncoder,
    newQEncoder,

    -- * Decoder
    QDecoderConfig (..),
    defaultQDecoderConfig,
    QDecoder,
    newQDecoder,

    -- ** Decoder for debugging
    QDecoderS,
    newQDecoderS,

    -- * Types
    EncodedEncoderInstruction,
    EncoderInstructionHandler,
    EncoderInstructionHandlerS,
    EncodedDecoderInstruction,
    DecoderInstructionHandler,
    InstructionHandler,
    Size,

    -- * Strategy
    EncodeStrategy (..),
    CompressionAlgo (..),

    -- * Re-exports
    HeaderTable,
    TokenHeaderList,
    ValueTable,
    Header,
    HeaderList,
    getHeaderValue,
    toHeaderTable,
    original,
    foldedCase,
    mk,
) where

import Control.Concurrent.STM
import qualified Data.ByteString as B
import Data.CaseInsensitive
import Network.ByteOrder
import Network.HPACK (
    HeaderList,
    HeaderTable,
    TokenHeaderList,
    ValueTable,
    getHeaderValue,
    toHeaderTable,
 )
import Network.HPACK.Internal
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

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

-- | QPACK encoder.
type QEncoder =
    TokenHeaderList -> IO (EncodedFieldSection, EncodedEncoderInstruction)

-- | QPACK decoder.
type QDecoder = EncodedFieldSection -> IO HeaderTable

-- | QPACK simple decoder.
type QDecoderS = EncodedFieldSection -> IO HeaderList

-- | Encoder instruction handler.
type EncoderInstructionHandler = (Int -> IO EncodedEncoderInstruction) -> IO ()

-- | Simple encoder instruction handler.
type EncoderInstructionHandlerS = EncodedEncoderInstruction -> IO ()

-- | Encoded decoder instruction.
type EncodedDecoderInstruction = ByteString

-- | Decoder instruction handler.
type DecoderInstructionHandler = (Int -> IO EncodedDecoderInstruction) -> IO ()

-- | A type to integrating handlers.
type InstructionHandler = (Int -> IO ByteString) -> IO ()

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

-- | Configuration for QPACK encoder.
data QEncoderConfig = QEncoderConfig
    { QEncoderConfig -> Size
ecDynamicTableSize :: Size
    , QEncoderConfig -> Size
ecHeaderBlockBufferSize :: 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)

-- | Default configuration for QPACK encoder.
--
-- >>> defaultQEncoderConfig
-- QEncoderConfig {ecDynamicTableSize = 4096, ecHeaderBlockBufferSize = 4096, ecPrefixBufferSize = 128, ecInstructionBufferSize = 4096, encStrategy = EncodeStrategy {compressionAlgo = Static, useHuffman = True}}
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
        }

-- | Creating a new QPACK encoder.
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
    let enc :: QEncoder
enc = EncodeStrategy
-> ForeignPtr Word8
-> Size
-> ForeignPtr Word8
-> Size
-> ForeignPtr Word8
-> Size
-> DynamicTable
-> QEncoder
qpackEncoder EncodeStrategy
encStrategy ForeignPtr Word8
gcbuf1 Size
bufsiz1 ForeignPtr Word8
gcbuf2 Size
bufsiz2 ForeignPtr Word8
gcbuf3 Size
bufsiz3 DynamicTable
dyntbl
        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
    -> TokenHeaderList
    -> IO (EncodedFieldSection, EncodedEncoderInstruction)
qpackEncoder :: EncodeStrategy
-> ForeignPtr Word8
-> Size
-> ForeignPtr Word8
-> Size
-> ForeignPtr Word8
-> Size
-> DynamicTable
-> QEncoder
qpackEncoder EncodeStrategy
stgy ForeignPtr Word8
gcbuf1 Size
bufsiz1 ForeignPtr Word8
gcbuf2 Size
bufsiz2 ForeignPtr Word8
gcbuf3 Size
bufsiz3 DynamicTable
dyntbl TokenHeaderList
ts =
    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 -- fixme: leftover
                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 -- fixme
        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 -- fixme: saving leftover
            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 ()

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

-- | Configuration for QPACK decoder.
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)

-- | Default configuration for QPACK decoder.
--
-- >>> defaultQDecoderConfig
-- QDecoderConfig {dcDynamicTableSize = 4096, dcHuffmanBufferSize = 4096}
defaultQDecoderConfig :: QDecoderConfig
defaultQDecoderConfig :: QDecoderConfig
defaultQDecoderConfig =
    QDecoderConfig
        { dcDynamicTableSize :: Size
dcDynamicTableSize = Size
4096
        , dcHuffmanBufferSize :: Size
dcHuffmanBufferSize = Size
4096
        }

-- | Creating a new QPACK decoder.
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)

-- | Creating a new simple QPACK decoder.
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 HeaderTable
qpackDecoder :: DynamicTable -> QDecoder
qpackDecoder DynamicTable
dyntbl EncodedEncoderInstruction
bs = EncodedEncoderInstruction
-> (ReadBuffer -> IO HeaderTable) -> IO HeaderTable
forall a. EncodedEncoderInstruction -> (ReadBuffer -> IO a) -> IO a
withReadBuffer EncodedEncoderInstruction
bs ((ReadBuffer -> IO HeaderTable) -> IO HeaderTable)
-> (ReadBuffer -> IO HeaderTable) -> IO HeaderTable
forall a b. (a -> b) -> a -> b
$ \ReadBuffer
rbuf -> DynamicTable -> ReadBuffer -> IO HeaderTable
decodeTokenHeader DynamicTable
dyntbl ReadBuffer
rbuf

qpackDecoderS :: DynamicTable -> EncodedFieldSection -> IO HeaderList
qpackDecoderS :: DynamicTable -> QDecoderS
qpackDecoderS DynamicTable
dyntbl EncodedEncoderInstruction
bs = EncodedEncoderInstruction
-> (ReadBuffer -> IO HeaderList) -> IO HeaderList
forall a. EncodedEncoderInstruction -> (ReadBuffer -> IO a) -> IO a
withReadBuffer EncodedEncoderInstruction
bs ((ReadBuffer -> IO HeaderList) -> IO HeaderList)
-> (ReadBuffer -> IO HeaderList) -> IO HeaderList
forall a b. (a -> b) -> a -> b
$ \ReadBuffer
rbuf -> DynamicTable -> ReadBuffer -> IO HeaderList
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 -- fixme: saving leftover
    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