    {-# 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'