Merge PR #28

kazu-yamamoto · Jun 10, 2021 · 7b46da6 · 7b46da6
2 parents 6bcad0e + 598c1bb
commit 7b46da6
Show file tree

Hide file tree

Showing 2 changed files with 77 additions and 40 deletions.
diff --git a/Network/HPACK/Table/Dynamic.hs b/Network/HPACK/Table/Dynamic.hs
@@ -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
@@ -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 []

diff --git a/test/HPACK/EncodeSpec.hs b/test/HPACK/EncodeSpec.hs
@@ -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]