{-# LANGUAGE OverloadedStrings #-}
{-# 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 Imports
import Network.HPACK.HeaderBlock.Integer
import Network.HPACK.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 -> 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 '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
-> Int -> DynamicTable -> HeaderList -> IO ByteString
encodeHeader EncodeStrategy
stgy Int
siz DynamicTable
dyntbl HeaderList
hs = EncodeStrategy
-> Int -> DynamicTable -> TokenHeaderList -> IO ByteString
encodeHeader' EncodeStrategy
stgy Int
siz DynamicTable
dyntbl TokenHeaderList
hs'
  where
    hs' :: TokenHeaderList
hs' = 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
-> Int -> DynamicTable -> TokenHeaderList -> IO ByteString
encodeHeader' EncodeStrategy
stgy Int
siz DynamicTable
dyntbl TokenHeaderList
hs = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
mallocBytes Int
siz) forall a. Ptr a -> IO ()
free Buffer -> IO ByteString
enc
  where
    enc :: Buffer -> IO ByteString
enc Buffer
buf = do
        (TokenHeaderList
hs', Int
len) <- Buffer
-> Int
-> EncodeStrategy
-> Bool
-> DynamicTable
-> TokenHeaderList
-> IO (TokenHeaderList, Int)
encodeTokenHeader Buffer
buf Int
siz EncodeStrategy
stgy Bool
True DynamicTable
dyntbl TokenHeaderList
hs
        case TokenHeaderList
hs' of
            [] -> Int -> (Buffer -> IO ()) -> IO ByteString
create Int
len forall a b. (a -> b) -> a -> b
$ \Buffer
p -> forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Buffer
p Buffer
buf Int
len
            TokenHeaderList
_ -> forall e a. 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 :: Buffer
-> Int
-> EncodeStrategy
-> Bool
-> DynamicTable
-> TokenHeaderList
-> IO (TokenHeaderList, Int)
encodeTokenHeader Buffer
buf Int
siz EncodeStrategy{Bool
CompressionAlgo
useHuffman :: EncodeStrategy -> Bool
compressionAlgo :: EncodeStrategy -> CompressionAlgo
useHuffman :: Bool
compressionAlgo :: CompressionAlgo
..} Bool
first DynamicTable
dyntbl TokenHeaderList
hs0 = do
    WriteBuffer
wbuf <- Buffer -> Int -> IO WriteBuffer
newWriteBuffer Buffer
buf Int
siz
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
first 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 Buffer
ref1 <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO (IORef a)
newIORef
    IORef TokenHeaderList
ref2 <- forall a. a -> IO (IORef a)
newIORef TokenHeaderList
hs0
    forall {t} {t} {a}.
WriteBuffer
-> IORef Buffer
-> IORef [(t, t)]
-> (t -> t -> IO a)
-> [(t, t)]
-> IO ()
loop WriteBuffer
wbuf IORef Buffer
ref1 IORef TokenHeaderList
ref2 Token -> ByteString -> IO ()
step0 TokenHeaderList
hs0 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \BufferOverrun
BufferOverrun -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Buffer
end <- forall a. IORef a -> IO a
readIORef IORef Buffer
ref1
    let len :: Int
len = Buffer
end forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Buffer
buf
    TokenHeaderList
hs <- forall a. IORef a -> IO a
readIORef IORef TokenHeaderList
ref2
    forall (m :: * -> *) a. Monad m => a -> m a
return (TokenHeaderList
hs, Int
len)
  where
    loop :: WriteBuffer
-> IORef Buffer
-> IORef [(t, t)]
-> (t -> t -> IO a)
-> [(t, t)]
-> IO ()
loop WriteBuffer
wbuf IORef Buffer
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 [] = 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 Buffer
currentOffset WriteBuffer
wbuf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
ref1
            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 Int
fromHIndexToIndex DynamicTable
dyntbl HIndex
hidx 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 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 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 -> 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 -> 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 -> HeaderValue -> 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 -> 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 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 forall a. Bits a => a -> Int -> a
`setBit` Int
7
set01 :: Setter
set01 Word8
x = Word8
x forall a. Bits a => a -> Int -> a
`setBit` Int
6
set001 :: Setter
set001 Word8
x = Word8
x forall a. Bits a => a -> Int -> a
`setBit` Int
5
-- set0001 x = x `setBit` 4 -- Never indexing
set0000 :: Setter
set0000 = 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 forall a. Integral a => a -> a -> a
`div` Int
10) forall a. Num a => a -> a -> a
* Int
8 -- 80%: decided by examples
        expectedIntLen :: Int
expectedIntLen = Int -> Int -> Int
integerLength Int
n Int
expectedLen
    forall a. Readable a => a -> Int -> IO ()
ff WriteBuffer
wbuf Int
expectedIntLen
    Int
len <- WriteBuffer -> ByteString -> IO Int
encodeH WriteBuffer
wbuf ByteString
bs
    let intLen :: Int
intLen = Int -> Int -> Int
integerLength Int
n Int
len
    if Int
origLen forall a. Ord a => a -> a -> Bool
< Int
len
        then do
            forall a. Readable a => a -> Int -> IO ()
ff WriteBuffer
wbuf (forall a. Num a => a -> a
negate (Int
expectedIntLen forall a. Num a => a -> a -> a
+ Int
len))
            WriteBuffer -> Setter -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Setter
set Int
n Int
origLen
            WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer
wbuf ByteString
bs
        else
            if Int
intLen forall a. Eq a => a -> a -> Bool
== Int
expectedIntLen
                then do
                    forall a. Readable a => a -> Int -> IO ()
ff WriteBuffer
wbuf (forall a. Num a => a -> a
negate (Int
expectedIntLen forall a. Num a => a -> a -> a
+ Int
len))
                    WriteBuffer -> Setter -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf (Setter
set forall b c a. (b -> c) -> (a -> b) -> a -> c
. Setter
setH) Int
n Int
len
                    forall a. Readable a => a -> Int -> IO ()
ff WriteBuffer
wbuf Int
len
                else do
                    let gap :: Int
gap = Int
intLen forall a. Num a => a -> a -> a
- Int
expectedIntLen
                    WriteBuffer -> Int -> Int -> IO ()
shiftLastN WriteBuffer
wbuf Int
gap Int
len
                    forall a. Readable a => a -> Int -> IO ()
ff WriteBuffer
wbuf (forall a. Num a => a -> a
negate (Int
intLen forall a. Num a => a -> a -> a
+ Int
len))
                    WriteBuffer -> Setter -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf (Setter
set forall b c a. (b -> c) -> (a -> b) -> a -> c
. Setter
setH) Int
n Int
len
                    forall a. Readable a => a -> Int -> IO ()
ff WriteBuffer
wbuf Int
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 forall a. a -> a
id (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 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 forall a. Ord a => a -> a -> Bool
<= Int
254 = Int
1
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
382 = Int
2
    | Bool
otherwise = Int
3
integerLength Int
7 Int
l
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
126 = Int
1
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
254 = Int
2
    | Bool
otherwise = Int
3
integerLength Int
6 Int
l
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
62 = Int
1
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
190 = Int
2
    | Bool
otherwise = Int
3
integerLength Int
5 Int
l
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
30 = Int
1
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
158 = Int
2
    | Bool
otherwise = Int
3
integerLength Int
4 Int
l
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
14 = Int
1
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
142 = Int
2
    | Bool
otherwise = Int
3
integerLength Int
3 Int
l
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
6 = Int
1
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
134 = Int
2
    | Bool
otherwise = Int
3
integerLength Int
2 Int
l
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
2 = Int
1
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
130 = Int
2
    | Bool
otherwise = Int
3
integerLength Int
_ Int
l
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
1
    | Int
l forall a. Ord a => a -> a -> Bool
<= Int
128 = Int
2
    | Bool
otherwise = Int
3