Test encoding with 0-size table

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]