packages feed

http2 3.0.1 → 3.0.2

raw patch · 4 files changed

+83/−41 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

ChangeLog.md view
@@ -1,3 +1,8 @@+## 3.0.2++* Skip inserting entries that do not fit in the encoding table+  (#28)[https://github.com/kazu-yamamoto/http2/pull/28]+ ## 3.0.1  * Including a necessary file for testing.
Network/HPACK/Table/Dynamic.hs view
@@ -222,7 +222,6 @@  -- | 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 @@     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 []
http2.cabal view
@@ -1,5 +1,5 @@ Name:                   http2-Version:                3.0.1+Version:                3.0.2 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3
test/HPACK/EncodeSpec.hs view
@@ -7,6 +7,8 @@ #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 @@ -14,45 +16,78 @@ 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 lens0 = 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 lens0 `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]