{-# 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
decodeTokenHeader :: DynamicTable -> ReadBuffer -> IO HeaderTable
decodeTokenHeader 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
decodeTokenHeaderS :: DynamicTable -> ReadBuffer -> IO HeaderList
decodeTokenHeaderS 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
toTokenHeader :: DynamicTable -> BasePoint -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader 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

-- 4.5.2.  Indexed Field Line
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

-- 4.5.4.  Literal Field Line With Name Reference
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

-- 4.5.6.  Literal Field Line Without Name Reference
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

-- 4.5.3.  Indexed Field Line With Post-Base Index
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

-- 4.5.5.  Literal Field Line With Post-Base Name Reference
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
showTokenHeader :: TokenHeader -> String
showTokenHeader (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