{-# LANGUAGE BangPatterns, RecordWildCards, OverloadedStrings #-}
module Network.HPACK.HeaderBlock.Decode (
decodeHeader
, decodeTokenHeader
, ValueTable
, HeaderTable
, toHeaderTable
, getHeaderValue
) where
import Control.Exception (throwIO)
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.Char (isUpper)
import Data.CaseInsensitive (CI(..))
import Network.ByteOrder
import Imports hiding (empty)
import Network.HPACK.Builder
import qualified Network.HPACK.HeaderBlock.Integer as I
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 ValueTable -> Int -> Maybe HeaderValue
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 = DynamicTable
-> HeaderValue
-> (DynamicTable -> ReadBuffer -> IO HeaderList)
-> IO HeaderList
forall a.
DynamicTable
-> HeaderValue -> (DynamicTable -> ReadBuffer -> IO a) -> IO a
decodeHPACK DynamicTable
dyntbl HeaderValue
inp DynamicTable -> ReadBuffer -> IO HeaderList
decodeSimple
decodeTokenHeader :: DynamicTable
-> ByteString
-> IO HeaderTable
DynamicTable
dyntbl HeaderValue
inp = DynamicTable
-> HeaderValue
-> (DynamicTable -> ReadBuffer -> IO HeaderTable)
-> IO HeaderTable
forall a.
DynamicTable
-> HeaderValue -> (DynamicTable -> ReadBuffer -> IO a) -> IO a
decodeHPACK DynamicTable
dyntbl HeaderValue
inp DynamicTable -> ReadBuffer -> IO HeaderTable
decodeSophisticated
decodeHPACK :: DynamicTable
-> ByteString
-> (DynamicTable -> ReadBuffer -> IO a)
-> IO a
decodeHPACK :: DynamicTable
-> HeaderValue -> (DynamicTable -> ReadBuffer -> IO a) -> IO a
decodeHPACK DynamicTable
dyntbl HeaderValue
inp DynamicTable -> ReadBuffer -> IO a
dec = HeaderValue -> (ReadBuffer -> IO a) -> IO a
forall a. HeaderValue -> (ReadBuffer -> IO a) -> IO a
withReadBuffer HeaderValue
inp ReadBuffer -> IO a
chkChange
where
chkChange :: ReadBuffer -> IO a
chkChange ReadBuffer
rbuf = do
Int
leftover <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
if Int
leftover Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 then do
Word8
w <- ReadBuffer -> IO Word8
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
ReadBuffer -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
ff ReadBuffer
rbuf (-Int
1)
DynamicTable -> ReadBuffer -> IO a
dec DynamicTable
dyntbl ReadBuffer
rbuf
else
DecodeError -> IO a
forall e a. Exception e => e -> IO a
throwIO DecodeError
HeaderBlockTruncated
decodeSimple :: DynamicTable -> ReadBuffer -> IO HeaderList
decodeSimple :: DynamicTable -> ReadBuffer -> IO HeaderList
decodeSimple DynamicTable
dyntbl ReadBuffer
rbuf = Builder TokenHeader -> IO HeaderList
go Builder TokenHeader
forall a. Builder a
empty
where
go :: Builder TokenHeader -> IO HeaderList
go Builder TokenHeader
builder = do
Int
leftover <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
if Int
leftover Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 then do
Word8
w <- ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
!TokenHeader
tv <- DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
let builder' :: Builder TokenHeader
builder' = Builder TokenHeader
builder Builder TokenHeader -> TokenHeader -> Builder TokenHeader
forall a. Builder a -> a -> Builder a
<< TokenHeader
tv
Builder TokenHeader -> IO HeaderList
go Builder TokenHeader
builder'
else do
let !tvs :: [TokenHeader]
tvs = Builder TokenHeader -> [TokenHeader]
forall a. Builder a -> [a]
run Builder TokenHeader
builder
!kvs :: HeaderList
kvs = (TokenHeader -> (HeaderValue, HeaderValue))
-> [TokenHeader] -> HeaderList
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
HeaderList -> IO HeaderList
forall (m :: * -> *) a. Monad m => a -> m a
return HeaderList
kvs
decodeSophisticated :: DynamicTable -> ReadBuffer
-> IO HeaderTable
decodeSophisticated :: DynamicTable -> ReadBuffer -> IO HeaderTable
decodeSophisticated DynamicTable
dyntbl ReadBuffer
rbuf = do
IOArray Int (Maybe HeaderValue)
arr <- (Int, Int)
-> Maybe HeaderValue -> IO (IOArray Int (Maybe HeaderValue))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
IOA.newArray (Int
minTokenIx,Int
maxTokenIx) Maybe HeaderValue
forall a. Maybe a
Nothing
![TokenHeader]
tvs <- IOArray Int (Maybe HeaderValue) -> IO [TokenHeader]
pseudoNormal IOArray Int (Maybe HeaderValue)
arr
ValueTable
tbl <- IOArray Int (Maybe HeaderValue) -> IO ValueTable
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
HeaderTable -> IO HeaderTable
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 <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
if Int
leftover Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 then do
Word8
w <- ReadBuffer -> IO Word8
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
ix :: Token -> Int
tokenKey :: CI HeaderValue
isPseudo :: Bool
shouldBeIndexed :: Bool
ix :: Int
..},!HeaderValue
v) <- DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
if Bool
isPseudo then do
Maybe HeaderValue
mx <- IOArray Int (Maybe HeaderValue) -> Int -> IO (Maybe HeaderValue)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead IOArray Int (Maybe HeaderValue)
arr Int
ix
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe HeaderValue -> Bool
forall a. Maybe a -> Bool
isJust Maybe HeaderValue
mx) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DecodeError -> IO ()
forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
isMaxTokenIx Int
ix) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DecodeError -> IO ()
forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
IOArray Int (Maybe HeaderValue)
-> Int -> Maybe HeaderValue -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOArray Int (Maybe HeaderValue)
arr Int
ix (HeaderValue -> Maybe HeaderValue
forall a. a -> Maybe a
Just HeaderValue
v)
IO [TokenHeader]
pseudo
else do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
isMaxTokenIx Int
ix Bool -> Bool -> Bool
&& (Char -> Bool) -> HeaderValue -> Bool
B8.any Char -> Bool
isUpper (CI HeaderValue -> HeaderValue
forall s. CI s -> s
original CI HeaderValue
tokenKey)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
DecodeError -> IO ()
forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
IOArray Int (Maybe HeaderValue)
-> Int -> Maybe HeaderValue -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOArray Int (Maybe HeaderValue)
arr Int
ix (HeaderValue -> Maybe HeaderValue
forall a. a -> Maybe a
Just HeaderValue
v)
if Int -> Bool
isCookieTokenIx Int
ix then
Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal Builder TokenHeader
forall a. Builder a
empty (Builder HeaderValue
forall a. Builder a
empty Builder HeaderValue -> HeaderValue -> Builder HeaderValue
forall a. Builder a -> a -> Builder a
<< HeaderValue
v)
else
Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal (Builder TokenHeader
forall a. Builder a
empty Builder TokenHeader -> TokenHeader -> Builder TokenHeader
forall a. Builder a -> a -> Builder a
<< TokenHeader
tv) Builder HeaderValue
forall a. Builder a
empty
else
[TokenHeader] -> IO [TokenHeader]
forall (m :: * -> *) a. Monad m => a -> m a
return []
normal :: Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal !Builder TokenHeader
builder !Builder HeaderValue
cookie = do
Int
leftover <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
if Int
leftover Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 then do
Word8
w <- ReadBuffer -> IO Word8
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
ix :: Int
tokenKey :: Token -> CI HeaderValue
isPseudo :: Token -> Bool
shouldBeIndexed :: Token -> Bool
ix :: Token -> Int
..},!HeaderValue
v) <- DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
toTokenHeader DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isPseudo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DecodeError -> IO ()
forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
isMaxTokenIx Int
ix Bool -> Bool -> Bool
&& (Char -> Bool) -> HeaderValue -> Bool
B8.any Char -> Bool
isUpper (CI HeaderValue -> HeaderValue
forall s. CI s -> s
original CI HeaderValue
tokenKey)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
DecodeError -> IO ()
forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalHeaderName
IOArray Int (Maybe HeaderValue)
-> Int -> Maybe HeaderValue -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOArray Int (Maybe HeaderValue)
arr Int
ix (HeaderValue -> Maybe HeaderValue
forall a. a -> Maybe a
Just HeaderValue
v)
if Int -> Bool
isCookieTokenIx Int
ix then
Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal Builder TokenHeader
builder (Builder HeaderValue
cookie Builder HeaderValue -> HeaderValue -> Builder HeaderValue
forall a. Builder a -> a -> Builder a
<< HeaderValue
v)
else
Builder TokenHeader -> Builder HeaderValue -> IO [TokenHeader]
normal (Builder TokenHeader
builder Builder TokenHeader -> TokenHeader -> Builder TokenHeader
forall a. Builder a -> a -> Builder a
<< TokenHeader
tv) Builder HeaderValue
cookie
else do
let !tvs0 :: [TokenHeader]
tvs0 = Builder TokenHeader -> [TokenHeader]
forall a. Builder a -> [a]
run Builder TokenHeader
builder
!cook :: [HeaderValue]
cook = Builder HeaderValue -> [HeaderValue]
forall a. Builder a -> [a]
run Builder HeaderValue
cookie
if [HeaderValue] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderValue]
cook then
[TokenHeader] -> IO [TokenHeader]
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) TokenHeader -> [TokenHeader] -> [TokenHeader]
forall a. a -> [a] -> [a]
: [TokenHeader]
tvs0
IOArray Int (Maybe HeaderValue)
-> Int -> Maybe HeaderValue -> IO ()
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 (HeaderValue -> Maybe HeaderValue
forall a. a -> Maybe a
Just HeaderValue
v)
[TokenHeader] -> IO [TokenHeader]
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 Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7 = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
indexed DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
| Word8
w Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
6 = DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader
incrementalIndexing DynamicTable
dyntbl Word8
w ReadBuffer
rbuf
| Word8
w Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
5 = DecodeError -> IO TokenHeader
forall e a. Exception e => e -> IO a
throwIO DecodeError
IllegalTableSizeUpdate
| Word8
w Word8 -> Int -> Bool
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
I.decode Int
5 Word8
w' ReadBuffer
rbuf
Bool
suitable <- Int -> DynamicTable -> IO Bool
isSuitableSize Int
siz DynamicTable
dyntbl
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
suitable (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DecodeError -> IO ()
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' = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
w Int
7
!Int
idx <- Int -> Word8 -> ReadBuffer -> IO Int
I.decode Int
7 Word8
w' ReadBuffer
rbuf
Entry -> TokenHeader
entryTokenHeader (Entry -> TokenHeader) -> IO Entry -> IO TokenHeader
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
TokenHeader -> IO TokenHeader
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
I.decode Int
n Word8
p ReadBuffer
rbuf
!Token
t <- Entry -> Token
entryToken (Entry -> Token) -> IO Entry -> IO Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> Int -> IO Entry
toIndexedEntry DynamicTable
dyntbl Int
idx
!HeaderValue
val <- DynamicTable -> ReadBuffer -> IO HeaderValue
headerStuff DynamicTable
dyntbl ReadBuffer
rbuf
let !tv :: TokenHeader
tv = (Token
t,HeaderValue
val)
TokenHeader -> IO TokenHeader
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
!Token
t <- HeaderValue -> Token
toToken (HeaderValue -> Token) -> IO HeaderValue -> IO Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicTable -> ReadBuffer -> IO HeaderValue
headerStuff DynamicTable
dyntbl ReadBuffer
rbuf
!HeaderValue
val <- DynamicTable -> ReadBuffer -> IO HeaderValue
headerStuff DynamicTable
dyntbl ReadBuffer
rbuf
let !tv :: TokenHeader
tv = (Token
t,HeaderValue
val)
TokenHeader -> IO TokenHeader
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeader
tv
headerStuff :: DynamicTable -> ReadBuffer -> IO HeaderStuff
DynamicTable
dyntbl ReadBuffer
rbuf = do
Int
leftover <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
if Int
leftover Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 then do
Word8
w <- ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
let !p :: Word8
p = Word8 -> Word8
dropHuffman Word8
w
!huff :: Bool
huff = Word8 -> Bool
isHuffman Word8
w
!Int
len <- Int -> Word8 -> ReadBuffer -> IO Int
I.decode Int
7 Word8
p ReadBuffer
rbuf
Bool -> HuffmanDecoding -> HuffmanDecoding
decodeString Bool
huff (DynamicTable -> HuffmanDecoding
huffmanDecoder DynamicTable
dyntbl) ReadBuffer
rbuf Int
len
else
DecodeError -> IO HeaderValue
forall e a. Exception e => e -> IO a
throwIO DecodeError
EmptyEncodedString
mask6 :: Word8 -> Word8
mask6 :: Word8 -> Word8
mask6 Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
63
mask5 :: Word8 -> Word8
mask5 :: Word8 -> Word8
mask5 Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
31
mask4 :: Word8 -> Word8
mask4 :: Word8 -> Word8
mask4 Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
15
isIndexedName1 :: Word8 -> Bool
isIndexedName1 :: Word8 -> Bool
isIndexedName1 Word8
w = Word8 -> Word8
mask6 Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
isIndexedName2 :: Word8 -> Bool
isIndexedName2 :: Word8 -> Bool
isIndexedName2 Word8
w = Word8 -> Word8
mask4 Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
isTableSizeUpdate :: Word8 -> Bool
isTableSizeUpdate :: Word8 -> Bool
isTableSizeUpdate Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xe0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20
isHuffman :: Word8 -> Bool
isHuffman :: Word8 -> Bool
isHuffman Word8
w = Word8
w Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
dropHuffman :: Word8 -> Word8
dropHuffman :: Word8 -> Word8
dropHuffman Word8
w = Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
7
decodeString :: Bool -> HuffmanDecoding -> ReadBuffer -> Int -> IO HeaderStuff
decodeString :: Bool -> HuffmanDecoding -> HuffmanDecoding
decodeString Bool
huff HuffmanDecoding
hufdec ReadBuffer
rbuf Int
len = do
Int
leftover <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
if Int
leftover Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len then
if Bool
huff then
HuffmanDecoding
hufdec ReadBuffer
rbuf Int
len
else
HuffmanDecoding
forall a. Readable a => a -> Int -> IO HeaderValue
extractByteString ReadBuffer
rbuf Int
len
else
DecodeError -> IO HeaderValue
forall e a. Exception e => e -> IO a
throwIO DecodeError
HeaderBlockTruncated
type = (TokenHeaderList, ValueTable)
toHeaderTable :: [(CI HeaderName,HeaderValue)] -> IO HeaderTable
[(CI HeaderValue, HeaderValue)]
kvs = do
IOArray Int (Maybe HeaderValue)
arr <- (Int, Int)
-> Maybe HeaderValue -> IO (IOArray Int (Maybe HeaderValue))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
IOA.newArray (Int
minTokenIx,Int
maxTokenIx) Maybe HeaderValue
forall a. Maybe a
Nothing
![TokenHeader]
tvs <- IOArray Int (Maybe HeaderValue) -> IO [TokenHeader]
conv IOArray Int (Maybe HeaderValue)
arr
ValueTable
tbl <- IOArray Int (Maybe HeaderValue) -> IO ValueTable
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
HeaderTable -> IO HeaderTable
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 Builder TokenHeader
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 = [TokenHeader] -> IO [TokenHeader]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TokenHeader] -> IO [TokenHeader])
-> [TokenHeader] -> IO [TokenHeader]
forall a b. (a -> b) -> a -> b
$ Builder TokenHeader -> [TokenHeader]
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 (CI HeaderValue -> HeaderValue
forall s. CI s -> s
foldedCase CI HeaderValue
k)
IOArray Int (Maybe HeaderValue)
-> Int -> Maybe HeaderValue -> IO ()
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) (HeaderValue -> Maybe HeaderValue
forall a. a -> Maybe a
Just HeaderValue
v)
let !tv :: TokenHeader
tv = (Token
t,HeaderValue
v)
!builder' :: Builder TokenHeader
builder' = Builder TokenHeader
builder Builder TokenHeader -> TokenHeader -> Builder TokenHeader
forall a. Builder a -> a -> Builder a
<< TokenHeader
tv
[(CI HeaderValue, HeaderValue)]
-> Builder TokenHeader -> IO [TokenHeader]
go [(CI HeaderValue, HeaderValue)]
xs Builder TokenHeader
builder'