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

-- 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 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

-- 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 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

-- 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
    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

-- 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 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

-- 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 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
showTokenHeader :: TokenHeader -> String
showTokenHeader (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