{-# 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 (HeaderList, HeaderTable, TokenHeader)
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
debug (IO () -> IO ()) -> IO () -> IO ()
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 Word8 -> Int -> Bool
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 Word8 -> Int -> Bool
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 Word8 -> Int -> Bool
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 Word8 -> Int -> Bool
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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111111) ReadBuffer
rbuf
let static :: Bool
static = Word8
w8 Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
6
hidx :: HIndex
hidx
| Bool
static = AbsoluteIndex -> HIndex
SIndex (AbsoluteIndex -> HIndex) -> AbsoluteIndex -> HIndex
forall a b. (a -> b) -> a -> b
$ Int -> AbsoluteIndex
AbsoluteIndex Int
i
| Bool
otherwise = AbsoluteIndex -> HIndex
DIndex (AbsoluteIndex -> HIndex) -> AbsoluteIndex -> HIndex
forall a b. (a -> b) -> a -> b
$ HBRelativeIndex -> BasePoint -> AbsoluteIndex
fromHBRelativeIndex (Int -> HBRelativeIndex
HBRelativeIndex Int
i) BasePoint
bp
TokenHeader
ret <- STM TokenHeader -> IO TokenHeader
forall a. STM a -> IO a
atomically (Entry -> TokenHeader
entryTokenHeader (Entry -> TokenHeader) -> STM Entry -> STM TokenHeader
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"IndexedFieldLine (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ HIndex -> String
forall a. Show a => a -> String
show HIndex
hidx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
TokenHeader -> IO TokenHeader
forall a. a -> IO a
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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00001111) ReadBuffer
rbuf
let static :: Bool
static = Word8
w8 Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
4
hidx :: HIndex
hidx
| Bool
static = AbsoluteIndex -> HIndex
SIndex (AbsoluteIndex -> HIndex) -> AbsoluteIndex -> HIndex
forall a b. (a -> b) -> a -> b
$ Int -> AbsoluteIndex
AbsoluteIndex Int
i
| Bool
otherwise = AbsoluteIndex -> HIndex
DIndex (AbsoluteIndex -> HIndex) -> AbsoluteIndex -> HIndex
forall a b. (a -> b) -> a -> b
$ HBRelativeIndex -> BasePoint -> AbsoluteIndex
fromHBRelativeIndex (Int -> HBRelativeIndex
HBRelativeIndex Int
i) BasePoint
bp
Token
key <- STM Token -> IO Token
forall a. STM a -> IO a
atomically (Entry -> Token
entryToken (Entry -> Token) -> STM Entry -> STM Token
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 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
7) (Word8 -> Int -> Bool
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"LiteralFieldLineWithNameReference ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ HIndex -> String
forall a. Show a => a -> String
show HIndex
hidx
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
TokenHeader -> IO TokenHeader
forall a. a -> IO a
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
ReadBuffer -> Int -> IO ()
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 (ByteString -> Token) -> IO ByteString -> IO Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO ByteString
decodeS (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000111) (Word8 -> Int -> Bool
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 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
7) (Word8 -> Int -> Bool
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"LiteralFieldLineWithoutNameReference " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
TokenHeader -> IO TokenHeader
forall a. a -> IO a
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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00001111) ReadBuffer
rbuf
let hidx :: HIndex
hidx = AbsoluteIndex -> HIndex
DIndex (AbsoluteIndex -> HIndex) -> AbsoluteIndex -> HIndex
forall a b. (a -> b) -> a -> b
$ PostBaseIndex -> BasePoint -> AbsoluteIndex
fromPostBaseIndex (Int -> PostBaseIndex
PostBaseIndex Int
i) BasePoint
bp
TokenHeader
ret <- STM TokenHeader -> IO TokenHeader
forall a. STM a -> IO a
atomically (Entry -> TokenHeader
entryTokenHeader (Entry -> TokenHeader) -> STM Entry -> STM TokenHeader
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"IndexedFieldLineWithPostBaseIndex ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ HIndex -> String
forall a. Show a => a -> String
show HIndex
hidx
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ BasePoint -> String
forall a. Show a => a -> String
show BasePoint
bp
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
TokenHeader -> IO TokenHeader
forall a. a -> IO a
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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000111) ReadBuffer
rbuf
let hidx :: HIndex
hidx = AbsoluteIndex -> HIndex
DIndex (AbsoluteIndex -> HIndex) -> AbsoluteIndex -> HIndex
forall a b. (a -> b) -> a -> b
$ PostBaseIndex -> BasePoint -> AbsoluteIndex
fromPostBaseIndex (Int -> PostBaseIndex
PostBaseIndex Int
i) BasePoint
bp
Token
key <- STM Token -> IO Token
forall a. STM a -> IO a
atomically (Entry -> Token
entryToken (Entry -> Token) -> STM Entry -> STM Token
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 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
7) (Word8 -> Int -> Bool
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"LiteralFieldLineWithPostBaseNameReference ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ HIndex -> String
forall a. Show a => a -> String
show HIndex
hidx
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TokenHeader -> String
showTokenHeader TokenHeader
ret
TokenHeader -> IO TokenHeader
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
ret
showTokenHeader :: TokenHeader -> String
(Token
t, ByteString
val) = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS8.unpack ByteString
val String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
where
key :: String
key = ByteString -> String
BS8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
foldedCase (CI ByteString -> ByteString) -> CI ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Token -> CI ByteString
tokenKey Token
t