{-# LANGUAGE BangPatterns, RecordWildCards, OverloadedStrings #-}

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

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

import Imports
import qualified Network.HPACK.HeaderBlock.Integer as I
import qualified Network.HPACK.Huffman as Huffman
import Network.HPACK.Table
import Network.HPACK.Token
import Network.HPACK.Types

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

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

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

-- | Converting 'HeaderList' 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
             -> HeaderList
             -> IO ByteString -- ^ An HPACK format
encodeHeader :: EncodeStrategy
-> Size -> DynamicTable -> HeaderList -> IO ByteString
encodeHeader EncodeStrategy
stgy Size
siz DynamicTable
dyntbl HeaderList
hs = EncodeStrategy
-> Size -> DynamicTable -> TokenHeaderList -> IO ByteString
encodeHeader' EncodeStrategy
stgy Size
siz DynamicTable
dyntbl TokenHeaderList
hs'
  where
    hs' :: TokenHeaderList
hs' = ((ByteString, ByteString) -> (Token, ByteString))
-> HeaderList -> TokenHeaderList
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
k,ByteString
v) -> let !t :: Token
t = ByteString -> Token
toToken ByteString
k in (Token
t,ByteString
v)) HeaderList
hs


-- | Converting 'HeaderList' 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
-> Size -> DynamicTable -> TokenHeaderList -> IO ByteString
encodeHeader' EncodeStrategy
stgy Size
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 (Size -> IO (Ptr Word8)
forall a. Size -> IO (Ptr a)
mallocBytes Size
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
        (TokenHeaderList
hs',Size
len) <- Ptr Word8
-> Size
-> EncodeStrategy
-> Bool
-> DynamicTable
-> TokenHeaderList
-> IO (TokenHeaderList, Size)
encodeTokenHeader Ptr Word8
buf Size
siz EncodeStrategy
stgy Bool
True DynamicTable
dyntbl TokenHeaderList
hs
        case TokenHeaderList
hs' of
            [] -> Size -> (Ptr Word8 -> IO ()) -> IO ByteString
create Size
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 -> Size -> IO ()
memcpy Ptr Word8
p Ptr Word8
buf Size
len
            TokenHeaderList
_  -> BufferOverrun -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun

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

-- | Converting 'TokenHeaderList' to the HPACK format directly in the buffer.
--
--   4th argument is relating to dynamic table size update.
--   When calling this function for a new 'TokenHeaderList',
--   it must be 'True'.
--   If 'True' and set by 'setLimitForEncoding',
--   dynamic table size update is generated at the beginning of
--   the HPACK format.
--
--   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'.
--
encodeTokenHeader :: Buffer
                  -> BufferSize
                  -> EncodeStrategy
                  -> Bool -- ^ 'True' at the first time, 'False' when continued.
                  -> DynamicTable
                  -> TokenHeaderList
                  -> IO (TokenHeaderList, Int) -- ^ Leftover, filled length
encodeTokenHeader :: Ptr Word8
-> Size
-> EncodeStrategy
-> Bool
-> DynamicTable
-> TokenHeaderList
-> IO (TokenHeaderList, Size)
encodeTokenHeader Ptr Word8
buf Size
siz EncodeStrategy{Bool
CompressionAlgo
useHuffman :: EncodeStrategy -> Bool
compressionAlgo :: EncodeStrategy -> CompressionAlgo
useHuffman :: Bool
compressionAlgo :: CompressionAlgo
..} Bool
first DynamicTable
dyntbl TokenHeaderList
hs0 = do
    WriteBuffer
wbuf <- Ptr Word8 -> Size -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf Size
siz
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
first (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicTable -> WriteBuffer -> IO ()
changeTableSize DynamicTable
dyntbl WriteBuffer
wbuf
    let fa :: FA
fa = DynamicTable -> WriteBuffer -> Bool -> FA
indexedHeaderField DynamicTable
dyntbl WriteBuffer
wbuf Bool
useHuffman
        fb :: FB
fb = DynamicTable -> WriteBuffer -> Bool -> FB
literalHeaderFieldWithIncrementalIndexingIndexedName DynamicTable
dyntbl WriteBuffer
wbuf Bool
useHuffman
        fc :: FC
fc = DynamicTable -> WriteBuffer -> Bool -> FC
literalHeaderFieldWithIncrementalIndexingNewName DynamicTable
dyntbl WriteBuffer
wbuf Bool
useHuffman
        fd :: FD
fd = DynamicTable -> WriteBuffer -> Bool -> FD
literalHeaderFieldWithoutIndexingIndexedName DynamicTable
dyntbl WriteBuffer
wbuf Bool
useHuffman
        fe :: FE
fe = DynamicTable -> WriteBuffer -> Bool -> FE
literalHeaderFieldWithoutIndexingNewName DynamicTable
dyntbl WriteBuffer
wbuf Bool
useHuffman
        fe' :: FE
fe' = DynamicTable -> WriteBuffer -> Bool -> FE
literalHeaderFieldWithoutIndexingNewName' DynamicTable
dyntbl WriteBuffer
wbuf Bool
useHuffman
        rev :: RevIndex
rev = DynamicTable -> RevIndex
getRevIndex DynamicTable
dyntbl
        step0 :: Token -> ByteString -> IO ()
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
    IORef (Ptr Word8)
ref1 <- WriteBuffer -> IO (Ptr Word8)
currentOffset WriteBuffer
wbuf IO (Ptr Word8)
-> (Ptr Word8 -> IO (IORef (Ptr Word8))) -> IO (IORef (Ptr Word8))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> IO (IORef (Ptr Word8))
forall a. a -> IO (IORef a)
newIORef
    IORef TokenHeaderList
ref2 <- TokenHeaderList -> IO (IORef TokenHeaderList)
forall a. a -> IO (IORef a)
newIORef TokenHeaderList
hs0
    WriteBuffer
-> IORef (Ptr Word8)
-> IORef TokenHeaderList
-> (Token -> ByteString -> IO ())
-> TokenHeaderList
-> IO ()
forall t t a.
WriteBuffer
-> IORef (Ptr Word8)
-> IORef [(t, t)]
-> (t -> t -> IO a)
-> [(t, t)]
-> IO ()
loop WriteBuffer
wbuf IORef (Ptr Word8)
ref1 IORef TokenHeaderList
ref2 Token -> ByteString -> IO ()
step0 TokenHeaderList
hs0 IO () -> (BufferOverrun -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \BufferOverrun
BufferOverrun -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Ptr Word8
end <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
ref1
    let !len :: Size
len = Ptr Word8
end Ptr Word8 -> Ptr Word8 -> Size
forall a b. Ptr a -> Ptr b -> Size
`minusPtr` Ptr Word8
buf
    TokenHeaderList
hs <- IORef TokenHeaderList -> IO TokenHeaderList
forall a. IORef a -> IO a
readIORef IORef TokenHeaderList
ref2
    (TokenHeaderList, Size) -> IO (TokenHeaderList, Size)
forall (m :: * -> *) a. Monad m => a -> m a
return (TokenHeaderList
hs, Size
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 (m :: * -> *) a. Monad m => a -> m a
return ()
        go ((t
t,t
v):[(t, t)]
hs) = do
            a
_ <- t -> t -> IO a
step t
t t
v
            WriteBuffer -> IO (Ptr Word8)
currentOffset WriteBuffer
wbuf IO (Ptr Word8) -> (Ptr Word8 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
ref1
            IORef [(t, t)] -> [(t, t)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(t, t)]
ref2 [(t, t)]
hs
            [(t, t)] -> IO ()
go [(t, t)]
hs

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

naiveStep :: (HeaderName -> HeaderValue -> IO ()) -> Token -> HeaderValue -> 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 -> HeaderValue -> 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 -> HeaderValue -> 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 = HeaderValue -> Entry -> HIndex -> IO ()
type FC = HeaderName -> HeaderValue -> Entry -> IO ()
type FD = HeaderValue -> HIndex -> IO ()
type FE = HeaderName -> HeaderValue -> 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 Size
fromHIndexToIndex DynamicTable
dyntbl HIndex
hidx IO Size -> (Size -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriteBuffer -> Size -> 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 Size
fromHIndexToIndex DynamicTable
dyntbl HIndex
hidx IO Size -> (Size -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriteBuffer
-> Bool -> Size -> Setter -> ByteString -> Size -> IO ()
indexedName WriteBuffer
wbuf Bool
huff Size
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 Size
fromHIndexToIndex DynamicTable
dyntbl HIndex
hidx IO Size -> (Size -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriteBuffer
-> Bool -> Size -> Setter -> ByteString -> Size -> IO ()
indexedName WriteBuffer
wbuf Bool
huff Size
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 -> HeaderName -> HeaderValue -> 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 -> Size -> IO ()
change WriteBuffer
wbuf Size
i = WriteBuffer -> Setter -> Size -> Size -> IO ()
I.encode WriteBuffer
wbuf Setter
set001 Size
5 Size
i

{-# INLINE index #-}
index :: WriteBuffer -> Int -> IO ()
index :: WriteBuffer -> Size -> IO ()
index WriteBuffer
wbuf Size
i = WriteBuffer -> Setter -> Size -> Size -> IO ()
I.encode WriteBuffer
wbuf Setter
set1 Size
7 Size
i

-- Using Huffman encoding
{-# INLINE indexedName #-}
indexedName :: WriteBuffer -> Bool -> Int -> Setter -> HeaderValue -> Index -> IO ()
indexedName :: WriteBuffer
-> Bool -> Size -> Setter -> ByteString -> Size -> IO ()
indexedName WriteBuffer
wbuf Bool
huff Size
n Setter
set ByteString
v Size
idx = do
    WriteBuffer -> Setter -> Size -> Size -> IO ()
I.encode WriteBuffer
wbuf Setter
set Size
n Size
idx
    Bool -> ByteString -> WriteBuffer -> IO ()
encodeString Bool
huff ByteString
v WriteBuffer
wbuf

-- Using Huffman encoding
{-# INLINE newName #-}
newName :: WriteBuffer -> Bool -> Setter -> HeaderName -> HeaderValue -> 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
    Bool -> ByteString -> WriteBuffer -> IO ()
encodeString Bool
huff ByteString
k WriteBuffer
wbuf
    Bool -> ByteString -> WriteBuffer -> IO ()
encodeString Bool
huff ByteString
v WriteBuffer
wbuf

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

type Setter = Word8 -> Word8

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

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

{-# INLINE encodeString #-}
encodeString :: Bool -> ByteString -> WriteBuffer -> IO ()
encodeString :: Bool -> ByteString -> WriteBuffer -> IO ()
encodeString Bool
False ByteString
bs WriteBuffer
wbuf = do
    let !len :: Size
len = ByteString -> Size
BS.length ByteString
bs
    WriteBuffer -> Setter -> Size -> Size -> IO ()
I.encode WriteBuffer
wbuf Setter
forall a. a -> a
id Size
7 Size
len
    WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer
wbuf ByteString
bs
encodeString Bool
True  ByteString
bs WriteBuffer
wbuf = do
    let !origLen :: Size
origLen = ByteString -> Size
BS.length ByteString
bs
        !expectedLen :: Size
expectedLen = (Size
origLen Size -> Size -> Size
forall a. Integral a => a -> a -> a
`div` Size
10) Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
8 -- 80%: decided by examples
        !expectedIntLen :: Size
expectedIntLen = Size -> Size
integerLength Size
expectedLen
    WriteBuffer -> Size -> IO ()
forall a. Readable a => a -> Size -> IO ()
ff WriteBuffer
wbuf Size
expectedIntLen
    Size
len <- HuffmanEncoding
Huffman.encode WriteBuffer
wbuf ByteString
bs
    let !intLen :: Size
intLen = Size -> Size
integerLength Size
len
    if Size
origLen Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
len then do
        WriteBuffer -> Size -> IO ()
forall a. Readable a => a -> Size -> IO ()
ff WriteBuffer
wbuf (Size -> Size
forall a. Num a => a -> a
negate (Size
expectedIntLen Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
len))
        WriteBuffer -> Setter -> Size -> Size -> IO ()
I.encode WriteBuffer
wbuf Setter
forall a. a -> a
id Size
7 Size
origLen
        WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer
wbuf ByteString
bs
      else if Size
intLen Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
expectedIntLen then do
        WriteBuffer -> Size -> IO ()
forall a. Readable a => a -> Size -> IO ()
ff WriteBuffer
wbuf (Size -> Size
forall a. Num a => a -> a
negate (Size
expectedIntLen Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
len))
        WriteBuffer -> Setter -> Size -> Size -> IO ()
I.encode WriteBuffer
wbuf Setter
setH Size
7 Size
len
        WriteBuffer -> Size -> IO ()
forall a. Readable a => a -> Size -> IO ()
ff WriteBuffer
wbuf Size
len
      else do
        let !gap :: Size
gap = Size
intLen Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
expectedIntLen
        WriteBuffer -> Size -> Size -> IO ()
shiftLastN WriteBuffer
wbuf Size
gap Size
len
        WriteBuffer -> Size -> IO ()
forall a. Readable a => a -> Size -> IO ()
ff WriteBuffer
wbuf (Size -> Size
forall a. Num a => a -> a
negate (Size
intLen Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
len))
        WriteBuffer -> Setter -> Size -> Size -> IO ()
I.encode WriteBuffer
wbuf Setter
setH Size
7 Size
len
        WriteBuffer -> Size -> IO ()
forall a. Readable a => a -> Size -> IO ()
ff WriteBuffer
wbuf Size
len

-- For 7+:
-- 1 byte:    0 -   126
-- 2 bytes: 127 -   254
-- 3 bytes: 255 - 16510
{-# INLINE integerLength #-}
integerLength :: Int -> Int
integerLength :: Size -> Size
integerLength Size
n
    | Size
n Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
126  = Size
1
    | Size
n Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
254  = Size
2
    | Bool
otherwise = Size
3