{-# 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.Internal (
decodeI,
decodeS,
decodeSimple,
decodeSophisticated,
entryToken,
entryTokenHeader,
)
import Network.HTTP.Types
import Imports
import Network.QPACK.HeaderBlock.Prefix
import Network.QPACK.Table
import Network.QPACK.Types
decodeTokenHeader
:: DynamicTable
-> ReadBuffer
-> IO TokenHeaderTable
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 TokenHeaderTable
decodeSophisticated (DynamicTable -> BasePoint -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl BasePoint
bp) ReadBuffer
rbuf
decodeTokenHeaderS
:: DynamicTable
-> ReadBuffer
-> IO [Header]
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 [Header]
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