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

module Network.HPACK.HeaderBlock.Decode (
    decodeHeader,
    decodeTokenHeader,
    ValueTable,
    TokenHeaderTable,
    toTokenHeaderTable,
    getFieldValue,
    decodeString,
    decodeS,
    decodeSophisticated,
    decodeSimple, -- testing
) where

import Control.Exception (catch, throwIO)
import Data.Array.Base (unsafeRead, unsafeWrite)
import qualified Data.Array.IO as IOA
import qualified Data.Array.Unsafe as Unsafe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import Data.Char (isUpper)
import Network.ByteOrder
import Network.HTTP.Semantics

import Imports hiding (empty)
import Network.HPACK.Builder
import Network.HPACK.HeaderBlock.Integer
import Network.HPACK.Huffman
import Network.HPACK.Table
import Network.HPACK.Types

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

-- | Converting the HPACK format to '[Header]'.
--
--   * Headers are decoded as is.
--   * 'DecodeError' would be thrown if the HPACK format is broken.
--   * 'BufferOverrun' will be thrown if the temporary buffer for Huffman decoding is too small.
decodeHeader
    :: DynamicTable
    -> ByteString
    -- ^ An HPACK format
    -> IO [Header]
decodeHeader :: DynamicTable -> FieldValue -> IO [Header]
decodeHeader DynamicTable
dyntbl FieldValue
inp = DynamicTable
-> FieldValue -> (ReadBuffer -> IO [Header]) -> IO [Header]
forall a.
DynamicTable -> FieldValue -> (ReadBuffer -> IO a) -> IO a
decodeHPACK DynamicTable
dyntbl FieldValue
inp ((Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO [Header]
decodeSimple (DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl))

-- | Converting the HPACK format to 'TokenHeaderList'
--   and 'ValueTable'.
--
--   * Multiple values of Cookie: are concatenated.
--   * If a pseudo header appears multiple times,
--     'IllegalHeaderName' is thrown.
--   * If unknown pseudo headers appear,
--     'IllegalHeaderName' is thrown.
--   * If pseudo headers are found after normal headers,
--     'IllegalHeaderName' is thrown.
--   * If a header key contains capital letters,
--     'IllegalHeaderName' is thrown.
--   * 'DecodeError' would be thrown if the HPACK format is broken.
--   * 'BufferOverrun' will be thrown if the temporary buffer for Huffman decoding is too small.
decodeTokenHeader
    :: DynamicTable
    -> ByteString
    -- ^ An HPACK format
    -> IO TokenHeaderTable
decodeTokenHeader :: DynamicTable -> FieldValue -> IO TokenHeaderTable
decodeTokenHeader DynamicTable
dyntbl FieldValue
inp =
    DynamicTable
-> FieldValue
-> (ReadBuffer -> IO TokenHeaderTable)
-> IO TokenHeaderTable
forall a.
DynamicTable -> FieldValue -> (ReadBuffer -> IO a) -> IO a
decodeHPACK DynamicTable
dyntbl FieldValue
inp ((Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO TokenHeaderTable
decodeSophisticated (DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl)) IO TokenHeaderTable
-> (BufferOverrun -> IO TokenHeaderTable) -> IO TokenHeaderTable
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \BufferOverrun
BufferOverrun -> DecodeError -> IO TokenHeaderTable
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO DecodeError
HeaderBlockTruncated

decodeHPACK
    :: DynamicTable
    -> ByteString
    -> (ReadBuffer -> IO a)
    -> IO a
decodeHPACK :: forall a.
DynamicTable -> FieldValue -> (ReadBuffer -> IO a) -> IO a
decodeHPACK DynamicTable
dyntbl FieldValue
inp ReadBuffer -> IO a
dec = FieldValue -> (ReadBuffer -> IO a) -> IO a
forall a. FieldValue -> (ReadBuffer -> IO a) -> IO a
withReadBuffer FieldValue
inp ReadBuffer -> IO a
chkChange
  where
    chkChange :: ReadBuffer -> IO a
chkChange ReadBuffer
rbuf = do
        w <- ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
        if isTableSizeUpdate w
            then do
                tableSizeUpdate dyntbl w rbuf
                chkChange rbuf
            else do
                ff rbuf (-1)
                dec rbuf

-- | Converting to '[Header]'.
--
--   * Headers are decoded as is.
--   * 'DecodeError' would be thrown if the HPACK format is broken.
--   * 'BufferOverrun' will be thrown if the temporary buffer for Huffman decoding is too small.
decodeSimple
    :: (Word8 -> ReadBuffer -> IO TokenHeader)
    -> ReadBuffer
    -> IO [Header]
decodeSimple :: (Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO [Header]
decodeSimple Word8 -> ReadBuffer -> IO TokenHeader
decTokenHeader ReadBuffer
rbuf = Builder TokenHeader -> IO [Header]
go Builder TokenHeader
forall a. Builder a
empty
  where
    go :: Builder TokenHeader -> IO [Header]
go Builder TokenHeader
builder = do
        leftover <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
        if leftover >= 1
            then do
                w <- read8 rbuf
                tv <- decTokenHeader w rbuf
                let builder' = Builder TokenHeader
builder Builder TokenHeader -> TokenHeader -> Builder TokenHeader
forall a. Builder a -> a -> Builder a
<< TokenHeader
tv
                go builder'
            else do
                let tvs = Builder TokenHeader -> [TokenHeader]
forall a. Builder a -> [a]
run Builder TokenHeader
builder
                    kvs = (TokenHeader -> Header) -> [TokenHeader] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map (\(Token
t, FieldValue
v) -> let k :: HeaderName
k = Token -> HeaderName
tokenKey Token
t in (HeaderName
k, FieldValue
v)) [TokenHeader]
tvs
                return kvs

headerLimit :: Int
headerLimit :: Int
headerLimit = Int
200

-- | Converting to 'TokenHeaderList' and 'ValueTable'.
--
--   * Multiple values of Cookie: are concatenated.
--   * If a pseudo header appears multiple times,
--     'IllegalHeaderName' is thrown.
--   * If unknown pseudo headers appear,
--     'IllegalHeaderName' is thrown.
--   * If pseudo headers are found after normal headers,
--     'IllegalHeaderName' is thrown.
--   * If a header key contains capital letters,
--     'IllegalHeaderName' is thrown.
--   * If the number of header fields is too large,
--     'TooLargeHeader' is thrown
--   * 'DecodeError' would be thrown if the HPACK format is broken.
--   * 'BufferOverrun' will be thrown if the temporary buffer for Huffman decoding is too small.
decodeSophisticated
    :: (Word8 -> ReadBuffer -> IO TokenHeader)
    -> ReadBuffer
    -> IO TokenHeaderTable
decodeSophisticated :: (Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO TokenHeaderTable
decodeSophisticated Word8 -> ReadBuffer -> IO TokenHeader
decTokenHeader ReadBuffer
rbuf = do
    -- using maxTokenIx to reduce condition
    arr <- (Int, Int)
-> Maybe FieldValue -> IO (IOArray Int (Maybe FieldValue))
forall i.
Ix i =>
(i, i) -> Maybe FieldValue -> IO (IOArray i (Maybe FieldValue))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
IOA.newArray (Int
minTokenIx, Int
maxTokenIx) Maybe FieldValue
forall a. Maybe a
Nothing
    tvs <- pseudoNormal arr
    tbl <- Unsafe.unsafeFreeze arr
    return (tvs, tbl)
  where
    pseudoNormal :: IOA.IOArray Int (Maybe FieldValue) -> IO TokenHeaderList
    pseudoNormal :: IOArray Int (Maybe FieldValue) -> IO [TokenHeader]
pseudoNormal IOArray Int (Maybe FieldValue)
arr = IO [TokenHeader]
pseudo
      where
        pseudo :: IO [TokenHeader]
pseudo = do
            leftover <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
            if leftover >= 1
                then do
                    w <- read8 rbuf
                    tv@(Token{..}, v) <- decTokenHeader w rbuf
                    if isPseudo
                        then do
                            mx <- unsafeRead arr tokenIx
                            -- duplicated
                            when (isJust mx) $ throwIO IllegalHeaderName
                            -- unknown
                            when (isMaxTokenIx tokenIx) $ throwIO IllegalHeaderName
                            unsafeWrite arr tokenIx (Just v)
                            pseudo
                        else do
                            -- 0-Length Headers Leak - CVE-2019-9516
                            when (tokenKey == "") $ throwIO IllegalHeaderName
                            when (isMaxTokenIx tokenIx && B8.any isUpper (original tokenKey)) $
                                throwIO IllegalHeaderName
                            unsafeWrite arr tokenIx (Just v)
                            if isCookieTokenIx tokenIx
                                then normal 0 empty (empty << v)
                                else normal 0 (empty << tv) empty
                else return []
        normal :: Int
-> Builder TokenHeader -> Builder FieldValue -> IO [TokenHeader]
normal Int
n Builder TokenHeader
builder Builder FieldValue
cookie
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
headerLimit = DecodeError -> IO [TokenHeader]
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO DecodeError
TooLargeHeader
            | Bool
otherwise = do
                leftover <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
                if leftover >= 1
                    then do
                        w <- read8 rbuf
                        tv@(Token{..}, v) <- decTokenHeader w rbuf
                        when isPseudo $ throwIO IllegalHeaderName
                        -- 0-Length Headers Leak - CVE-2019-9516
                        when (tokenKey == "") $ throwIO IllegalHeaderName
                        when (isMaxTokenIx tokenIx && B8.any isUpper (original tokenKey)) $
                            throwIO IllegalHeaderName
                        unsafeWrite arr tokenIx (Just v)
                        if isCookieTokenIx tokenIx
                            then normal (n + 1) builder (cookie << v)
                            else normal (n + 1) (builder << tv) cookie
                    else do
                        let tvs0 = Builder TokenHeader -> [TokenHeader]
forall a. Builder a -> [a]
run Builder TokenHeader
builder
                            cook = Builder FieldValue -> [FieldValue]
forall a. Builder a -> [a]
run Builder FieldValue
cookie
                        if null cook
                            then return tvs0
                            else do
                                let v = FieldValue -> [FieldValue] -> FieldValue
BS.intercalate FieldValue
"; " [FieldValue]
cook
                                    tvs = (Token
tokenCookie, FieldValue
v) TokenHeader -> [TokenHeader] -> [TokenHeader]
forall a. a -> [a] -> [a]
: [TokenHeader]
tvs0
                                unsafeWrite arr cookieTokenIx (Just v)
                                return tvs

toTokenHeader :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
    | Word8
w Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7 = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
indexed DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
    | Word8
w Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
6 = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
incrementalIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
    | Word8
w Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
5 = DecodeError -> IO TokenHeader
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO DecodeError
IllegalTableSizeUpdate
    | Word8
w Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
4 = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
neverIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
    | Bool
otherwise = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
withoutIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf

tableSizeUpdate :: DynamicTable -> Word8 -> ReadBuffer -> IO ()
tableSizeUpdate :: DynamicTable -> Word8 -> ReadBuffer -> IO ()
tableSizeUpdate DynamicTable
dyntbl Word8
w ReadBuffer
rbuf = do
    let w' :: Word8
w' = Word8 -> Word8
mask5 Word8
w
    siz <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
5 Word8
w' ReadBuffer
rbuf
    suitable <- isSuitableSize siz dyntbl
    unless suitable $ throwIO TooLargeTableSize
    renewDynamicTable siz dyntbl

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

indexed :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
indexed :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
indexed DynamicTable
dyntbl Word8
w ReadBuffer
rbuf = do
    let w' :: Word8
w' = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
w Int
7
    idx <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
7 Word8
w' ReadBuffer
rbuf
    entryTokenHeader <$> toIndexedEntry dyntbl idx

incrementalIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
incrementalIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
incrementalIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf = do
    tv@(t, v) <-
        if Word8 -> Bool
isIndexedName1 Word8
w
            then DynamicTable
-> Word8 -> ReadBuffer -> Int -> (Word8 -> Word8) -> IO TokenHeader
indexedName DynamicTable
dyntbl Word8
w ReadBuffer
rbuf Int
6 Word8 -> Word8
mask6
            else DynamicTable -> ReadBuffer -> IO TokenHeader
newName DynamicTable
dyntbl ReadBuffer
rbuf
    let e = Token -> FieldValue -> Entry
toEntryToken Token
t FieldValue
v
    insertEntry e dyntbl
    return tv

withoutIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
withoutIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
withoutIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
    | Word8 -> Bool
isIndexedName2 Word8
w = DynamicTable
-> Word8 -> ReadBuffer -> Int -> (Word8 -> Word8) -> IO TokenHeader
indexedName DynamicTable
dyntbl Word8
w ReadBuffer
rbuf Int
4 Word8 -> Word8
mask4
    | Bool
otherwise = DynamicTable -> ReadBuffer -> IO TokenHeader
newName DynamicTable
dyntbl ReadBuffer
rbuf

neverIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
neverIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
neverIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
    | Word8 -> Bool
isIndexedName2 Word8
w = DynamicTable
-> Word8 -> ReadBuffer -> Int -> (Word8 -> Word8) -> IO TokenHeader
indexedName DynamicTable
dyntbl Word8
w ReadBuffer
rbuf Int
4 Word8 -> Word8
mask4
    | Bool
otherwise = DynamicTable -> ReadBuffer -> IO TokenHeader
newName DynamicTable
dyntbl ReadBuffer
rbuf

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

indexedName
    :: DynamicTable
    -> Word8
    -> ReadBuffer
    -> Int
    -> (Word8 -> Word8)
    -> IO TokenHeader
indexedName :: DynamicTable
-> Word8 -> ReadBuffer -> Int -> (Word8 -> Word8) -> IO TokenHeader
indexedName DynamicTable
dyntbl Word8
w ReadBuffer
rbuf Int
n Word8 -> Word8
mask = do
    let p :: Word8
p = Word8 -> Word8
mask Word8
w
    idx <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
n Word8
p ReadBuffer
rbuf
    t <- entryToken <$> toIndexedEntry dyntbl idx
    val <- decStr (huffmanDecoder dyntbl) rbuf
    let tv = (Token
t, FieldValue
val)
    return tv

newName :: DynamicTable -> ReadBuffer -> IO TokenHeader
newName :: DynamicTable -> ReadBuffer -> IO TokenHeader
newName DynamicTable
dyntbl ReadBuffer
rbuf = do
    let hufdec :: HuffmanDecoder
hufdec = DynamicTable -> HuffmanDecoder
huffmanDecoder DynamicTable
dyntbl
    t <- FieldValue -> Token
toToken (FieldValue -> Token) -> IO FieldValue -> IO Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HuffmanDecoder -> ReadBuffer -> IO FieldValue
decStr HuffmanDecoder
hufdec ReadBuffer
rbuf
    val <- decStr hufdec rbuf
    let tv = (Token
t, FieldValue
val)
    return tv

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

isHuffman :: Word8 -> Bool
isHuffman :: Word8 -> Bool
isHuffman Word8
w = Word8
w Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7

dropHuffman :: Word8 -> Word8
dropHuffman :: Word8 -> Word8
dropHuffman Word8
w = Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
7

-- | String decoding (7+) with a temporal Huffman decoder whose buffer is 4096.
decodeString :: ReadBuffer -> IO ByteString
decodeString :: ReadBuffer -> IO FieldValue
decodeString ReadBuffer
rbuf = do
    let bufsiz :: Int
bufsiz = Int
4096
    gcbuf <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
4096
    decodeS dropHuffman isHuffman 7 (decodeH gcbuf bufsiz) rbuf

decStr :: HuffmanDecoder -> ReadBuffer -> IO ByteString
decStr :: HuffmanDecoder -> ReadBuffer -> IO FieldValue
decStr = (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO FieldValue
decodeS Word8 -> Word8
dropHuffman Word8 -> Bool
isHuffman Int
7

-- | String decoding with Huffman decoder.
decodeS
    :: (Word8 -> Word8)
    -- ^ Dropping prefix and Huffman
    -> (Word8 -> Bool)
    -- ^ Checking Huffman flag
    -> Int
    -- ^ N+
    -> HuffmanDecoder
    -> ReadBuffer
    -> IO ByteString
decodeS :: (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO FieldValue
decodeS Word8 -> Word8
mask Word8 -> Bool
isH Int
n HuffmanDecoder
hufdec ReadBuffer
rbuf = do
    w <- ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
    let p = Word8 -> Word8
mask Word8
w
        huff = Word8 -> Bool
isH Word8
w
    len <- decodeI n p rbuf
    if huff
        then hufdec rbuf len
        else extractByteString rbuf len

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

mask6 :: Word8 -> Word8
mask6 :: Word8 -> Word8
mask6 Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
63

mask5 :: Word8 -> Word8
mask5 :: Word8 -> Word8
mask5 Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
31

mask4 :: Word8 -> Word8
mask4 :: Word8 -> Word8
mask4 Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
15

isIndexedName1 :: Word8 -> Bool
isIndexedName1 :: Word8 -> Bool
isIndexedName1 Word8
w = Word8 -> Word8
mask6 Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0

isIndexedName2 :: Word8 -> Bool
isIndexedName2 :: Word8 -> Bool
isIndexedName2 Word8
w = Word8 -> Word8
mask4 Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0

isTableSizeUpdate :: Word8 -> Bool
isTableSizeUpdate :: Word8 -> Bool
isTableSizeUpdate Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xe0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20

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

-- | Converting a header list of the http-types style to
--   'TokenHeaderList' and 'ValueTable'.
toTokenHeaderTable :: [Header] -> IO TokenHeaderTable
toTokenHeaderTable :: [Header] -> IO TokenHeaderTable
toTokenHeaderTable [Header]
kvs = do
    arr <- (Int, Int)
-> Maybe FieldValue -> IO (IOArray Int (Maybe FieldValue))
forall i.
Ix i =>
(i, i) -> Maybe FieldValue -> IO (IOArray i (Maybe FieldValue))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
IOA.newArray (Int
minTokenIx, Int
maxTokenIx) Maybe FieldValue
forall a. Maybe a
Nothing
    tvs <- conv arr
    tbl <- Unsafe.unsafeFreeze arr
    return (tvs, tbl)
  where
    conv :: IOA.IOArray Int (Maybe FieldValue) -> IO TokenHeaderList
    conv :: IOArray Int (Maybe FieldValue) -> IO [TokenHeader]
conv IOArray Int (Maybe FieldValue)
arr = [Header] -> Builder TokenHeader -> IO [TokenHeader]
go [Header]
kvs Builder TokenHeader
forall a. Builder a
empty
      where
        go :: [Header] -> Builder TokenHeader -> IO TokenHeaderList
        go :: [Header] -> Builder TokenHeader -> IO [TokenHeader]
go [] Builder TokenHeader
builder = [TokenHeader] -> IO [TokenHeader]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TokenHeader] -> IO [TokenHeader])
-> [TokenHeader] -> IO [TokenHeader]
forall a b. (a -> b) -> a -> b
$ Builder TokenHeader -> [TokenHeader]
forall a. Builder a -> [a]
run Builder TokenHeader
builder
        go ((HeaderName
k, FieldValue
v) : [Header]
xs) Builder TokenHeader
builder = do
            let t :: Token
t = FieldValue -> Token
toToken (HeaderName -> FieldValue
forall s. CI s -> s
foldedCase HeaderName
k)
            IOArray Int (Maybe FieldValue) -> Int -> Maybe FieldValue -> IO ()
forall i.
Ix i =>
IOArray i (Maybe FieldValue) -> Int -> Maybe FieldValue -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOArray Int (Maybe FieldValue)
arr (Token -> Int
tokenIx Token
t) (FieldValue -> Maybe FieldValue
forall a. a -> Maybe a
Just FieldValue
v)
            let tv :: TokenHeader
tv = (Token
t, FieldValue
v)
                builder' :: Builder TokenHeader
builder' = Builder TokenHeader
builder Builder TokenHeader -> TokenHeader -> Builder TokenHeader
forall a. Builder a -> a -> Builder a
<< TokenHeader
tv
            [Header] -> Builder TokenHeader -> IO [TokenHeader]
go [Header]
xs Builder TokenHeader
builder'