{-# 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 (HeaderTable, TokenHeaderList, HeaderList, 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
showList :: [QEncoderConfig] -> ShowS
$cshowList :: [QEncoderConfig] -> ShowS
show :: QEncoderConfig -> String
$cshow :: QEncoderConfig -> String
showsPrec :: Size -> QEncoderConfig -> ShowS
$cshowsPrec :: Size -> 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 :: Size -> Size -> Size -> Size -> EncodeStrategy -> QEncoderConfig
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
encStrategy :: EncodeStrategy
ecInstructionBufferSize :: Size
ecPrefixBufferSize :: Size
ecHeaderBlockBufferSize :: Size
ecDynamicTableSize :: Size
encStrategy :: QEncoderConfig -> EncodeStrategy
ecInstructionBufferSize :: QEncoderConfig -> Size
ecPrefixBufferSize :: QEncoderConfig -> Size
ecHeaderBlockBufferSize :: QEncoderConfig -> Size
ecDynamicTableSize :: QEncoderConfig -> Size
..} = 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 (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 (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
gcbuf1 ((Ptr Word8 -> IO (ByteString, ByteString))
 -> IO (ByteString, ByteString))
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf1 ->
    ForeignPtr Word8
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
gcbuf2 ((Ptr Word8 -> IO (ByteString, ByteString))
 -> IO (ByteString, ByteString))
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf2 ->
    ForeignPtr Word8
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
gcbuf3 ((Ptr Word8 -> IO (ByteString, ByteString))
 -> IO (ByteString, ByteString))
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
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"
      ByteString
hb0 <- WriteBuffer -> IO ByteString
toByteString WriteBuffer
wbuf1
      ByteString
ins <- WriteBuffer -> IO ByteString
toByteString WriteBuffer
wbuf3
      WriteBuffer -> DynamicTable -> IO ()
encodePrefix WriteBuffer
wbuf2 DynamicTable
dyntbl
      ByteString
prefix <- WriteBuffer -> IO ByteString
toByteString WriteBuffer
wbuf2
      let hb :: ByteString
hb = ByteString
prefix ByteString -> ByteString -> ByteString
`B.append` ByteString
hb0
      (ByteString, ByteString) -> IO (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
hb, ByteString
ins)

decoderInstructionHandler :: DynamicTable -> (Int -> IO EncodedDecoderInstruction) -> IO ()
decoderInstructionHandler :: DynamicTable -> DecoderInstructionHandler
decoderInstructionHandler DynamicTable
dyntbl Size -> IO ByteString
recv = IO ()
loop
  where
    loop :: IO ()
loop = do
        InsertionPoint
_ <- DynamicTable -> IO InsertionPoint
getInsertionPoint DynamicTable
dyntbl -- fixme
        ByteString
bs <- Size -> IO ByteString
recv Size
1024
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            ([DecoderInstruction]
ins,ByteString
leftover) <- ByteString -> IO ([DecoderInstruction], ByteString)
decodeDecoderInstructions ByteString
bs -- fixme: saving leftover
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
leftover ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"") (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 (m :: * -> *) a. Monad m => a -> m a
return ()
    handle (StreamCancellation Size
_n) = () -> m ()
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 (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
showList :: [QDecoderConfig] -> ShowS
$cshowList :: [QDecoderConfig] -> ShowS
show :: QDecoderConfig -> String
$cshow :: QDecoderConfig -> String
showsPrec :: Size -> QDecoderConfig -> ShowS
$cshowsPrec :: Size -> QDecoderConfig -> ShowS
Show

-- | Default configuration for QPACK decoder.
--
-- >>> defaultQDecoderConfig
-- QDecoderConfig {dcDynamicTableSize = 4096, dcHuffmanBufferSize = 4096}
defaultQDecoderConfig :: QDecoderConfig
defaultQDecoderConfig :: QDecoderConfig
defaultQDecoderConfig = QDecoderConfig :: Size -> Size -> QDecoderConfig
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
dcHuffmanBufferSize :: Size
dcDynamicTableSize :: Size
dcHuffmanBufferSize :: QDecoderConfig -> Size
dcDynamicTableSize :: QDecoderConfig -> 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 (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
dcHuffmanBufferSize :: Size
dcDynamicTableSize :: Size
dcHuffmanBufferSize :: QDecoderConfig -> Size
dcDynamicTableSize :: QDecoderConfig -> 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 (m :: * -> *) a. Monad m => a -> m a
return (QDecoderS
dec, EncoderInstructionHandlerS
handler)

qpackDecoder :: DynamicTable -> EncodedFieldSection -> IO HeaderTable
qpackDecoder :: DynamicTable -> QDecoder
qpackDecoder DynamicTable
dyntbl ByteString
bs = ByteString -> (ReadBuffer -> IO HeaderTable) -> IO HeaderTable
forall a. ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer ByteString
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 ByteString
bs = ByteString -> (ReadBuffer -> IO HeaderList) -> IO HeaderList
forall a. ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer ByteString
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 ByteString
recv = IO ()
loop
  where
    loop :: IO ()
loop = do
        ByteString
bs <- Size -> IO ByteString
recv Size
1024
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            DynamicTable -> EncoderInstructionHandlerS
encoderInstructionHandlerS DynamicTable
dyntbl ByteString
bs
            IO ()
loop

encoderInstructionHandlerS :: DynamicTable -> EncodedEncoderInstruction -> IO ()
encoderInstructionHandlerS :: DynamicTable -> EncoderInstructionHandlerS
encoderInstructionHandlerS DynamicTable
dyntbl ByteString
bs = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ([EncoderInstruction]
ins,ByteString
leftover) <- HuffmanDecoder
-> ByteString -> IO ([EncoderInstruction], ByteString)
decodeEncoderInstructions HuffmanDecoder
hufdec ByteString
bs -- fixme: saving leftover
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
leftover ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"") (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 (m :: * -> *) a. Monad m => a -> m a
return ()
    handle (InsertWithNameReference InsIndex
ii ByteString
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 (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 (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 -> ByteString -> Entry
toEntryToken (Entry -> Token
entryToken Entry
ent0) ByteString
val
        Entry -> DynamicTable -> STM ()
insertEntryToDecoder Entry
ent DynamicTable
dyntbl
    handle (InsertWithoutNameReference Token
t ByteString
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 -> ByteString -> Entry
toEntryToken Token
t ByteString
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