{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Network.HPACK.HeaderBlock.Decode (
decodeHeader
, decodeTokenHeader
, ValueTable
, HeaderTable
, toHeaderTable
, getHeaderValue
, decodeString
, decodeS
, decodeSophisticated
, decodeSimple
) where
import Control.Exception (throwIO, catch)
import Data.Array (Array)
import Data.Array.Base (unsafeAt, unsafeRead, unsafeWrite)
import qualified Data.Array.IO as IOA
import qualified Data.Array.Unsafe as Unsafe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import Data.CaseInsensitive (CI(..))
import Data.Char (isUpper)
import Network.ByteOrder
import Imports hiding (empty)
import Network.HPACK.Builder
import Network.HPACK.HeaderBlock.Integer
import Network.HPACK.Huffman
import Network.HPACK.Table
import Network.HPACK.Token
import Network.HPACK.Types
type ValueTable = Array Int (Maybe HeaderValue)
{-# INLINE getHeaderValue #-}
getHeaderValue :: Token -> ValueTable -> Maybe HeaderValue
Token
t ValueTable
tbl = ValueTable
tbl forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Token -> Int
tokenIx Token
t
decodeHeader :: DynamicTable
-> ByteString
-> IO HeaderList
DynamicTable
dyntbl HeaderValue
inp = forall a.
DynamicTable -> HeaderValue -> (ReadBuffer -> IO a) -> IO a
decodeHPACK DynamicTable
dyntbl HeaderValue
inp ((Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO HeaderList
decodeSimple (DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl))
decodeTokenHeader :: DynamicTable
-> ByteString
-> IO HeaderTable
DynamicTable
dyntbl HeaderValue
inp =
forall a.
DynamicTable -> HeaderValue -> (ReadBuffer -> IO a) -> IO a
decodeHPACK DynamicTable
dyntbl HeaderValue
inp ((Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO HeaderTable
decodeSophisticated (DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl)) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \BufferOverrun
BufferOverrun -> forall e a. Exception e => e -> IO a
throwIO DecodeError
HeaderBlockTruncated
decodeHPACK :: DynamicTable
-> ByteString
-> (ReadBuffer -> IO a)
-> IO a
decodeHPACK :: forall a.
DynamicTable -> HeaderValue -> (ReadBuffer -> IO a) -> IO a
decodeHPACK DynamicTable
dyntbl HeaderValue
inp ReadBuffer -> IO a
dec = forall a. HeaderValue -> (ReadBuffer -> IO a) -> IO a
withReadBuffer HeaderValue
inp ReadBuffer -> IO a
chkChange
where
chkChange :: ReadBuffer -> IO a
chkChange ReadBuffer
rbuf = do
Word8
w <- forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
if Word8 -> Bool
isTableSizeUpdate Word8
w then do
DynamicTable -> Word8 -> ReadBuffer -> IO ()
tableSizeUpdate DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
ReadBuffer -> IO a
chkChange ReadBuffer
rbuf
else do
forall a. Readable a => a -> Int -> IO ()
ff ReadBuffer
rbuf (-Int
1)
ReadBuffer -> IO a
dec ReadBuffer
rbuf
decodeSimple :: (Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer
-> IO HeaderList
decodeSimple :: (Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO HeaderList
decodeSimple Word8 -> ReadBuffer -> IO TokenHeader
decTokenHeader ReadBuffer
rbuf = Builder TokenHeader -> IO HeaderList
go forall a. Builder a
empty
where
go :: Builder TokenHeader -> IO HeaderList
go Builder TokenHeader
builder = do
Int
leftover <- forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
if Int
leftover forall a. Ord a => a -> a -> Bool
>= Int
1 then do
Word8
w <- forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
TokenHeader
tv <- Word8 -> ReadBuffer -> IO TokenHeader
decTokenHeader Word8
w ReadBuffer
rbuf
let builder' :: Builder TokenHeader
builder' = Builder TokenHeader
builder forall a. Builder a -> a -> Builder a
<< TokenHeader
tv
Builder TokenHeader -> IO HeaderList
go Builder TokenHeader
builder'
else do
let tvs :: [TokenHeader]
tvs = forall a. Builder a -> [a]
run Builder TokenHeader
builder
kvs :: HeaderList
kvs = forall a b. (a -> b) -> [a] -> [b]
map (\(Token
t,HeaderValue
v) -> let k :: HeaderValue
k = Token -> HeaderValue
tokenFoldedKey Token
t in (HeaderValue
k,HeaderValue
v)) [TokenHeader]
tvs
forall (m :: * -> *) a. Monad m => a -> m a
return HeaderList
kvs
headerLimit :: Int
= Int
200
decodeSophisticated :: (Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer
-> IO HeaderTable
decodeSophisticated :: (Word8 -> ReadBuffer -> IO TokenHeader)
-> ReadBuffer -> IO HeaderTable
decodeSophisticated Word8 -> ReadBuffer -> IO TokenHeader
decTokenHeader ReadBuffer
rbuf = do
IOArray Int (Maybe HeaderValue)
arr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
IOA.newArray (Int
minTokenIx,Int
maxTokenIx) forall a. Maybe a
Nothing
[TokenHeader]
tvs <- IOArray Int (Maybe HeaderValue) -> IO [TokenHeader]
pseudoNormal IOArray Int (Maybe HeaderValue)
arr
ValueTable
tbl <- forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
Unsafe.unsafeFreeze IOArray Int (Maybe HeaderValue)
arr
forall (m :: * -> *) a. Monad m => a -> m a
return ([TokenHeader]
tvs, ValueTable
tbl)
where
pseudoNormal :: IOA.IOArray Int (Maybe HeaderValue) -> IO TokenHeaderList
pseudoNormal :: IOArray Int (Maybe HeaderValue) -> IO [TokenHeader]
pseudoNormal IOArray Int (Maybe HeaderValue)
arr = IO [TokenHeader]
pseudo
where
pseudo :: IO [TokenHeader]
pseudo = do
Int
leftover <- forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
if Int
leftover forall a. Ord a => a -> a -> Bool
>= Int
1 then do
Word8
w <- forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
tv :: TokenHeader
tv@(Token{Bool
Int
CI HeaderValue
tokenKey :: Token -> CI HeaderValue
isPseudo :: Token -> Bool
shouldBeIndexed :: Token -> Bool
tokenKey :: CI HeaderValue
isPseudo :: Bool
shouldBeIndexed :: Bool
tokenIx :: Int
tokenIx :: Token -> Int
..},HeaderValue
v) <- Word8 -> ReadBuffer -> IO TokenHeader
decTokenHeader Word8
w ReadBuffer
rbuf
if Bool
isPseudo then do
Maybe HeaderValue
mx <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead IOArray Int (Maybe HeaderValue)
arr Int
tokenIx
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe HeaderValue
mx) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
isMaxTokenIx Int
tokenIx) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOArray Int (Maybe HeaderValue)
arr Int
tokenIx (forall a. a -> Maybe a
Just HeaderValue
v)
IO [TokenHeader]
pseudo
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CI HeaderValue
tokenKey forall a. Eq a => a -> a -> Bool
== CI HeaderValue
"") forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
isMaxTokenIx Int
tokenIx Bool -> Bool -> Bool
&& (Char -> Bool) -> HeaderValue -> Bool
B8.any Char -> Bool
isUpper (forall s. CI s -> s
original CI HeaderValue
tokenKey)) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOArray Int (Maybe HeaderValue)
arr Int
tokenIx (forall a. a -> Maybe a
Just HeaderValue
v)
if Int -> Bool
isCookieTokenIx Int
tokenIx then
Int
-> Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal Int
0 forall a. Builder a
empty (forall a. Builder a
empty forall a. Builder a -> a -> Builder a
<< HeaderValue
v)
else
Int
-> Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal Int
0 (forall a. Builder a
empty forall a. Builder a -> a -> Builder a
<< TokenHeader
tv) forall a. Builder a
empty
else
forall (m :: * -> *) a. Monad m => a -> m a
return []
normal :: Int
-> Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal Int
n Builder TokenHeader
builder Builder HeaderValue
cookie
| Int
n forall a. Ord a => a -> a -> Bool
> Int
headerLimit = forall e a. Exception e => e -> IO a
throwIO DecodeError
TooLargeHeader
| Bool
otherwise = do
Int
leftover <- forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
if Int
leftover forall a. Ord a => a -> a -> Bool
>= Int
1 then do
Word8
w <- forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
tv :: TokenHeader
tv@(Token{Bool
Int
CI HeaderValue
tokenKey :: CI HeaderValue
isPseudo :: Bool
shouldBeIndexed :: Bool
tokenIx :: Int
tokenKey :: Token -> CI HeaderValue
isPseudo :: Token -> Bool
shouldBeIndexed :: Token -> Bool
tokenIx :: Token -> Int
..},HeaderValue
v) <- Word8 -> ReadBuffer -> IO TokenHeader
decTokenHeader Word8
w ReadBuffer
rbuf
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isPseudo forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CI HeaderValue
tokenKey forall a. Eq a => a -> a -> Bool
== CI HeaderValue
"") forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
isMaxTokenIx Int
tokenIx Bool -> Bool -> Bool
&& (Char -> Bool) -> HeaderValue -> Bool
B8.any Char -> Bool
isUpper (forall s. CI s -> s
original CI HeaderValue
tokenKey)) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOArray Int (Maybe HeaderValue)
arr Int
tokenIx (forall a. a -> Maybe a
Just HeaderValue
v)
if Int -> Bool
isCookieTokenIx Int
tokenIx then
Int
-> Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal (Int
nforall a. Num a => a -> a -> a
+Int
1) Builder TokenHeader
builder (Builder HeaderValue
cookie forall a. Builder a -> a -> Builder a
<< HeaderValue
v)
else
Int
-> Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal (Int
nforall a. Num a => a -> a -> a
+Int
1) (Builder TokenHeader
builder forall a. Builder a -> a -> Builder a
<< TokenHeader
tv) Builder HeaderValue
cookie
else do
let tvs0 :: [TokenHeader]
tvs0 = forall a. Builder a -> [a]
run Builder TokenHeader
builder
cook :: [HeaderValue]
cook = forall a. Builder a -> [a]
run Builder HeaderValue
cookie
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderValue]
cook then
forall (m :: * -> *) a. Monad m => a -> m a
return [TokenHeader]
tvs0
else do
let v :: HeaderValue
v = HeaderValue -> [HeaderValue] -> HeaderValue
BS.intercalate HeaderValue
"; " [HeaderValue]
cook
tvs :: [TokenHeader]
tvs = (Token
tokenCookie, HeaderValue
v) forall a. a -> [a] -> [a]
: [TokenHeader]
tvs0
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOArray Int (Maybe HeaderValue)
arr Int
cookieTokenIx (forall a. a -> Maybe a
Just HeaderValue
v)
forall (m :: * -> *) a. Monad m => a -> m a
return [TokenHeader]
tvs
toTokenHeader :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
| Word8
w forall a. Bits a => a -> Int -> Bool
`testBit` Int
7 = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
indexed DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
| Word8
w forall a. Bits a => a -> Int -> Bool
`testBit` Int
6 = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
incrementalIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
| Word8
w forall a. Bits a => a -> Int -> Bool
`testBit` Int
5 = forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalTableSizeUpdate
| Word8
w forall a. Bits a => a -> Int -> Bool
`testBit` Int
4 = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
neverIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
| Bool
otherwise = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
withoutIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
tableSizeUpdate :: DynamicTable -> Word8 -> ReadBuffer -> IO ()
tableSizeUpdate :: DynamicTable -> Word8 -> ReadBuffer -> IO ()
tableSizeUpdate DynamicTable
dyntbl Word8
w ReadBuffer
rbuf = do
let w' :: Word8
w' = Word8 -> Word8
mask5 Word8
w
Int
siz <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
5 Word8
w' ReadBuffer
rbuf
Bool
suitable <- Int -> DynamicTable -> IO Bool
isSuitableSize Int
siz DynamicTable
dyntbl
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
suitable forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO DecodeError
TooLargeTableSize
Int -> DynamicTable -> IO ()
renewDynamicTable Int
siz DynamicTable
dyntbl
indexed :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
indexed :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
indexed DynamicTable
dyntbl Word8
w ReadBuffer
rbuf = do
let w' :: Word8
w' = forall a. Bits a => a -> Int -> a
clearBit Word8
w Int
7
Int
idx <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
7 Word8
w' ReadBuffer
rbuf
Entry -> TokenHeader
entryTokenHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> Int -> IO Entry
toIndexedEntry DynamicTable
dyntbl Int
idx
incrementalIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
incrementalIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
incrementalIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf = do
tv :: TokenHeader
tv@(Token
t,HeaderValue
v) <- if Word8 -> Bool
isIndexedName1 Word8
w then
DynamicTable
-> Word8 -> ReadBuffer -> Int -> (Word8 -> Word8) -> IO TokenHeader
indexedName DynamicTable
dyntbl Word8
w ReadBuffer
rbuf Int
6 Word8 -> Word8
mask6
else
DynamicTable -> ReadBuffer -> IO TokenHeader
newName DynamicTable
dyntbl ReadBuffer
rbuf
let e :: Entry
e = Token -> HeaderValue -> Entry
toEntryToken Token
t HeaderValue
v
Entry -> DynamicTable -> IO ()
insertEntry Entry
e DynamicTable
dyntbl
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
tv
withoutIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
withoutIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
withoutIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
| Word8 -> Bool
isIndexedName2 Word8
w = DynamicTable
-> Word8 -> ReadBuffer -> Int -> (Word8 -> Word8) -> IO TokenHeader
indexedName DynamicTable
dyntbl Word8
w ReadBuffer
rbuf Int
4 Word8 -> Word8
mask4
| Bool
otherwise = DynamicTable -> ReadBuffer -> IO TokenHeader
newName DynamicTable
dyntbl ReadBuffer
rbuf
neverIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
neverIndexing :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
neverIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
| Word8 -> Bool
isIndexedName2 Word8
w = DynamicTable
-> Word8 -> ReadBuffer -> Int -> (Word8 -> Word8) -> IO TokenHeader
indexedName DynamicTable
dyntbl Word8
w ReadBuffer
rbuf Int
4 Word8 -> Word8
mask4
| Bool
otherwise = DynamicTable -> ReadBuffer -> IO TokenHeader
newName DynamicTable
dyntbl ReadBuffer
rbuf
indexedName :: DynamicTable -> Word8 -> ReadBuffer
-> Int -> (Word8 -> Word8)
-> IO TokenHeader
indexedName :: DynamicTable
-> Word8 -> ReadBuffer -> Int -> (Word8 -> Word8) -> IO TokenHeader
indexedName DynamicTable
dyntbl Word8
w ReadBuffer
rbuf Int
n Word8 -> Word8
mask = do
let p :: Word8
p = Word8 -> Word8
mask Word8
w
Int
idx <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
n Word8
p ReadBuffer
rbuf
Token
t <- Entry -> Token
entryToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> Int -> IO Entry
toIndexedEntry DynamicTable
dyntbl Int
idx
HeaderValue
val <- HuffmanDecoder -> ReadBuffer -> IO HeaderValue
decStr (DynamicTable -> HuffmanDecoder
huffmanDecoder DynamicTable
dyntbl) ReadBuffer
rbuf
let tv :: TokenHeader
tv = (Token
t,HeaderValue
val)
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
tv
newName :: DynamicTable -> ReadBuffer -> IO TokenHeader
newName :: DynamicTable -> ReadBuffer -> IO TokenHeader
newName DynamicTable
dyntbl ReadBuffer
rbuf = do
let hufdec :: HuffmanDecoder
hufdec = DynamicTable -> HuffmanDecoder
huffmanDecoder DynamicTable
dyntbl
Token
t <- HeaderValue -> Token
toToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HuffmanDecoder -> ReadBuffer -> IO HeaderValue
decStr HuffmanDecoder
hufdec ReadBuffer
rbuf
HeaderValue
val <- HuffmanDecoder -> ReadBuffer -> IO HeaderValue
decStr HuffmanDecoder
hufdec ReadBuffer
rbuf
let tv :: TokenHeader
tv = (Token
t,HeaderValue
val)
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
tv
isHuffman :: Word8 -> Bool
isHuffman :: Word8 -> Bool
isHuffman Word8
w = Word8
w forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
dropHuffman :: Word8 -> Word8
dropHuffman :: Word8 -> Word8
dropHuffman Word8
w = Word8
w forall a. Bits a => a -> Int -> a
`clearBit` Int
7
decodeString :: ReadBuffer -> IO ByteString
decodeString :: ReadBuffer -> IO HeaderValue
decodeString ReadBuffer
rbuf = do
let bufsiz :: Int
bufsiz = Int
4096
ForeignPtr Word8
gcbuf <- forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
4096
(Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO HeaderValue
decodeS Word8 -> Word8
dropHuffman Word8 -> Bool
isHuffman Int
7 (ForeignPtr Word8 -> Int -> HuffmanDecoder
decodeH ForeignPtr Word8
gcbuf Int
bufsiz) ReadBuffer
rbuf
decStr :: HuffmanDecoder -> ReadBuffer -> IO ByteString
decStr :: HuffmanDecoder -> ReadBuffer -> IO HeaderValue
decStr = (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO HeaderValue
decodeS Word8 -> Word8
dropHuffman Word8 -> Bool
isHuffman Int
7
decodeS :: (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO ByteString
decodeS :: (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO HeaderValue
decodeS Word8 -> Word8
mask Word8 -> Bool
isH Int
n HuffmanDecoder
hufdec ReadBuffer
rbuf = do
Word8
w <- forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
let p :: Word8
p = Word8 -> Word8
mask Word8
w
huff :: Bool
huff = Word8 -> Bool
isH Word8
w
Int
len <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
n Word8
p ReadBuffer
rbuf
if Bool
huff then
HuffmanDecoder
hufdec ReadBuffer
rbuf Int
len
else
forall a. Readable a => a -> Int -> IO HeaderValue
extractByteString ReadBuffer
rbuf Int
len
mask6 :: Word8 -> Word8
mask6 :: Word8 -> Word8
mask6 Word8
w = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
63
mask5 :: Word8 -> Word8
mask5 :: Word8 -> Word8
mask5 Word8
w = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
31
mask4 :: Word8 -> Word8
mask4 :: Word8 -> Word8
mask4 Word8
w = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
15
isIndexedName1 :: Word8 -> Bool
isIndexedName1 :: Word8 -> Bool
isIndexedName1 Word8
w = Word8 -> Word8
mask6 Word8
w forall a. Eq a => a -> a -> Bool
/= Word8
0
isIndexedName2 :: Word8 -> Bool
isIndexedName2 :: Word8 -> Bool
isIndexedName2 Word8
w = Word8 -> Word8
mask4 Word8
w forall a. Eq a => a -> a -> Bool
/= Word8
0
isTableSizeUpdate :: Word8 -> Bool
isTableSizeUpdate :: Word8 -> Bool
isTableSizeUpdate Word8
w = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
0xe0 forall a. Eq a => a -> a -> Bool
== Word8
0x20
type = (TokenHeaderList, ValueTable)
toHeaderTable :: [(CI HeaderName,HeaderValue)] -> IO HeaderTable
[(CI HeaderValue, HeaderValue)]
kvs = do
IOArray Int (Maybe HeaderValue)
arr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
IOA.newArray (Int
minTokenIx,Int
maxTokenIx) forall a. Maybe a
Nothing
[TokenHeader]
tvs <- IOArray Int (Maybe HeaderValue) -> IO [TokenHeader]
conv IOArray Int (Maybe HeaderValue)
arr
ValueTable
tbl <- forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
Unsafe.unsafeFreeze IOArray Int (Maybe HeaderValue)
arr
forall (m :: * -> *) a. Monad m => a -> m a
return ([TokenHeader]
tvs, ValueTable
tbl)
where
conv :: IOA.IOArray Int (Maybe HeaderValue) -> IO TokenHeaderList
conv :: IOArray Int (Maybe HeaderValue) -> IO [TokenHeader]
conv IOArray Int (Maybe HeaderValue)
arr = [(CI HeaderValue, HeaderValue)]
-> Builder TokenHeader -> IO [TokenHeader]
go [(CI HeaderValue, HeaderValue)]
kvs forall a. Builder a
empty
where
go :: [(CI HeaderName,HeaderValue)] -> Builder TokenHeader -> IO TokenHeaderList
go :: [(CI HeaderValue, HeaderValue)]
-> Builder TokenHeader -> IO [TokenHeader]
go [] Builder TokenHeader
builder = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Builder a -> [a]
run Builder TokenHeader
builder
go ((CI HeaderValue
k,HeaderValue
v):[(CI HeaderValue, HeaderValue)]
xs) Builder TokenHeader
builder = do
let t :: Token
t = HeaderValue -> Token
toToken (forall s. CI s -> s
foldedCase CI HeaderValue
k)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOArray Int (Maybe HeaderValue)
arr (Token -> Int
tokenIx Token
t) (forall a. a -> Maybe a
Just HeaderValue
v)
let tv :: TokenHeader
tv = (Token
t,HeaderValue
v)
builder' :: Builder TokenHeader
builder' = Builder TokenHeader
builder forall a. Builder a -> a -> Builder a
<< TokenHeader
tv
[(CI HeaderValue, HeaderValue)]
-> Builder TokenHeader -> IO [TokenHeader]
go [(CI HeaderValue, HeaderValue)]
xs Builder TokenHeader
builder'