    {-# LANGUAGE RecordWildCards #-}

    module Network.HPACK.HeaderBlock.Encode (
        encodeHeader,
        encodeTokenHeader,
        encodeString,
        encodeS,
    ) where

    import Control.Exception (bracket, throwIO)
    import qualified Control.Exception as E
    import qualified Data.ByteString as BS
    import Data.ByteString.Internal (create)
    import Data.IORef
    import Foreign.Marshal.Alloc (free, mallocBytes)
    import Foreign.Marshal.Utils (copyBytes)
    import Foreign.Ptr (minusPtr)
    import Network.ByteOrder
    import Network.HTTP.Semantics

    import Imports
    import Network.HPACK.HeaderBlock.Integer
    import Network.HPACK.Huffman
    import Network.HPACK.Table
    import Network.HPACK.Types

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

    changeTableSize :: DynamicTable -> WriteBuffer -> IO ()
    changeTableSize :: DynamicTable -> WriteBuffer -> IO ()
    changeTableSize DynamicTable
    dyntbl WriteBuffer
    wbuf = do
        msiz <- DynamicTable -> IO TableSizeAction
    needChangeTableSize DynamicTable
    dyntbl
        case msiz of
            TableSizeAction
    Keep -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Change Int
    lim -> do
                Int -> DynamicTable -> IO ()
    renewDynamicTable Int
    lim DynamicTable
    dyntbl
                WriteBuffer -> Int -> IO ()
    change WriteBuffer
    wbuf Int
    lim
            Ignore Int
    lim -> do
                DynamicTable -> IO ()
    resetLimitForEncoding DynamicTable
    dyntbl
                WriteBuffer -> Int -> IO ()
    change WriteBuffer
    wbuf Int
    lim

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

    -- | Converting '[Header]' to the HPACK format.
    --   This function has overhead of allocating/freeing a temporary buffer.
    --   'BufferOverrun' will be thrown if the temporary buffer is too small.
    encodeHeader
        :: EncodeStrategy
        -> Size
        -- ^ The size of a temporary buffer.
        -> DynamicTable
        -> [Header]
        -> IO ByteString
        -- ^ An HPACK format
    encodeHeader :: EncodeStrategy -> Int -> DynamicTable -> [Header] -> IO ByteString
    encodeHeader EncodeStrategy
    stgy Int
    siz DynamicTable
    dyntbl [Header]
    hs = EncodeStrategy
    -> Int -> DynamicTable -> TokenHeaderList -> IO ByteString
    encodeHeader' EncodeStrategy
    stgy Int
    siz DynamicTable
    dyntbl TokenHeaderList
    hs'
      where
        mk' :: (CI ByteString, b) -> (Token, b)
    mk' (CI ByteString
    k, b
    v) = (Token
    t, b
    v)
          where
            t :: Token
    t = ByteString -> Token
    toToken (ByteString -> Token) -> ByteString -> Token
    forall a b. (a -> b) -> a -> b
    $ CI ByteString -> ByteString
    forall s. CI s -> s
    foldedCase CI ByteString
    k
        hs' :: TokenHeaderList
    hs' = (Header -> (Token, ByteString)) -> [Header] -> TokenHeaderList
    forall a b. (a -> b) -> [a] -> [b]
    map Header -> (Token, ByteString)
    forall {b}. (CI ByteString, b) -> (Token, b)
    mk' [Header]
    hs

    -- | Converting 'TokenHeaderList' to the HPACK format.
    --   'BufferOverrun' will be thrown if the temporary buffer is too small.
    encodeHeader'
        :: EncodeStrategy
        -> Size
        -- ^ The size of a temporary buffer.
        -> DynamicTable
        -> TokenHeaderList
        -> IO ByteString
        -- ^ An HPACK format
    encodeHeader' :: EncodeStrategy
    -> Int -> DynamicTable -> TokenHeaderList -> IO ByteString
    encodeHeader' EncodeStrategy
    stgy Int
    siz DynamicTable
    dyntbl TokenHeaderList
    hs = IO (Ptr Word8)
    -> (Ptr Word8 -> IO ())
    -> (Ptr Word8 -> IO ByteString)
    -> IO ByteString
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    siz) Ptr Word8 -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr Word8 -> IO ByteString
    enc
      where
        enc :: Ptr Word8 -> IO ByteString
    enc Ptr Word8
    buf = do
            (hs', len) <- Ptr Word8
    -> Int
    -> EncodeStrategy
    -> Bool
    -> DynamicTable
    -> TokenHeaderList
    -> IO (TokenHeaderList, Int)
    encodeTokenHeader Ptr Word8
    buf Int
    siz EncodeStrategy
    stgy Bool
    True DynamicTable
    dyntbl TokenHeaderList
    hs
            case hs' of
                [] -> Int -> (Ptr Word8 -> IO ()) -> IO ByteString
    create Int
    len ((Ptr Word8 -> IO ()) -> IO ByteString)
    -> (Ptr Word8 -> IO ()) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    p -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr Word8
    p Ptr Word8
    buf Int
    len
                TokenHeaderList
    _ -> BufferOverrun -> IO ByteString
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO BufferOverrun
    BufferOverrun

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

    -- | Converting 'TokenHeaderList' to the HPACK format directly in the buffer.
    --
    --   When calling this function for a new 'TokenHeaderList',
    --   4th argument must be 'True'.
    --
    --   The return value is a pair of leftover 'TokenHeaderList' and
    --   how many bytes are filled in the buffer.
    --   If the leftover is empty, the encoding is finished.
    --   Otherwise, this function should be called with it again.
    --   4th argument must be 'False'.
    --
    --   4th argument is relating to dynamic table size update.
    --   If 'True' and the limit is set by 'setLimitForEncoding',
    --   dynamic table size update is generated at the beginning of
    --   the HPACK format.
    encodeTokenHeader
        :: Buffer
        -> BufferSize
        -> EncodeStrategy
        -> Bool
        -- ^ 'True' at the first time, 'False' when continued.
        -> DynamicTable
        -> TokenHeaderList
        -> IO (TokenHeaderList, Int)
        -- ^ Leftover, filled length
    encodeTokenHeader :: Ptr Word8
    -> Int
    -> EncodeStrategy
    -> Bool
    -> DynamicTable
    -> TokenHeaderList
    -> IO (TokenHeaderList, Int)
    encodeTokenHeader Ptr Word8
    buf Int
    siz EncodeStrategy{Bool
    CompressionAlgo
    compressionAlgo :: CompressionAlgo
    useHuffman :: Bool
    useHuffman :: EncodeStrategy -> Bool
    compressionAlgo :: EncodeStrategy -> CompressionAlgo
    ..} Bool
    first DynamicTable
    dyntbl TokenHeaderList
    hs0 = do
        wbuf <- Ptr Word8 -> Int -> IO WriteBuffer
    newWriteBuffer Ptr Word8
    buf Int
    siz
        when first $ changeTableSize dyntbl wbuf
        let fa = DynamicTable -> WriteBuffer -> Bool -> FA
    indexedHeaderField DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    useHuffman
            fb = DynamicTable -> WriteBuffer -> Bool -> FB
    literalHeaderFieldWithIncrementalIndexingIndexedName DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    useHuffman
            fc = DynamicTable -> WriteBuffer -> Bool -> FC
    literalHeaderFieldWithIncrementalIndexingNewName DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    useHuffman
            fd = DynamicTable -> WriteBuffer -> Bool -> FD
    literalHeaderFieldWithoutIndexingIndexedName DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    useHuffman
            fe = DynamicTable -> WriteBuffer -> Bool -> FE
    literalHeaderFieldWithoutIndexingNewName DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    useHuffman
            fe' = DynamicTable -> WriteBuffer -> Bool -> FE
    literalHeaderFieldWithoutIndexingNewName' DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    useHuffman
            rev = DynamicTable -> RevIndex
    getRevIndex DynamicTable
    dyntbl
            step0 = case CompressionAlgo
    compressionAlgo of
                CompressionAlgo
    Naive -> FE -> Token -> ByteString -> IO ()
    naiveStep FE
    fe'
                CompressionAlgo
    Static -> FA -> FD -> FE -> Token -> ByteString -> IO ()
    staticStep FA
    fa FD
    fd FE
    fe
                CompressionAlgo
    Linear -> RevIndex -> FA -> FB -> FC -> FD -> Token -> ByteString -> IO ()
    linearStep RevIndex
    rev FA
    fa FB
    fb FC
    fc FD
    fd
        ref1 <- currentOffset wbuf >>= newIORef
        ref2 <- newIORef hs0
        loop wbuf ref1 ref2 step0 hs0 `E.catch` \BufferOverrun
    BufferOverrun -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        end <- readIORef ref1
        let len = Ptr Word8
    end Ptr Word8 -> Ptr Word8 -> Int
    forall a b. Ptr a -> Ptr b -> Int
    `minusPtr` Ptr Word8
    buf
        hs <- readIORef ref2
        return (hs, len)
      where
        loop :: WriteBuffer
    -> IORef (Ptr Word8)
    -> IORef [(t, t)]
    -> (t -> t -> IO a)
    -> [(t, t)]
    -> IO ()
    loop WriteBuffer
    wbuf IORef (Ptr Word8)
    ref1 IORef [(t, t)]
    ref2 t -> t -> IO a
    step [(t, t)]
    hsx = [(t, t)] -> IO ()
    go [(t, t)]
    hsx
          where
            go :: [(t, t)] -> IO ()
    go [] = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            go ((t
    t, t
    v) : [(t, t)]
    hs) = do
                _ <- t -> t -> IO a
    step t
    t t
    v
                currentOffset wbuf >>= writeIORef ref1
                writeIORef ref2 hs
                go hs

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

    naiveStep
        :: (FieldName -> FieldValue -> IO ()) -> Token -> FieldValue -> IO ()
    naiveStep :: FE -> Token -> ByteString -> IO ()
    naiveStep FE
    fe Token
    t ByteString
    v = FE
    fe (Token -> ByteString
    tokenFoldedKey Token
    t) ByteString
    v

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

    staticStep :: FA -> FD -> FE -> Token -> FieldValue -> IO ()
    staticStep :: FA -> FD -> FE -> Token -> ByteString -> IO ()
    staticStep FA
    fa FD
    fd FE
    fe Token
    t ByteString
    v = Token -> ByteString -> FA -> FD -> FE -> IO ()
    lookupRevIndex' Token
    t ByteString
    v FA
    fa FD
    fd FE
    fe

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

    linearStep :: RevIndex -> FA -> FB -> FC -> FD -> Token -> FieldValue -> IO ()
    linearStep :: RevIndex -> FA -> FB -> FC -> FD -> Token -> ByteString -> IO ()
    linearStep RevIndex
    rev FA
    fa FB
    fb FC
    fc FD
    fd Token
    t ByteString
    v = Token -> ByteString -> FA -> FB -> FC -> FD -> RevIndex -> IO ()
    lookupRevIndex Token
    t ByteString
    v FA
    fa FB
    fb FC
    fc FD
    fd RevIndex
    rev

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

    type FA = HIndex -> IO ()
    type FB = FieldValue -> Entry -> HIndex -> IO ()
    type FC = FieldName -> FieldValue -> Entry -> IO ()
    type FD = FieldValue -> HIndex -> IO ()
    type FE = FieldName -> FieldValue -> IO ()

    -- 6.1.  Indexed Header Field Representation
    -- Indexed Header Field
    indexedHeaderField
        :: DynamicTable -> WriteBuffer -> Bool -> FA
    indexedHeaderField :: DynamicTable -> WriteBuffer -> Bool -> FA
    indexedHeaderField DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    _ HIndex
    hidx =
        DynamicTable -> HIndex -> IO Int
    fromHIndexToIndex DynamicTable
    dyntbl HIndex
    hidx IO Int -> (Int -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= WriteBuffer -> Int -> IO ()
    index WriteBuffer
    wbuf

    -- 6.2.1.  Literal Header Field with Incremental Indexing
    -- Literal Header Field with Incremental Indexing -- Indexed Name
    literalHeaderFieldWithIncrementalIndexingIndexedName
        :: DynamicTable -> WriteBuffer -> Bool -> FB
    literalHeaderFieldWithIncrementalIndexingIndexedName :: DynamicTable -> WriteBuffer -> Bool -> FB
    literalHeaderFieldWithIncrementalIndexingIndexedName DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    huff ByteString
    v Entry
    ent HIndex
    hidx = do
        DynamicTable -> HIndex -> IO Int
    fromHIndexToIndex DynamicTable
    dyntbl HIndex
    hidx IO Int -> (Int -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= WriteBuffer -> Bool -> Int -> Setter -> ByteString -> Int -> IO ()
    indexedName WriteBuffer
    wbuf Bool
    huff Int
    6 Setter
    set01 ByteString
    v
        Entry -> DynamicTable -> IO ()
    insertEntry Entry
    ent DynamicTable
    dyntbl

    -- 6.2.1.  Literal Header Field with Incremental Indexing
    -- Literal Header Field with Incremental Indexing -- New Name
    literalHeaderFieldWithIncrementalIndexingNewName
        :: DynamicTable -> WriteBuffer -> Bool -> FC
    literalHeaderFieldWithIncrementalIndexingNewName :: DynamicTable -> WriteBuffer -> Bool -> FC
    literalHeaderFieldWithIncrementalIndexingNewName DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    huff ByteString
    k ByteString
    v Entry
    ent = do
        WriteBuffer -> Bool -> Setter -> FE
    newName WriteBuffer
    wbuf Bool
    huff Setter
    set01 ByteString
    k ByteString
    v
        Entry -> DynamicTable -> IO ()
    insertEntry Entry
    ent DynamicTable
    dyntbl

    -- 6.2.2.  Literal Header Field without Indexing
    -- Literal Header Field without Indexing -- Indexed Name
    literalHeaderFieldWithoutIndexingIndexedName
        :: DynamicTable -> WriteBuffer -> Bool -> FD
    literalHeaderFieldWithoutIndexingIndexedName :: DynamicTable -> WriteBuffer -> Bool -> FD
    literalHeaderFieldWithoutIndexingIndexedName DynamicTable
    dyntbl WriteBuffer
    wbuf Bool
    huff ByteString
    v HIndex
    hidx =
        DynamicTable -> HIndex -> IO Int
    fromHIndexToIndex DynamicTable
    dyntbl HIndex
    hidx IO Int -> (Int -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= WriteBuffer -> Bool -> Int -> Setter -> ByteString -> Int -> IO ()
    indexedName WriteBuffer
    wbuf Bool
    huff Int
    4 Setter
    set0000 ByteString
    v

    -- 6.2.2.  Literal Header Field without Indexing
    -- Literal Header Field without Indexing -- New Name
    literalHeaderFieldWithoutIndexingNewName
        :: DynamicTable -> WriteBuffer -> Bool -> FE
    literalHeaderFieldWithoutIndexingNewName :: DynamicTable -> WriteBuffer -> Bool -> FE
    literalHeaderFieldWithoutIndexingNewName DynamicTable
    _ WriteBuffer
    wbuf Bool
    huff ByteString
    k ByteString
    v =
        WriteBuffer -> Bool -> Setter -> FE
    newName WriteBuffer
    wbuf Bool
    huff Setter
    set0000 ByteString
    k ByteString
    v

    literalHeaderFieldWithoutIndexingNewName'
        :: DynamicTable -> WriteBuffer -> Bool -> FieldName -> FieldValue -> IO ()
    literalHeaderFieldWithoutIndexingNewName' :: DynamicTable -> WriteBuffer -> Bool -> FE
    literalHeaderFieldWithoutIndexingNewName' DynamicTable
    _ WriteBuffer
    wbuf Bool
    huff ByteString
    k ByteString
    v =
        WriteBuffer -> Bool -> Setter -> FE
    newName WriteBuffer
    wbuf Bool
    huff Setter
    set0000 ByteString
    k ByteString
    v

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

    {-# INLINE change #-}
    change :: WriteBuffer -> Int -> IO ()
    change :: WriteBuffer -> Int -> IO ()
    change WriteBuffer
    wbuf Int
    i = WriteBuffer -> Setter -> Int -> Int -> IO ()
    encodeI WriteBuffer
    wbuf Setter
    set001 Int
    5 Int
    i

    {-# INLINE index #-}
    index :: WriteBuffer -> Int -> IO ()
    index :: WriteBuffer -> Int -> IO ()
    index WriteBuffer
    wbuf Int
    i = WriteBuffer -> Setter -> Int -> Int -> IO ()
    encodeI WriteBuffer
    wbuf Setter
    set1 Int
    7 Int
    i

    -- Using Huffman encoding
    {-# INLINE indexedName #-}
    indexedName
        :: WriteBuffer -> Bool -> Int -> Setter -> FieldValue -> Index -> IO ()
    indexedName :: WriteBuffer -> Bool -> Int -> Setter -> ByteString -> Int -> IO ()
    indexedName WriteBuffer
    wbuf Bool
    huff Int
    n Setter
    set ByteString
    v Int
    idx = do
        WriteBuffer -> Setter -> Int -> Int -> IO ()
    encodeI WriteBuffer
    wbuf Setter
    set Int
    n Int
    idx
        WriteBuffer -> Bool -> ByteString -> IO ()
    encStr WriteBuffer
    wbuf Bool
    huff ByteString
    v

    -- Using Huffman encoding
    {-# INLINE newName #-}
    newName :: WriteBuffer -> Bool -> Setter -> FieldName -> FieldValue -> IO ()
    newName :: WriteBuffer -> Bool -> Setter -> FE
    newName WriteBuffer
    wbuf Bool
    huff Setter
    set ByteString
    k ByteString
    v = do
        WriteBuffer -> Word8 -> IO ()
    write8 WriteBuffer
    wbuf (Word8 -> IO ()) -> Word8 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Setter
    set Word8
    0
        WriteBuffer -> Bool -> ByteString -> IO ()
    encStr WriteBuffer
    wbuf Bool
    huff ByteString
    k
        WriteBuffer -> Bool -> ByteString -> IO ()
    encStr WriteBuffer
    wbuf Bool
    huff ByteString
    v

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

    type Setter = Word8 -> Word8

    -- Assuming MSBs are 0.
    set1, set01, set001, set0000 :: Setter
    set1 :: Setter
    set1 Word8
    x = Word8
    x Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    7
    set01 :: Setter
    set01 Word8
    x = Word8
    x Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    6
    set001 :: Setter
    set001 Word8
    x = Word8
    x Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    5
    -- set0001 x = x `setBit` 4 -- Never indexing
    set0000 :: Setter
    set0000 = Setter
    forall a. a -> a
    id

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

    -- | String encoding.
    --   The algorithm based on copy avoidance and
    --   selection of better result of huffman or raw.
    encodeS
        :: WriteBuffer
        -> Bool
        -- ^ Use Huffman if efficient
        -> (Word8 -> Word8)
        -- ^ Setting prefix
        -> (Word8 -> Word8)
        -- ^ Setting huffman flag
        -> Int
        -- ^ N+
        -> ByteString
        -- ^ Target
        -> IO ()
    encodeS :: WriteBuffer
    -> Bool -> Setter -> Setter -> Int -> ByteString -> IO ()
    encodeS WriteBuffer
    wbuf Bool
    False Setter
    set Setter
    _ Int
    n ByteString
    bs = do
        let len :: Int
    len = ByteString -> Int
    BS.length ByteString
    bs
        WriteBuffer -> Setter -> Int -> Int -> IO ()
    encodeI WriteBuffer
    wbuf Setter
    set Int
    n Int
    len
        WriteBuffer -> ByteString -> IO ()
    copyByteString WriteBuffer
    wbuf ByteString
    bs
    encodeS WriteBuffer
    wbuf Bool
    True Setter
    set Setter
    setH Int
    n ByteString
    bs = do
        let origLen :: Int
    origLen = ByteString -> Int
    BS.length ByteString
    bs
            expectedLen :: Int
    expectedLen = (Int
    origLen Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    10) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8 -- 80%: decided by examples
            expectedIntLen :: Int
    expectedIntLen = Int -> Int -> Int
    integerLength Int
    n Int
    expectedLen
        WriteBuffer -> Int -> IO ()
    forall a. Readable a => a -> Int -> IO ()
    ff WriteBuffer
    wbuf Int
    expectedIntLen
        len <- WriteBuffer -> ByteString -> IO Int
    encodeH WriteBuffer
    wbuf ByteString
    bs
        let intLen = Int -> Int -> Int
    integerLength Int
    n Int
    len
        if origLen < len
            then do
                ff wbuf (negate (expectedIntLen + len))
                encodeI wbuf set n origLen
                copyByteString wbuf bs
            else
                if intLen == expectedIntLen
                    then do
                        ff wbuf (negate (expectedIntLen + len))
                        encodeI wbuf (set . setH) n len
                        ff wbuf len
                    else do
                        let gap = Int
    intLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    expectedIntLen
                        shiftLastN wbuf gap len
                        ff wbuf (negate (intLen + len))
                        encodeI wbuf (set . setH) n len
                        ff wbuf len

    {-# INLINE encStr #-}
    encStr :: WriteBuffer -> Bool -> ByteString -> IO ()
    encStr :: WriteBuffer -> Bool -> ByteString -> IO ()
    encStr WriteBuffer
    wbuf Bool
    h ByteString
    bs = WriteBuffer
    -> Bool -> Setter -> Setter -> Int -> ByteString -> IO ()
    encodeS WriteBuffer
    wbuf Bool
    h Setter
    forall a. a -> a
    id (Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    7) Int
    7 ByteString
    bs

    -- | String encoding (7+) with a temporary buffer whose size is 4096.
    encodeString
        :: Bool
        -- ^ Use Huffman if efficient
        -> ByteString
        -- ^ Target
        -> IO ByteString
    encodeString :: Bool -> ByteString -> IO ByteString
    encodeString Bool
    h ByteString
    bs = Int -> (WriteBuffer -> IO ()) -> IO ByteString
    withWriteBuffer Int
    4096 ((WriteBuffer -> IO ()) -> IO ByteString)
    -> (WriteBuffer -> IO ()) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \WriteBuffer
    wbuf -> WriteBuffer -> Bool -> ByteString -> IO ()
    encStr WriteBuffer
    wbuf Bool
    h ByteString
    bs

    {-
    N+   1   2     3 <- bytes
    8  254 382 16638
    7  126 254 16510
    6   62 190 16446
    5   30 158 16414
    4   14 142 16398
    3    6 134 16390
    2    2 130 16386
    1    0 128 16384
    -}

    {-# INLINE integerLength #-}
    integerLength :: Int -> Int -> Int
    integerLength :: Int -> Int -> Int
    integerLength Int
    8 Int
    l
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    254 = Int
    1
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    382 = Int
    2
        | Bool
    otherwise = Int
    3
    integerLength Int
    7 Int
    l
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    126 = Int
    1
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    254 = Int
    2
        | Bool
    otherwise = Int
    3
    integerLength Int
    6 Int
    l
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    62 = Int
    1
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    190 = Int
    2
        | Bool
    otherwise = Int
    3
    integerLength Int
    5 Int
    l
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    30 = Int
    1
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    158 = Int
    2
        | Bool
    otherwise = Int
    3
    integerLength Int
    4 Int
    l
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    14 = Int
    1
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    142 = Int
    2
        | Bool
    otherwise = Int
    3
    integerLength Int
    3 Int
    l
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    6 = Int
    1
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    134 = Int
    2
        | Bool
    otherwise = Int
    3
    integerLength Int
    2 Int
    l
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    2 = Int
    1
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    130 = Int
    2
        | Bool
    otherwise = Int
    3
    integerLength Int
    _ Int
    l
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 = Int
    1
        | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    128 = Int
    2
        | Bool
    otherwise = Int
    3