{-# LANGUAGE BinaryLiterals #-}
module Network.QPACK.HeaderBlock.Decode where
import Control.Concurrent.STM
import qualified Data.ByteString.Char8 as BS8
import Data.CaseInsensitive
import Network.ByteOrder
import Network.HPACK (TokenHeader, HeaderTable, HeaderList)
import Network.HPACK.Internal
import Network.HPACK.Token (toToken, tokenKey)
import Imports
import Network.QPACK.HeaderBlock.Prefix
import Network.QPACK.Table
import Network.QPACK.Types
decodeTokenHeader :: DynamicTable
-> ReadBuffer
-> IO HeaderTable
DynamicTable
dyntbl ReadBuffer
rbuf = do
(InsertionPoint
reqip, BasePoint
bp) <- ReadBuffer -> DynamicTable -> IO (InsertionPoint, BasePoint)
decodePrefix ReadBuffer
rbuf DynamicTable
dyntbl
DynamicTable -> InsertionPoint -> IO ()
checkInsertionPoint DynamicTable
dyntbl InsertionPoint
reqip
(Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO HeaderTable
decodeSophisticated (DynamicTable -> BasePoint -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl BasePoint
bp) ReadBuffer
rbuf
decodeTokenHeaderS :: DynamicTable
-> ReadBuffer
-> IO HeaderList
DynamicTable
dyntbl ReadBuffer
rbuf = do
(InsertionPoint
reqip, BasePoint
bp) <- ReadBuffer -> DynamicTable -> IO (InsertionPoint, BasePoint)
decodePrefix ReadBuffer
rbuf DynamicTable
dyntbl
Bool
debug <- DynamicTable -> IO Bool
getDebugQPACK DynamicTable
dyntbl
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
debug forall a b. (a -> b) -> a -> b
$ DynamicTable -> InsertionPoint -> IO ()
checkInsertionPoint DynamicTable
dyntbl InsertionPoint
reqip
(Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO HeaderList
decodeSimple (DynamicTable -> BasePoint -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl BasePoint
bp) ReadBuffer
rbuf
toTokenHeader :: DynamicTable -> BasePoint -> Word8 -> ReadBuffer -> IO TokenHeader
DynamicTable
dyntbl BasePoint
bp Word8
w8 ReadBuffer
rbuf
| Word8
w8 forall a. Bits a => a -> Int -> Bool
`testBit` Int
7 = ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeIndexedFieldLine ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
bp Word8
w8
| Word8
w8 forall a. Bits a => a -> Int -> Bool
`testBit` Int
6 = ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeLiteralFieldLineWithNameReference ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
bp Word8
w8
| Word8
w8 forall a. Bits a => a -> Int -> Bool
`testBit` Int
5 = ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeLiteralFieldLineWithoutNameReference ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
bp Word8
w8
| Word8
w8 forall a. Bits a => a -> Int -> Bool
`testBit` Int
4 = ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeIndexedFieldLineWithPostBaseIndex ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
bp Word8
w8
| Bool
otherwise = ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeLiteralFieldLineWithPostBaseNameReference ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
bp Word8
w8
decodeIndexedFieldLine :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeIndexedFieldLine :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeIndexedFieldLine ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
bp Word8
w8 = do
Int
i <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
6 (Word8
w8 forall a. Bits a => a -> a -> a
.&. Word8
0b00111111) ReadBuffer
rbuf
let static :: Bool
static = Word8
w8 forall a. Bits a => a -> Int -> Bool
`testBit` Int
6
hidx :: HIndex
hidx | Bool
static = AbsoluteIndex -> HIndex
SIndex forall a b. (a -> b) -> a -> b
$ Int -> AbsoluteIndex
AbsoluteIndex Int
i
| Bool
otherwise = AbsoluteIndex -> HIndex
DIndex forall a b. (a -> b) -> a -> b
$ HBRelativeIndex -> BasePoint -> AbsoluteIndex
fromHBRelativeIndex (Int -> HBRelativeIndex
HBRelativeIndex Int
i) BasePoint
bp
TokenHeader
ret <- forall a. STM a -> IO a
atomically (Entry -> TokenHeader
entryTokenHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> HIndex -> STM Entry
toIndexedEntry DynamicTable
dyntbl HIndex
hidx)
DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"IndexedFieldLine (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show HIndex
hidx forall a. [a] -> [a] -> [a]
++ String
") " forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
ret
decodeLiteralFieldLineWithNameReference :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeLiteralFieldLineWithNameReference :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeLiteralFieldLineWithNameReference ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
bp Word8
w8 = do
Int
i <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
4 (Word8
w8 forall a. Bits a => a -> a -> a
.&. Word8
0b00001111) ReadBuffer
rbuf
let static :: Bool
static = Word8
w8 forall a. Bits a => a -> Int -> Bool
`testBit` Int
4
hidx :: HIndex
hidx | Bool
static = AbsoluteIndex -> HIndex
SIndex forall a b. (a -> b) -> a -> b
$ Int -> AbsoluteIndex
AbsoluteIndex Int
i
| Bool
otherwise = AbsoluteIndex -> HIndex
DIndex forall a b. (a -> b) -> a -> b
$ HBRelativeIndex -> BasePoint -> AbsoluteIndex
fromHBRelativeIndex (Int -> HBRelativeIndex
HBRelativeIndex Int
i) BasePoint
bp
Token
key <- forall a. STM a -> IO a
atomically (Entry -> Token
entryToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> HIndex -> STM Entry
toIndexedEntry DynamicTable
dyntbl HIndex
hidx)
let hufdec :: HuffmanDecoder
hufdec = DynamicTable -> HuffmanDecoder
getHuffmanDecoder DynamicTable
dyntbl
ByteString
val <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO ByteString
decodeS (forall a. Bits a => a -> Int -> a
`clearBit` Int
7) (forall a. Bits a => a -> Int -> Bool
`testBit` Int
7) Int
7 HuffmanDecoder
hufdec ReadBuffer
rbuf
let ret :: TokenHeader
ret = (Token
key,ByteString
val)
DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"LiteralFieldLineWithNameReference (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show HIndex
hidx forall a. [a] -> [a] -> [a]
++ String
") " forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
ret
decodeLiteralFieldLineWithoutNameReference :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeLiteralFieldLineWithoutNameReference :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeLiteralFieldLineWithoutNameReference ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
_bp Word8
_w8 = do
forall a. Readable a => a -> Int -> IO ()
ff ReadBuffer
rbuf (-Int
1)
let hufdec :: HuffmanDecoder
hufdec = DynamicTable -> HuffmanDecoder
getHuffmanDecoder DynamicTable
dyntbl
Token
key <- ByteString -> Token
toToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO ByteString
decodeS (forall a. Bits a => a -> a -> a
.&. Word8
0b00000111) (forall a. Bits a => a -> Int -> Bool
`testBit` Int
3) Int
3 HuffmanDecoder
hufdec ReadBuffer
rbuf
ByteString
val <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO ByteString
decodeS (forall a. Bits a => a -> Int -> a
`clearBit` Int
7) (forall a. Bits a => a -> Int -> Bool
`testBit` Int
7) Int
7 HuffmanDecoder
hufdec ReadBuffer
rbuf
let ret :: TokenHeader
ret = (Token
key,ByteString
val)
DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"LiteralFieldLineWithoutNameReference " forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
ret
decodeIndexedFieldLineWithPostBaseIndex :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeIndexedFieldLineWithPostBaseIndex :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeIndexedFieldLineWithPostBaseIndex ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
bp Word8
w8 = do
Int
i <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
4 (Word8
w8 forall a. Bits a => a -> a -> a
.&. Word8
0b00001111) ReadBuffer
rbuf
let hidx :: HIndex
hidx = AbsoluteIndex -> HIndex
DIndex forall a b. (a -> b) -> a -> b
$ PostBaseIndex -> BasePoint -> AbsoluteIndex
fromPostBaseIndex (Int -> PostBaseIndex
PostBaseIndex Int
i) BasePoint
bp
TokenHeader
ret <- forall a. STM a -> IO a
atomically (Entry -> TokenHeader
entryTokenHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> HIndex -> STM Entry
toIndexedEntry DynamicTable
dyntbl HIndex
hidx)
DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"IndexedFieldLineWithPostBaseIndex (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show HIndex
hidx forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BasePoint
bp forall a. [a] -> [a] -> [a]
++ String
") " forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
ret
decodeLiteralFieldLineWithPostBaseNameReference :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeLiteralFieldLineWithPostBaseNameReference :: ReadBuffer -> DynamicTable -> BasePoint -> Word8 -> IO TokenHeader
decodeLiteralFieldLineWithPostBaseNameReference ReadBuffer
rbuf DynamicTable
dyntbl BasePoint
bp Word8
w8 = do
Int
i <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
3 (Word8
w8 forall a. Bits a => a -> a -> a
.&. Word8
0b00000111) ReadBuffer
rbuf
let hidx :: HIndex
hidx = AbsoluteIndex -> HIndex
DIndex forall a b. (a -> b) -> a -> b
$ PostBaseIndex -> BasePoint -> AbsoluteIndex
fromPostBaseIndex (Int -> PostBaseIndex
PostBaseIndex Int
i) BasePoint
bp
Token
key <- forall a. STM a -> IO a
atomically (Entry -> Token
entryToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> HIndex -> STM Entry
toIndexedEntry DynamicTable
dyntbl HIndex
hidx)
let hufdec :: HuffmanDecoder
hufdec = DynamicTable -> HuffmanDecoder
getHuffmanDecoder DynamicTable
dyntbl
ByteString
val <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO ByteString
decodeS (forall a. Bits a => a -> Int -> a
`clearBit` Int
7) (forall a. Bits a => a -> Int -> Bool
`testBit` Int
7) Int
7 HuffmanDecoder
hufdec ReadBuffer
rbuf
let ret :: TokenHeader
ret = (Token
key,ByteString
val)
DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable
dyntbl forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"LiteralFieldLineWithPostBaseNameReference (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show HIndex
hidx forall a. [a] -> [a] -> [a]
++ String
") " forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
ret
showTokenHeader :: TokenHeader -> String
(Token
t,ByteString
val) = String
"\"" forall a. [a] -> [a] -> [a]
++ String
key forall a. [a] -> [a] -> [a]
++ String
"\" \"" forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS8.unpack ByteString
val forall a. [a] -> [a] -> [a]
++ String
"\""
where
key :: String
key = ByteString -> String
BS8.unpack forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
foldedCase forall a b. (a -> b) -> a -> b
$ Token -> CI ByteString
tokenKey Token
t