{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.QPACK.HeaderBlock.Encode (
    encodeHeader,
    encodeTokenHeader,
    EncodedFieldSection,
    EncodedEncoderInstruction,
) where

import qualified Control.Exception as E
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8
import Network.ByteOrder
import Network.Control
import Network.HPACK.Internal (
    encodeI,
    encodeS,
    toEntryToken,
 )
import Network.HTTP.Semantics
import Network.HTTP.Types

import Imports
import Network.QPACK.HeaderBlock.Prefix
import Network.QPACK.Instruction
import Network.QPACK.Table
import Network.QPACK.Types

-- | Encoded field section including prefix.
type EncodedFieldSection = B.ByteString

-- | Encoded encoder instruction.
type EncodedEncoderInstruction = B.ByteString

-- | Encoding headers with QPACK.
--   Header block with prefix and instructions are returned.
--   2048, 32, and 2048 bytes-buffers are
--   temporally allocated for header block, prefix and encoder instructions.
--   If headers are too large, 'BufferOverrun' is thrown.
encodeHeader
    :: DynamicTable
    -> [Header]
    -> IO (EncodedFieldSection, EncodedEncoderInstruction)
encodeHeader :: DynamicTable -> [Header] -> IO (FieldValue, FieldValue)
encodeHeader DynamicTable
dyntbl [Header]
hs = do
    DynamicTable -> IO ()
setBasePointToInsersionPoint DynamicTable
dyntbl
    DynamicTable -> IO ()
clearRequiredInsertCount DynamicTable
dyntbl
    (FieldValue
hb0, FieldValue
insb) <- Int
-> (WriteBuffer -> IO FieldValue) -> IO (FieldValue, FieldValue)
forall a. Int -> (WriteBuffer -> IO a) -> IO (FieldValue, a)
withWriteBuffer' Int
2048 ((WriteBuffer -> IO FieldValue) -> IO (FieldValue, FieldValue))
-> (WriteBuffer -> IO FieldValue) -> IO (FieldValue, FieldValue)
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf1 ->
        Int -> (WriteBuffer -> IO ()) -> IO FieldValue
withWriteBuffer Int
2048 ((WriteBuffer -> IO ()) -> IO FieldValue)
-> (WriteBuffer -> IO ()) -> IO FieldValue
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf2 -> do
            [AbsoluteIndex]
hs1 <- WriteBuffer
-> WriteBuffer
-> DynamicTable
-> TokenHeaderList
-> IO [AbsoluteIndex]
encodeTokenHeader WriteBuffer
wbuf1 WriteBuffer
wbuf2 DynamicTable
dyntbl TokenHeaderList
ts
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AbsoluteIndex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AbsoluteIndex]
hs1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO BufferOverrun
BufferOverrun
    FieldValue
prefix <- Int -> (WriteBuffer -> IO ()) -> IO FieldValue
withWriteBuffer Int
32 ((WriteBuffer -> IO ()) -> IO FieldValue)
-> (WriteBuffer -> IO ()) -> IO FieldValue
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf -> WriteBuffer -> DynamicTable -> IO ()
encodePrefix WriteBuffer
wbuf DynamicTable
dyntbl
    let hb :: FieldValue
hb = FieldValue
prefix FieldValue -> FieldValue -> FieldValue
`B.append` FieldValue
hb0
    (FieldValue, FieldValue) -> IO (FieldValue, FieldValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldValue
hb, FieldValue
insb)
  where
    ts :: TokenHeaderList
ts = (Header -> (Token, FieldValue)) -> [Header] -> TokenHeaderList
forall a b. (a -> b) -> [a] -> [b]
map (\(HeaderName
k, FieldValue
v) -> let t :: Token
t = FieldValue -> Token
toToken (HeaderName -> FieldValue
forall s. CI s -> s
foldedCase HeaderName
k) in (Token
t, FieldValue
v)) [Header]
hs

-- | Converting 'TokenHeaderList' to the QPACK format.
--  'TokenHeaderList' must be smaller than or equal to workspaces.
--  Otherwise, 'BufferOverrun' is thrown.
encodeTokenHeader
    :: WriteBuffer
    -- ^ Workspace for the body of header block
    -> WriteBuffer
    -- ^ Workspace for encoder instructions
    -> DynamicTable
    -> TokenHeaderList
    -> IO [AbsoluteIndex]
encodeTokenHeader :: WriteBuffer
-> WriteBuffer
-> DynamicTable
-> TokenHeaderList
-> IO [AbsoluteIndex]
encodeTokenHeader WriteBuffer
wbuf1 WriteBuffer
wbuf2 DynamicTable
dyntbl TokenHeaderList
ts0 = do
    WriteBuffer -> IO ()
clearWriteBuffer WriteBuffer
wbuf1
    WriteBuffer -> IO ()
clearWriteBuffer WriteBuffer
wbuf2
    let revidx :: RevIndex
revidx = DynamicTable -> RevIndex
getRevIndex DynamicTable
dyntbl
    Bool
ready <- DynamicTable -> IO Bool
isTableReady DynamicTable
dyntbl
    if Bool
ready
        then WriteBuffer
-> WriteBuffer
-> DynamicTable
-> RevIndex
-> Bool
-> TokenHeaderList
-> IO [AbsoluteIndex]
encodeLinear WriteBuffer
wbuf1 WriteBuffer
wbuf2 DynamicTable
dyntbl RevIndex
revidx Bool
True TokenHeaderList
ts0
        else WriteBuffer
-> WriteBuffer
-> DynamicTable
-> RevIndex
-> Bool
-> TokenHeaderList
-> IO [AbsoluteIndex]
encodeStatic WriteBuffer
wbuf1 WriteBuffer
wbuf2 DynamicTable
dyntbl RevIndex
revidx Bool
True TokenHeaderList
ts0

encodeStatic
    :: WriteBuffer
    -> WriteBuffer
    -> DynamicTable
    -> RevIndex
    -> Bool
    -> TokenHeaderList
    -> IO [AbsoluteIndex]
encodeStatic :: WriteBuffer
-> WriteBuffer
-> DynamicTable
-> RevIndex
-> Bool
-> TokenHeaderList
-> IO [AbsoluteIndex]
encodeStatic WriteBuffer
wbuf1 WriteBuffer
_wbuf2 DynamicTable
dyntbl RevIndex
revidx Bool
huff TokenHeaderList
ts0 = do
    ((Token, FieldValue) -> IO ()) -> TokenHeaderList -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WriteBuffer
-> DynamicTable -> RevIndex -> Bool -> (Token, FieldValue) -> IO ()
encStatic WriteBuffer
wbuf1 DynamicTable
dyntbl RevIndex
revidx Bool
huff) TokenHeaderList
ts0
    [AbsoluteIndex] -> IO [AbsoluteIndex]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

encStatic
    :: WriteBuffer -> DynamicTable -> RevIndex -> Bool -> (Token, FieldValue) -> IO ()
encStatic :: WriteBuffer
-> DynamicTable -> RevIndex -> Bool -> (Token, FieldValue) -> IO ()
encStatic WriteBuffer
wbuf1 DynamicTable
dyntbl RevIndex
revidx Bool
huff (Token
t, FieldValue
val) = do
    RevResult
rr <- Token -> FieldValue -> RevIndex -> IO RevResult
lookupRevIndex Token
t FieldValue
val RevIndex
revidx
    case RevResult
rr of
        KV HIndex
hi -> do
            -- 4.5.2.  Indexed Field Line
            WriteBuffer -> DynamicTable -> HIndex -> IO ()
encodeIndexedFieldLine WriteBuffer
wbuf1 DynamicTable
dyntbl HIndex
hi
        K HIndex
i -> do
            -- 4.5.4.  Literal Field Line With Name Reference
            WriteBuffer
-> DynamicTable -> HIndex -> FieldValue -> Bool -> IO ()
encodeLiteralFieldLineWithNameReference WriteBuffer
wbuf1 DynamicTable
dyntbl HIndex
i FieldValue
val Bool
huff
        RevResult
N -> do
            -- 4.5.6.  Literal Field Line with Literal Name
            WriteBuffer -> DynamicTable -> Token -> FieldValue -> Bool -> IO ()
encodeLiteralFieldLineWithLiteralName WriteBuffer
wbuf1 DynamicTable
dyntbl Token
t FieldValue
val Bool
huff

encodeLinear
    :: WriteBuffer
    -> WriteBuffer
    -> DynamicTable
    -> RevIndex
    -> Bool
    -> TokenHeaderList
    -> IO [AbsoluteIndex]
encodeLinear :: WriteBuffer
-> WriteBuffer
-> DynamicTable
-> RevIndex
-> Bool
-> TokenHeaderList
-> IO [AbsoluteIndex]
encodeLinear WriteBuffer
wbuf1 WriteBuffer
wbuf2 DynamicTable
dyntbl RevIndex
revidx Bool
huff TokenHeaderList
ts0 =
    [Maybe AbsoluteIndex] -> [AbsoluteIndex]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe AbsoluteIndex] -> [AbsoluteIndex])
-> IO [Maybe AbsoluteIndex] -> IO [AbsoluteIndex]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Token, FieldValue) -> IO (Maybe AbsoluteIndex))
-> TokenHeaderList -> IO [Maybe AbsoluteIndex]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriteBuffer
-> WriteBuffer
-> DynamicTable
-> RevIndex
-> Bool
-> (Token, FieldValue)
-> IO (Maybe AbsoluteIndex)
encLinear WriteBuffer
wbuf1 WriteBuffer
wbuf2 DynamicTable
dyntbl RevIndex
revidx Bool
huff) TokenHeaderList
ts0

encLinear
    :: WriteBuffer
    -> WriteBuffer
    -> DynamicTable
    -> RevIndex
    -> Bool
    -> (Token, FieldValue)
    -> IO (Maybe AbsoluteIndex)
encLinear :: WriteBuffer
-> WriteBuffer
-> DynamicTable
-> RevIndex
-> Bool
-> (Token, FieldValue)
-> IO (Maybe AbsoluteIndex)
encLinear WriteBuffer
wbuf1 WriteBuffer
wbuf2 DynamicTable
dyntbl RevIndex
revidx Bool
huff (Token
t, FieldValue
val) = do
    RevResult
rr <- Token -> FieldValue -> RevIndex -> IO RevResult
lookupRevIndex Token
t FieldValue
val RevIndex
revidx
    DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Int
tblsiz <- DynamicTable -> IO Int
getTableCapacity DynamicTable
dyntbl
        BasePoint
base <- DynamicTable -> IO BasePoint
getBasePoint DynamicTable
dyntbl
        InsertionPoint
insPnt <- DynamicTable -> IO InsertionPoint
getInsertionPoint DynamicTable
dyntbl
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char]
"    Table size: "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
tblsiz
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BasePoint -> [Char]
forall a. Show a => a -> [Char]
show BasePoint
base
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ InsertionPoint -> [Char]
forall a. Show a => a -> [Char]
show InsertionPoint
insPnt
        [Char] -> IO ()
putStr [Char]
"    "
        DynamicTable -> IO ()
printReferences DynamicTable
dyntbl
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ RevResult -> [Char]
forall a. Show a => a -> [Char]
show RevResult
rr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HeaderName -> [Char]
forall a. Show a => a -> [Char]
show (Token -> HeaderName
tokenKey Token
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FieldValue -> [Char]
forall a. Show a => a -> [Char]
show FieldValue
val [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
""
    case RevResult
rr of
        KV hi :: HIndex
hi@(SIndex AbsoluteIndex
_) -> do
            -- 4.5.2/4.5.3
            WriteBuffer -> DynamicTable -> HIndex -> IO ()
encodeIndexed WriteBuffer
wbuf1 DynamicTable
dyntbl HIndex
hi
            Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AbsoluteIndex
forall a. Maybe a
Nothing
        KV hi :: HIndex
hi@(DIndex AbsoluteIndex
ai) -> do
            DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicTable -> AbsoluteIndex -> [Char] -> IO ()
checkAbsoluteIndex DynamicTable
dyntbl AbsoluteIndex
ai [Char]
"KV (1)"
            AbsoluteIndex
-> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
forall {a}. AbsoluteIndex -> IO (Maybe a) -> IO (Maybe a)
withDIndex AbsoluteIndex
ai (IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex))
-> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ do
                -- 4.5.2/4.5.3
                WriteBuffer -> DynamicTable -> HIndex -> IO ()
encodeIndexed WriteBuffer
wbuf1 DynamicTable
dyntbl HIndex
hi
                DynamicTable -> AbsoluteIndex -> IO ()
increaseReference DynamicTable
dyntbl AbsoluteIndex
ai
                Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex))
-> Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> Maybe AbsoluteIndex
forall a. a -> Maybe a
Just AbsoluteIndex
ai
        K hi :: HIndex
hi@(SIndex AbsoluteIndex
i) -> HIndex -> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
tryInsertVal HIndex
hi (IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex))
-> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ do
            FieldValue
-> Entry
-> Maybe AbsoluteIndex
-> InsIndex
-> IO (Maybe AbsoluteIndex)
insertWithNameReference FieldValue
val Entry
ent Maybe AbsoluteIndex
forall a. Maybe a
Nothing (InsIndex -> IO (Maybe AbsoluteIndex))
-> InsIndex -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> InsIndex
forall a b. a -> Either a b
Left AbsoluteIndex
i
        K hi :: HIndex
hi@(DIndex AbsoluteIndex
ai) -> do
            DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicTable -> AbsoluteIndex -> [Char] -> IO ()
checkAbsoluteIndex DynamicTable
dyntbl AbsoluteIndex
ai [Char]
"K (1)"
            AbsoluteIndex
-> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
forall {a}. AbsoluteIndex -> IO (Maybe a) -> IO (Maybe a)
withDIndex AbsoluteIndex
ai (IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex))
-> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ HIndex -> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
tryInsertVal HIndex
hi (IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex))
-> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ do
                InsRelativeIndex
ridx <- AbsoluteIndex -> InsertionPoint -> InsRelativeIndex
toInsRelativeIndex AbsoluteIndex
ai (InsertionPoint -> InsRelativeIndex)
-> IO InsertionPoint -> IO InsRelativeIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> IO InsertionPoint
getInsertionPoint DynamicTable
dyntbl
                FieldValue
-> Entry
-> Maybe AbsoluteIndex
-> InsIndex
-> IO (Maybe AbsoluteIndex)
insertWithNameReference FieldValue
val Entry
ent (AbsoluteIndex -> Maybe AbsoluteIndex
forall a. a -> Maybe a
Just AbsoluteIndex
ai) (InsIndex -> IO (Maybe AbsoluteIndex))
-> InsIndex -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ InsRelativeIndex -> InsIndex
forall a b. b -> Either a b
Right InsRelativeIndex
ridx
        RevResult
N -> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
tryInsertKeyVal (IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex))
-> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ FieldValue -> Entry -> IO (Maybe AbsoluteIndex)
insertWithLiteralName FieldValue
val Entry
ent
  where
    ent :: Entry
ent = Token -> FieldValue -> Entry
toEntryToken Token
t FieldValue
val
    key :: FieldValue
key = Token -> FieldValue
tokenFoldedKey Token
t
    lru :: LRUCacheRef (FieldValue, FieldValue) ()
lru = DynamicTable -> LRUCacheRef (FieldValue, FieldValue) ()
getLruCache DynamicTable
dyntbl

    withDIndex :: AbsoluteIndex -> IO (Maybe a) -> IO (Maybe a)
withDIndex AbsoluteIndex
ai IO (Maybe a)
action = do
        Bool
blocked <- DynamicTable -> AbsoluteIndex -> IO Bool
wouldInstructionBeBlocked DynamicTable
dyntbl AbsoluteIndex
ai
        Bool
canUseDynamicTable <- DynamicTable -> IO Bool
checkBlockedStreams DynamicTable
dyntbl
        if Bool
canUseDynamicTable Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
blocked
            then IO (Maybe a)
action
            else IO (Maybe a)
forall {a}. IO (Maybe a)
encodeLiteralFieldLineStatic

    insertWithNameReference :: FieldValue
-> Entry
-> Maybe AbsoluteIndex
-> InsIndex
-> IO (Maybe AbsoluteIndex)
insertWithNameReference FieldValue
v Entry
e Maybe AbsoluteIndex
mai InsIndex
insidx =
        Maybe AbsoluteIndex
-> Entry -> EncoderInstruction -> IO (Maybe AbsoluteIndex)
insertWith Maybe AbsoluteIndex
mai Entry
e (EncoderInstruction -> IO (Maybe AbsoluteIndex))
-> EncoderInstruction -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ InsIndex -> FieldValue -> EncoderInstruction
InsertWithNameReference InsIndex
insidx FieldValue
v

    insertWithLiteralName :: FieldValue -> Entry -> IO (Maybe AbsoluteIndex)
insertWithLiteralName FieldValue
v Entry
e =
        Maybe AbsoluteIndex
-> Entry -> EncoderInstruction -> IO (Maybe AbsoluteIndex)
insertWith Maybe AbsoluteIndex
forall a. Maybe a
Nothing Entry
e (EncoderInstruction -> IO (Maybe AbsoluteIndex))
-> EncoderInstruction -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ Token -> FieldValue -> EncoderInstruction
InsertWithLiteralName Token
t FieldValue
v

    insertWith :: Maybe AbsoluteIndex
-> Entry -> EncoderInstruction -> IO (Maybe AbsoluteIndex)
insertWith Maybe AbsoluteIndex
maiForKey Entry
e EncoderInstruction
ins = do
        WriteBuffer -> Bool -> EncoderInstruction -> IO ()
encodeEI WriteBuffer
wbuf2 Bool
True EncoderInstruction
ins
        AbsoluteIndex
ai <- Entry -> DynamicTable -> IO AbsoluteIndex
insertEntryToEncoder Entry
e DynamicTable
dyntbl
        DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ EncoderInstruction -> [Char]
forall a. Show a => a -> [Char]
show EncoderInstruction
ins [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AbsoluteIndex -> [Char]
forall a. Show a => a -> [Char]
show AbsoluteIndex
ai
        Bool
canUseDynamicTable <- DynamicTable -> IO Bool
checkBlockedStreams DynamicTable
dyntbl
        if Bool
canUseDynamicTable
            then do
                -- 4.5.4/4.5.5
                WriteBuffer
-> DynamicTable -> HIndex -> FieldValue -> Bool -> IO ()
encodeWithNameReference WriteBuffer
wbuf1 DynamicTable
dyntbl (AbsoluteIndex -> HIndex
DIndex AbsoluteIndex
ai) FieldValue
val Bool
huff
                DynamicTable -> AbsoluteIndex -> IO ()
increaseReference DynamicTable
dyntbl AbsoluteIndex
ai
                Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex))
-> Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> Maybe AbsoluteIndex
forall a. a -> Maybe a
Just AbsoluteIndex
ai
            else Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
encodeLiteralValue Maybe AbsoluteIndex
maiForKey

    encodeLiteralValue :: Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
encodeLiteralValue Maybe AbsoluteIndex
Nothing = IO (Maybe AbsoluteIndex)
forall {a}. IO (Maybe a)
encodeLiteralFieldLineStatic
    encodeLiteralValue (Just AbsoluteIndex
ai) = do
        Bool
blocked <- DynamicTable -> AbsoluteIndex -> IO Bool
wouldInstructionBeBlocked DynamicTable
dyntbl AbsoluteIndex
ai
        Bool
canUseDynamicTable <- DynamicTable -> IO Bool
checkBlockedStreams DynamicTable
dyntbl
        if Bool
canUseDynamicTable Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
blocked
            then do
                -- 4.5.4/4.5.5
                WriteBuffer
-> DynamicTable -> HIndex -> FieldValue -> Bool -> IO ()
encodeWithNameReference WriteBuffer
wbuf1 DynamicTable
dyntbl (AbsoluteIndex -> HIndex
DIndex AbsoluteIndex
ai) FieldValue
val Bool
huff
                DynamicTable -> AbsoluteIndex -> IO ()
increaseReference DynamicTable
dyntbl AbsoluteIndex
ai
                Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex))
-> Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> Maybe AbsoluteIndex
forall a. a -> Maybe a
Just AbsoluteIndex
ai
            else IO (Maybe AbsoluteIndex)
forall {a}. IO (Maybe a)
encodeLiteralFieldLineStatic

    tryInsertVal :: HIndex -> IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
tryInsertVal HIndex
hi IO (Maybe AbsoluteIndex)
action = do
        -- Field representation MUST not refer to a dropped entry
        -- on insertion.
        let possiblelyDropMySelf :: Maybe AbsoluteIndex
possiblelyDropMySelf = case HIndex
hi of
                SIndex AbsoluteIndex
_ -> Maybe AbsoluteIndex
forall a. Maybe a
Nothing
                DIndex AbsoluteIndex
ai -> AbsoluteIndex -> Maybe AbsoluteIndex
forall a. a -> Maybe a
Just AbsoluteIndex
ai
        Bool
ok <- Entry
-> FieldValue
-> FieldValue
-> Maybe AbsoluteIndex
-> [Char]
-> IO Bool
checkExistenceAndSpace Entry
ent FieldValue
key FieldValue
val Maybe AbsoluteIndex
possiblelyDropMySelf [Char]
"Val"
        if Bool
ok
            then IO (Maybe AbsoluteIndex)
action
            else do
                -- 4.5.4/4.5.5
                WriteBuffer
-> DynamicTable -> HIndex -> FieldValue -> Bool -> IO ()
encodeWithNameReference WriteBuffer
wbuf1 DynamicTable
dyntbl HIndex
hi FieldValue
val Bool
huff
                case HIndex
hi of
                    SIndex AbsoluteIndex
_ -> Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AbsoluteIndex
forall a. Maybe a
Nothing
                    DIndex AbsoluteIndex
dai -> do
                        DynamicTable -> AbsoluteIndex -> IO ()
increaseReference DynamicTable
dyntbl AbsoluteIndex
dai
                        Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex))
-> Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> Maybe AbsoluteIndex
forall a. a -> Maybe a
Just AbsoluteIndex
dai

    tryInsertKeyVal :: IO (Maybe AbsoluteIndex) -> IO (Maybe AbsoluteIndex)
tryInsertKeyVal IO (Maybe AbsoluteIndex)
action = do
        Bool
ok <- Entry
-> FieldValue
-> FieldValue
-> Maybe AbsoluteIndex
-> [Char]
-> IO Bool
checkExistenceAndSpace Entry
ent FieldValue
key FieldValue
val Maybe AbsoluteIndex
forall a. Maybe a
Nothing [Char]
"KeyVal"
        case Bool
ok of
            Bool
True -> IO (Maybe AbsoluteIndex)
action
            Bool
False -> IO (Maybe AbsoluteIndex)
tryInsertKey

    tryInsertKey :: IO (Maybe AbsoluteIndex)
tryInsertKey
        | Maybe AbsoluteIndex -> Bool
forall a. Maybe a -> Bool
isJust (Token -> Maybe AbsoluteIndex
tokenToStaticIndex Token
t) = IO (Maybe AbsoluteIndex)
forall {a}. IO (Maybe a)
encodeLiteralFieldLineStatic
        | Bool
otherwise = do
            Maybe AbsoluteIndex
mdai <- FieldValue -> RevIndex -> IO (Maybe AbsoluteIndex)
isKeyRegistered FieldValue
key RevIndex
revidx
            case Maybe AbsoluteIndex
mdai of
                Maybe AbsoluteIndex
Nothing -> do
                    let val' :: FieldValue
val' = FieldValue
""
                        ent' :: Entry
ent' = Token -> FieldValue -> Entry
toEntryToken Token
t FieldValue
val'
                    Bool
okK <- Entry
-> FieldValue
-> FieldValue
-> Maybe AbsoluteIndex
-> [Char]
-> IO Bool
checkExistenceAndSpace Entry
ent' FieldValue
key FieldValue
val' Maybe AbsoluteIndex
forall a. Maybe a
Nothing [Char]
"Key"
                    if Bool
okK
                        then FieldValue -> Entry -> IO (Maybe AbsoluteIndex)
insertWithLiteralName FieldValue
val' Entry
ent'
                        else IO (Maybe AbsoluteIndex)
forall {a}. IO (Maybe a)
encodeLiteralFieldLineStatic
                Just AbsoluteIndex
dai -> AbsoluteIndex -> IO (Maybe AbsoluteIndex)
encodeLiteralFieldLineDynamic AbsoluteIndex
dai

    encodeLiteralFieldLineDynamic :: AbsoluteIndex -> IO (Maybe AbsoluteIndex)
encodeLiteralFieldLineDynamic AbsoluteIndex
dai = do
        Bool
canUseDynamicTable <- DynamicTable -> IO Bool
checkBlockedStreams DynamicTable
dyntbl
        if Bool
canUseDynamicTable
            then do
                -- 4.5.4/4.5.5
                WriteBuffer
-> DynamicTable -> HIndex -> FieldValue -> Bool -> IO ()
encodeWithNameReference WriteBuffer
wbuf1 DynamicTable
dyntbl (AbsoluteIndex -> HIndex
DIndex AbsoluteIndex
dai) FieldValue
val Bool
huff

                DynamicTable -> AbsoluteIndex -> IO ()
increaseReference DynamicTable
dyntbl AbsoluteIndex
dai
                Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex))
-> Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> Maybe AbsoluteIndex
forall a. a -> Maybe a
Just AbsoluteIndex
dai
            else do
                -- 4.5.6.  Literal Field Line with Literal Name
                WriteBuffer -> DynamicTable -> Token -> FieldValue -> Bool -> IO ()
encodeLiteralFieldLineWithLiteralName WriteBuffer
wbuf1 DynamicTable
dyntbl Token
t FieldValue
val Bool
huff
                IO ()
tryTailDuplication
                Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AbsoluteIndex
forall a. Maybe a
Nothing

    encodeLiteralFieldLineStatic :: IO (Maybe a)
encodeLiteralFieldLineStatic = do
        case Token -> Maybe AbsoluteIndex
tokenToStaticIndex Token
t of
            Just AbsoluteIndex
i -> do
                -- 4.5.4/4.5.5
                WriteBuffer
-> DynamicTable -> HIndex -> FieldValue -> Bool -> IO ()
encodeWithNameReference WriteBuffer
wbuf1 DynamicTable
dyntbl (AbsoluteIndex -> HIndex
SIndex AbsoluteIndex
i) FieldValue
val Bool
huff
            Maybe AbsoluteIndex
Nothing -> do
                -- 4.5.6.  Literal Field Line with Literal Name
                WriteBuffer -> DynamicTable -> Token -> FieldValue -> Bool -> IO ()
encodeLiteralFieldLineWithLiteralName WriteBuffer
wbuf1 DynamicTable
dyntbl Token
t FieldValue
val Bool
huff
                IO ()
tryTailDuplication
        Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

    checkExistence :: FieldValue -> FieldValue -> [Char] -> IO Bool
checkExistence FieldValue
k FieldValue
v [Char]
tag = do
        (()
_, Bool
exist) <- LRUCacheRef (FieldValue, FieldValue) ()
-> (FieldValue, FieldValue) -> IO () -> IO ((), Bool)
forall k v. Ord k => LRUCacheRef k v -> k -> IO v -> IO (v, Bool)
cached LRUCacheRef (FieldValue, FieldValue) ()
lru (FieldValue
k, FieldValue
v) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                (if Bool
exist then [Char]
"    HIT for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tag else [Char]
"    not HIT for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tag)
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FieldValue -> [Char]
forall a. Show a => a -> [Char]
show FieldValue
k
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FieldValue -> [Char]
forall a. Show a => a -> [Char]
show FieldValue
v
        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exist

    checkSpace :: Entry -> Maybe AbsoluteIndex -> [Char] -> IO Bool
checkSpace Entry
e Maybe AbsoluteIndex
possiblelyDropMySelf [Char]
tag = do
        Bool
spaceOK <- DynamicTable -> Entry -> Maybe AbsoluteIndex -> IO Bool
canInsertEntry DynamicTable
dyntbl Entry
e Maybe AbsoluteIndex
possiblelyDropMySelf
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
spaceOK (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            DynamicTable -> IO ()
adjustDrainingPoint DynamicTable
dyntbl
            DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"    NO SPACE for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tag
        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
spaceOK

    checkExistenceAndSpace :: Entry
-> FieldValue
-> FieldValue
-> Maybe AbsoluteIndex
-> [Char]
-> IO Bool
checkExistenceAndSpace Entry
e FieldValue
k FieldValue
v Maybe AbsoluteIndex
possiblelyDropMySelf [Char]
tag = do
        Bool
exist <- FieldValue -> FieldValue -> [Char] -> IO Bool
checkExistence FieldValue
k FieldValue
v [Char]
tag
        if Bool
exist
            then Entry -> Maybe AbsoluteIndex -> [Char] -> IO Bool
checkSpace Entry
e Maybe AbsoluteIndex
possiblelyDropMySelf [Char]
tag
            else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    tryTailDuplication :: IO ()
tryTailDuplication = do
        Maybe AbsoluteIndex
mx <- DynamicTable -> IO (Maybe AbsoluteIndex)
checkTailDuplication DynamicTable
dyntbl
        case Maybe AbsoluteIndex
mx of
            Maybe AbsoluteIndex
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just AbsoluteIndex
ai -> do
                InsRelativeIndex
ridx <- AbsoluteIndex -> InsertionPoint -> InsRelativeIndex
toInsRelativeIndex AbsoluteIndex
ai (InsertionPoint -> InsRelativeIndex)
-> IO InsertionPoint -> IO InsRelativeIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> IO InsertionPoint
getInsertionPoint DynamicTable
dyntbl
                let ins :: EncoderInstruction
ins = InsRelativeIndex -> EncoderInstruction
Duplicate InsRelativeIndex
ridx
                WriteBuffer -> Bool -> EncoderInstruction -> IO ()
encodeEI WriteBuffer
wbuf2 Bool
True EncoderInstruction
ins
                DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ EncoderInstruction -> [Char]
forall a. Show a => a -> [Char]
show EncoderInstruction
ins [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AbsoluteIndex -> [Char]
forall a. Show a => a -> [Char]
show AbsoluteIndex
ai
                AbsoluteIndex
nai <- DynamicTable -> IO AbsoluteIndex
tailDuplication DynamicTable
dyntbl
                DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Duplicate: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AbsoluteIndex -> [Char]
forall a. Show a => a -> [Char]
show AbsoluteIndex
ai [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AbsoluteIndex -> [Char]
forall a. Show a => a -> [Char]
show AbsoluteIndex
nai

-- 4.5.2/4.5.3
encodeIndexed :: WriteBuffer -> DynamicTable -> HIndex -> IO ()
encodeIndexed :: WriteBuffer -> DynamicTable -> HIndex -> IO ()
encodeIndexed WriteBuffer
wbuf DynamicTable
dyntbl hi :: HIndex
hi@(SIndex (AbsoluteIndex Int
idx)) = do
    WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set11 Int
6 Int
idx
    DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"IndexedFieldLine (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HIndex -> [Char]
forall a. Show a => a -> [Char]
show HIndex
hi [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
encodeIndexed WriteBuffer
wbuf DynamicTable
dyntbl hi :: HIndex
hi@(DIndex AbsoluteIndex
ai) = do
    DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicTable -> AbsoluteIndex -> [Char] -> IO ()
checkAbsoluteIndex DynamicTable
dyntbl AbsoluteIndex
ai [Char]
"encodeIndexed"
    DynamicTable -> AbsoluteIndex -> IO ()
updateRequiredInsertCount DynamicTable
dyntbl AbsoluteIndex
ai
    BasePoint
bp <- DynamicTable -> IO BasePoint
getBasePoint DynamicTable
dyntbl
    case AbsoluteIndex -> BasePoint -> Either PreBaseIndex PostBaseIndex
toBaseIndex AbsoluteIndex
ai BasePoint
bp of
        Left (PreBaseIndex Int
idx) -> do
            WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set10 Int
6 Int
idx
            DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"IndexedFieldLine (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HIndex -> [Char]
forall a. Show a => a -> [Char]
show HIndex
hi [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
        Right (PostBaseIndex Int
idx) -> do
            WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set0001 Int
4 Int
idx
            DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                    [Char]
"IndexedFieldLineWithPostBaseIndex (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HIndex -> [Char]
forall a. Show a => a -> [Char]
show HIndex
hi [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- 4.5.2.  Indexed Field Line
encodeIndexedFieldLine :: WriteBuffer -> DynamicTable -> HIndex -> IO ()
encodeIndexedFieldLine :: WriteBuffer -> DynamicTable -> HIndex -> IO ()
encodeIndexedFieldLine WriteBuffer
wbuf DynamicTable
dyntbl HIndex
hi = do
    (Int
idx, Word8 -> Word8
set) <- case HIndex
hi of
        SIndex (AbsoluteIndex Int
i) -> (Int, Word8 -> Word8) -> IO (Int, Word8 -> Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, Word8 -> Word8
set11)
        DIndex AbsoluteIndex
ai -> do
            DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicTable -> AbsoluteIndex -> [Char] -> IO ()
checkAbsoluteIndex DynamicTable
dyntbl AbsoluteIndex
ai [Char]
"encodeIndexedFieldLine"
            DynamicTable -> AbsoluteIndex -> IO ()
updateRequiredInsertCount DynamicTable
dyntbl AbsoluteIndex
ai
            BasePoint
bp <- DynamicTable -> IO BasePoint
getBasePoint DynamicTable
dyntbl
            let PreBaseIndex Int
i = AbsoluteIndex -> BasePoint -> PreBaseIndex
toPreBaseIndex AbsoluteIndex
ai BasePoint
bp
            (Int, Word8 -> Word8) -> IO (Int, Word8 -> Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, Word8 -> Word8
set10)
    WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set Int
6 Int
idx
    DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"IndexedFieldLine (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HIndex -> [Char]
forall a. Show a => a -> [Char]
show HIndex
hi [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

{-
-- 4.5.3.  Indexed Field Line With Post-Base Index
encodeIndexedFieldLineWithPostBaseIndex
    :: WriteBuffer
    -> DynamicTable
    -> AbsoluteIndex -- in Dynamic table
    -> IO ()
encodeIndexedFieldLineWithPostBaseIndex wbuf dyntbl ai = do
    updateRequiredInsertCount dyntbl ai
    bp <- getBasePoint dyntbl
    let PostBaseIndex idx = toPostBaseIndex ai bp
    encodeI wbuf set0001 4 idx
    qpackDebug dyntbl $ putStrLn "IndexedFieldLineWithPostBaseIndex "
-}

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

-- 4.5.4/4.5.5
encodeWithNameReference
    :: WriteBuffer -> DynamicTable -> HIndex -> ByteString -> Bool -> IO ()
encodeWithNameReference :: WriteBuffer
-> DynamicTable -> HIndex -> FieldValue -> Bool -> IO ()
encodeWithNameReference WriteBuffer
wbuf DynamicTable
dyntbl hidx :: HIndex
hidx@(SIndex (AbsoluteIndex Int
idx)) FieldValue
val Bool
huff = do
    WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set0101 Int
4 Int
idx
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Int
-> FieldValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
forall a. a -> a
id Word8 -> Word8
set1 Int
7 FieldValue
val
    DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char]
"LiteralFieldLineWithNameReference (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HIndex -> [Char]
forall a. Show a => a -> [Char]
show HIndex
hidx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
encodeWithNameReference WriteBuffer
wbuf DynamicTable
dyntbl hidx :: HIndex
hidx@(DIndex AbsoluteIndex
ai) FieldValue
val Bool
huff = do
    DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicTable -> AbsoluteIndex -> [Char] -> IO ()
checkAbsoluteIndex DynamicTable
dyntbl AbsoluteIndex
ai [Char]
"encodeWithNameReference"
    DynamicTable -> AbsoluteIndex -> IO ()
updateRequiredInsertCount DynamicTable
dyntbl AbsoluteIndex
ai
    BasePoint
bp <- DynamicTable -> IO BasePoint
getBasePoint DynamicTable
dyntbl
    case AbsoluteIndex -> BasePoint -> Either PreBaseIndex PostBaseIndex
toBaseIndex AbsoluteIndex
ai BasePoint
bp of
        Left (PreBaseIndex Int
idx) -> do
            WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set0100 Int
4 Int
idx
            WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Int
-> FieldValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
forall a. a -> a
id Word8 -> Word8
set1 Int
7 FieldValue
val
            DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                    [Char]
"LiteralFieldLineWithNameReference (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HIndex -> [Char]
forall a. Show a => a -> [Char]
show HIndex
hidx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
        Right (PostBaseIndex Int
idx) -> do
            WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set00000 Int
3 Int
idx
            WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Int
-> FieldValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
forall a. a -> a
id Word8 -> Word8
set1 Int
7 FieldValue
val
            DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                    [Char]
"LiteralFieldLineWithPostBaseNameReference (DIndex " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AbsoluteIndex -> [Char]
forall a. Show a => a -> [Char]
show AbsoluteIndex
ai [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- 4.5.4.  Literal Field Line With Name Reference
encodeLiteralFieldLineWithNameReference
    :: WriteBuffer -> DynamicTable -> HIndex -> ByteString -> Bool -> IO ()
encodeLiteralFieldLineWithNameReference :: WriteBuffer
-> DynamicTable -> HIndex -> FieldValue -> Bool -> IO ()
encodeLiteralFieldLineWithNameReference WriteBuffer
wbuf DynamicTable
dyntbl HIndex
hidx FieldValue
val Bool
huff = do
    (Int
idx, Word8 -> Word8
set) <- case HIndex
hidx of
        SIndex (AbsoluteIndex Int
i) -> (Int, Word8 -> Word8) -> IO (Int, Word8 -> Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, Word8 -> Word8
set0101)
        DIndex AbsoluteIndex
ai -> do
            DynamicTable -> AbsoluteIndex -> IO ()
updateRequiredInsertCount DynamicTable
dyntbl AbsoluteIndex
ai
            BasePoint
bp <- DynamicTable -> IO BasePoint
getBasePoint DynamicTable
dyntbl
            let PreBaseIndex Int
i = AbsoluteIndex -> BasePoint -> PreBaseIndex
toPreBaseIndex AbsoluteIndex
ai BasePoint
bp
            (Int, Word8 -> Word8) -> IO (Int, Word8 -> Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, Word8 -> Word8
set0100)
    WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set Int
4 Int
idx
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Int
-> FieldValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
forall a. a -> a
id Word8 -> Word8
set1 Int
7 FieldValue
val
    DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char]
"LiteralFieldLineWithNameReference (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HIndex -> [Char]
forall a. Show a => a -> [Char]
show HIndex
hidx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

{-
-- 4.5.5.  Literal Field Line With Post-Base Name Reference
encodeLiteralFieldLineWithPostBaseNameReference
    :: WriteBuffer
    -> DynamicTable
    -> AbsoluteIndex -- in Dynamic table
    -> ByteString
    -> Bool
    -> IO ()
encodeLiteralFieldLineWithPostBaseNameReference wbuf dyntbl ai val huff = do
    updateRequiredInsertCount dyntbl ai
    bp <- getBasePoint dyntbl
    let PostBaseIndex idx = toPostBaseIndex ai bp
    encodeI wbuf set00000 3 idx
    encodeS wbuf huff id set1 7 val
    qpackDebug dyntbl $
        putStrLn $
            "LiteralFieldLineWithPostBaseNameReference (DIndex " ++ show ai ++ ")"
-}

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

-- 4.5.6.  Literal Field Line with Literal Name
encodeLiteralFieldLineWithLiteralName
    :: WriteBuffer -> DynamicTable -> Token -> ByteString -> Bool -> IO ()
encodeLiteralFieldLineWithLiteralName :: WriteBuffer -> DynamicTable -> Token -> FieldValue -> Bool -> IO ()
encodeLiteralFieldLineWithLiteralName WriteBuffer
wbuf DynamicTable
dyntbl Token
token FieldValue
val Bool
huff = do
    let key :: FieldValue
key = Token -> FieldValue
tokenFoldedKey Token
token
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Int
-> FieldValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
set0010 Word8 -> Word8
set00001 Int
3 FieldValue
key
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Int
-> FieldValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
forall a. a -> a
id Word8 -> Word8
set1 Int
7 FieldValue
val
    DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char]
"LiteralFieldLineWithLiteralName " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FieldValue -> FieldValue -> [Char]
showHeader FieldValue
key FieldValue
val

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

showHeader :: ByteString -> ByteString -> String
showHeader :: FieldValue -> FieldValue -> [Char]
showHeader FieldValue
key FieldValue
val = [Char]
"\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FieldValue -> [Char]
C8.unpack FieldValue
key [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FieldValue -> [Char]
C8.unpack FieldValue
val [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""