Skip to content

Commit

Permalink
Merge PR #28
Browse files Browse the repository at this point in the history
  • Loading branch information
kazu-yamamoto committed Jun 10, 2021
2 parents 6bcad0e + 598c1bb commit 7b46da6
Show file tree
Hide file tree
Showing 2 changed files with 77 additions and 40 deletions.
20 changes: 11 additions & 9 deletions Network/HPACK/Table/Dynamic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -222,7 +222,6 @@ newDynamicTable maxsiz info = do

-- | Renewing 'DynamicTable' with necessary entries copied.
renewDynamicTable :: Size -> DynamicTable -> IO ()
renewDynamicTable 0 _ = return () -- FIXME: handle case 'Max table size = 0'.
renewDynamicTable maxsiz dyntbl@DynamicTable{..} = do
renew <- shouldRenew dyntbl maxsiz
when renew $ do
Expand Down Expand Up @@ -309,14 +308,17 @@ insertFront e DynamicTable{..} = do
table <- readIORef circularTable
let i = off
dsize' = dsize + entrySize e
off' <- adj maxN (off - 1)
unsafeWrite table i e
writeIORef offset off'
writeIORef numOfEntries $ n + 1
writeIORef dynamicTableSize dsize'
case codeInfo of
EncodeInfo rev _ -> insertRevIndex e (DIndex i) rev
_ -> return ()
if maxN == 0
then return ()
else do
off' <- adj maxN (off - 1)
unsafeWrite table i e
writeIORef offset off'
writeIORef numOfEntries $ n + 1
writeIORef dynamicTableSize dsize'
case codeInfo of
EncodeInfo rev _ -> insertRevIndex e (DIndex i) rev
_ -> return ()

adjustTableSize :: DynamicTable -> IO [Entry]
adjustTableSize dyntbl@DynamicTable{..} = adjust []
Expand Down
97 changes: 66 additions & 31 deletions test/HPACK/EncodeSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,52 +7,87 @@ import Control.Applicative ((<$>))
#endif
import qualified Control.Exception as E
import qualified Data.ByteString as BS
import Data.Bits
import Data.Maybe (fromMaybe)
import Network.HPACK
import Test.Hspec

spec :: Spec
spec = do
describe "encodeHeader and decodeHeader" $ do
it "works for Naive" $
run EncodeStrategy {compressionAlgo = Naive, useHuffman = False} []
run Nothing EncodeStrategy {compressionAlgo = Naive, useHuffman = False} []
it "works for NaiveH" $
run EncodeStrategy {compressionAlgo = Naive, useHuffman = True} []
run Nothing EncodeStrategy {compressionAlgo = Naive, useHuffman = True} []
it "works for Static" $
run EncodeStrategy {compressionAlgo = Static, useHuffman = False} []
run Nothing EncodeStrategy {compressionAlgo = Static, useHuffman = False} []
it "works for StaticH" $
run EncodeStrategy {compressionAlgo = Static, useHuffman = True} []
run Nothing EncodeStrategy {compressionAlgo = Static, useHuffman = True} []
it "works for Linear" $
run EncodeStrategy {compressionAlgo = Linear, useHuffman = False} [] -- linearLens
run Nothing EncodeStrategy {compressionAlgo = Linear, useHuffman = False} [] -- linearLens
it "works for LinearH" $
run EncodeStrategy {compressionAlgo = Linear, useHuffman = True} []
run Nothing EncodeStrategy {compressionAlgo = Linear, useHuffman = True} []
describe "encodeHeader with a 0-size table" $ do
it "works for Linear" $
run (Just 0) EncodeStrategy {compressionAlgo = Linear, useHuffman = False} []
it "does not use indexed fields" $ do
runNotIndexed EncodeStrategy {compressionAlgo = Linear, useHuffman = False}

run :: EncodeStrategy -> [Int] -> Expectation
run stgy lens = do
run :: Maybe Int -> EncodeStrategy -> [Int] -> Expectation
run msz stgy lens = do
let sz = fromMaybe defaultDynamicTableSize msz
hdrs <- read <$> readFile "bench-hpack/headers.hs"
withDynamicTableForEncoding defaultDynamicTableSize $ \etbl ->
withDynamicTableForDecoding defaultDynamicTableSize 4096 $ \dtbl ->
go etbl dtbl stgy hdrs lens `shouldReturn` True
withDynamicTableForEncoding sz $ \etbl ->
withDynamicTableForDecoding sz 4096 $ \dtbl ->
go etbl dtbl hdrs lens `shouldReturn` True
where
go :: DynamicTable -> DynamicTable -> [HeaderList] -> [Int] -> IO Bool
go _ _ [] _ = return True
go etbl dtbl (h:hs) lens = do
bs <- encodeHeader stgy 4096 etbl h `E.catch` \(E.SomeException e) -> do
putStrLn $ "encodeHeader: " ++ show e
print h
E.throwIO e
lens' <- case lens of
l:ls
| BS.length bs == l -> return ls
| otherwise -> error $ "The length of encoded headers should be " ++ show l ++ " but " ++ show (BS.length bs)
[] -> return []
h' <- decodeHeader dtbl bs `E.catch` \(E.SomeException e) -> do
putStrLn $ "decodeHeader: " ++ show e
print h
E.throwIO e
if h == h' then
go etbl dtbl hs lens'
else do
return False

go :: DynamicTable -> DynamicTable -> EncodeStrategy -> [HeaderList] -> [Int] -> IO Bool
go _ _ _ [] _ = return True
go etbl dtbl stgy (h:hs) lens = do
bs <- encodeHeader stgy 4096 etbl h `E.catch` \(E.SomeException e) -> do
putStrLn $ "encodeHeader: " ++ show e
print h
E.throwIO e
lens' <- case lens of
l:ls
| BS.length bs == l -> return ls
| otherwise -> error $ "The length of encoded headers should be " ++ show l ++ " but " ++ show (BS.length bs)
[] -> return []
h' <- decodeHeader dtbl bs `E.catch` \(E.SomeException e) -> do
putStrLn $ "decodeHeader: " ++ show e
print h
E.throwIO e
if h == h' then
go etbl dtbl stgy hs lens'
else do
return False
runNotIndexed :: EncodeStrategy -> Expectation
runNotIndexed stgy = do
hdrs <- read <$> readFile "bench-hpack/headers.hs"
withDynamicTableForEncoding 0 $ \etbl ->
withDynamicTableForDecoding 0 4096 $ \dtbl ->
mapM_ (go etbl dtbl) (hdrs :: [HeaderList])
where
go etbl dtbl h = do
print h
bs <- encodeHeader stgy 4096 etbl h `E.catch` \(E.SomeException e) -> do
putStrLn $ "encodeHeader: " ++ show e
print h
E.throwIO e
findIndexed bs `shouldBe` False

-- check whether indexed fields are used (HPACK spec 6.1)
findIndexed :: BS.ByteString -> Bool
findIndexed = go . BS.unpack
where
go [] = False
go (b : bs)
| testBit b 7 = if clearBit b 7 <= 61 then go bs else True
| b == 0x40 || b == 0 = go (skip (skip bs))
| otherwise = go (skip bs)
skip (b : bs) = drop (fromIntegral (clearBit b 7)) bs
skip [] = []

{- fixme: form where these values come?
linearLens :: [Int]
Expand Down

0 comments on commit 7b46da6

Please sign in to comment.