diff --git a/Network/HPACK/Table.hs b/Network/HPACK/Table.hs --- a/Network/HPACK/Table.hs +++ b/Network/HPACK/Table.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TupleSections, CPP #-} +{-# OPTIONS_HADDOCK hide #-} module Network.HPACK.Table ( -- * dynamic table diff --git a/Network/HPACK/Table/Dynamic.hs b/Network/HPACK/Table/Dynamic.hs --- a/Network/HPACK/Table/Dynamic.hs +++ b/Network/HPACK/Table/Dynamic.hs @@ -228,6 +228,7 @@ -- | 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 diff --git a/http2.cabal b/http2.cabal --- a/http2.cabal +++ b/http2.cabal @@ -1,5 +1,5 @@ Name: http2 -Version: 1.6.4 +Version: 1.6.5 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -51,6 +51,7 @@ Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Network.HPACK + Network.HPACK.Table Network.HPACK.Token Network.HTTP2 Network.HTTP2.Priority @@ -68,7 +69,6 @@ Network.HPACK.HeaderBlock.Decode Network.HPACK.HeaderBlock.Encode Network.HPACK.HeaderBlock.Integer - Network.HPACK.Table Network.HPACK.Table.Dynamic Network.HPACK.Table.Entry Network.HPACK.Table.RevIndex @@ -112,12 +112,39 @@ HPACK.IntegerSpec HTTP2.FrameSpec HTTP2.PrioritySpec + Network.HPACK + Network.HPACK.Buffer + Network.HPACK.Builder + Network.HPACK.HeaderBlock + Network.HPACK.HeaderBlock.Decode + Network.HPACK.HeaderBlock.Encode + Network.HPACK.HeaderBlock.Integer + Network.HPACK.Huffman + Network.HPACK.Huffman.Bit + Network.HPACK.Huffman.Decode + Network.HPACK.Huffman.Encode + Network.HPACK.Huffman.Params + Network.HPACK.Huffman.Table + Network.HPACK.Huffman.Tree + Network.HPACK.Table + Network.HPACK.Table.Dynamic + Network.HPACK.Table.Entry + Network.HPACK.Table.RevIndex + Network.HPACK.Table.Static + Network.HPACK.Token + Network.HPACK.Types + Network.HTTP2.Decode + Network.HTTP2.Encode + Network.HTTP2.Priority + Network.HTTP2.Priority.PSQ + Network.HTTP2.Priority.Queue + Network.HTTP2.Types Build-Depends: base >= 4 && < 5 , array + , base16-bytestring , bytestring , case-insensitive , containers - , hex , hspec >= 1.3 , network-byte-order , psqueues @@ -133,16 +160,37 @@ Other-Modules: HPACKDecode HPACKSpec JSON + Network.HPACK + Network.HPACK.Buffer + Network.HPACK.Builder + Network.HPACK.HeaderBlock + Network.HPACK.HeaderBlock.Decode + Network.HPACK.HeaderBlock.Encode + Network.HPACK.HeaderBlock.Integer + Network.HPACK.Huffman + Network.HPACK.Huffman.Bit + Network.HPACK.Huffman.Decode + Network.HPACK.Huffman.Encode + Network.HPACK.Huffman.Params + Network.HPACK.Huffman.Table + Network.HPACK.Huffman.Tree + Network.HPACK.Table + Network.HPACK.Table.Dynamic + Network.HPACK.Table.Entry + Network.HPACK.Table.RevIndex + Network.HPACK.Table.Static + Network.HPACK.Token + Network.HPACK.Types Build-Depends: base >= 4 && < 5 , aeson , aeson-pretty , array + , base16-bytestring , bytestring , case-insensitive , containers , directory , filepath - , hex , hspec >= 1.3 , network-byte-order , text @@ -157,15 +205,16 @@ GHC-Options: -Wall Main-Is: Spec.hs Other-Modules: Case + FrameSpec JSON Build-Depends: base >= 4 && < 5 , Glob >= 0.9 , aeson , aeson-pretty + , base16-bytestring , bytestring , directory , filepath - , hex , hspec >= 1.3 , http2 , network-byte-order @@ -176,7 +225,7 @@ Executable hpack-encode Default-Language: Haskell2010 - HS-Source-Dirs: test-hpack, . + HS-Source-Dirs: test-hpack GHC-Options: -Wall if flag(devel) Buildable: True @@ -184,14 +233,16 @@ Buildable: False Main-Is: hpack-encode.hs Other-Modules: HPACKEncode + JSON Build-Depends: base >= 4 && < 5 , aeson , aeson-pretty , array + , base16-bytestring , bytestring , case-insensitive , containers - , hex + , http2 , network-byte-order , text , unordered-containers @@ -200,20 +251,23 @@ Executable hpack-debug Default-Language: Haskell2010 - HS-Source-Dirs: test-hpack, . + HS-Source-Dirs: test-hpack GHC-Options: -Wall if flag(devel) Buildable: True else Buildable: False Main-Is: hpack-debug.hs + Other-Modules: HPACKDecode + JSON Build-Depends: base >= 4 && < 5 , aeson , array + , base16-bytestring , bytestring , case-insensitive , containers - , hex + , http2 , network-byte-order , text , unordered-containers @@ -222,13 +276,14 @@ Executable hpack-stat Default-Language: Haskell2010 - HS-Source-Dirs: test-hpack, . + HS-Source-Dirs: test-hpack GHC-Options: -Wall if flag(devel) Buildable: True else Buildable: False Main-Is: hpack-stat.hs + Other-Modules: JSON Build-Depends: base >= 4 && < 5 , aeson , aeson-pretty @@ -238,6 +293,7 @@ , containers , directory , filepath + , http2 , network-byte-order , text , unordered-containers @@ -258,8 +314,8 @@ Build-Depends: base >= 4 && < 5 , aeson , aeson-pretty + , base16-bytestring , bytestring - , hex , http2 , text , unordered-containers @@ -267,7 +323,7 @@ Benchmark priority Type: exitcode-stdio-1.0 Default-Language: Haskell2010 - Hs-Source-Dirs: bench-priority, . + Hs-Source-Dirs: bench-priority Ghc-Options: -Wall Main-Is: Main.hs Other-Modules: BinaryHeap @@ -291,7 +347,7 @@ Benchmark header-compression Type: exitcode-stdio-1.0 Default-Language: Haskell2010 - Hs-Source-Dirs: bench-hpack, . + Hs-Source-Dirs: bench-hpack Ghc-Options: -Wall Main-Is: Main.hs Build-Depends: base diff --git a/test-frame/Case.hs b/test-frame/Case.hs --- a/test-frame/Case.hs +++ b/test-frame/Case.hs @@ -6,8 +6,7 @@ import Control.Applicative ((<$>)) #endif import Data.ByteString (ByteString) -import Data.Hex -import Data.Maybe (fromJust) +import qualified Data.ByteString.Base16 as B16 import JSON import Network.HTTP2 @@ -34,7 +33,7 @@ } where frame = encodeFrame cs_encodeinfo cs_payload - wire = hex frame + wire = B16.encode frame wireToCase :: CaseWire -> Case wireToCase CaseWire { wire_error = Nothing, ..} = Case { @@ -45,7 +44,7 @@ } where -- fromJust is unsafe - frm = case decodeFrame defaultSettings $ fromJust $ unhex wire_hex of + frm = case decodeFrame defaultSettings $ fst $ B16.decode wire_hex of Left e -> error $ show e Right r -> r wireToCase CaseWire { wire_error = Just e, ..} = Case { diff --git a/test-frame/FrameSpec.hs b/test-frame/FrameSpec.hs new file mode 100644 --- /dev/null +++ b/test-frame/FrameSpec.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE CPP #-} + +module FrameSpec where + +#if __GLASGOW_HASKELL__ < 709 +import Control.Applicative ((<$>)) +#endif +import Control.Monad (forM_) +import Data.Aeson (eitherDecode) +import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Lazy as BL +import Network.HTTP2 +import System.FilePath.Glob (compile, globDir) +import Test.Hspec + +import JSON + +testDir :: FilePath +testDir = "test-frame/http2-frame-test-case" + +getTestFiles :: FilePath -> IO [FilePath] +getTestFiles dir = head <$> globDir [compile "*/*.json"] dir + +check :: FilePath -> IO () +check file = do + bs <- BL.readFile file + let etc = eitherDecode bs :: Either String Case + case etc of + Left _ -> putStrLn $ "JSON error: " ++ file + Right tc -> do + let bin = fst $ B16.decode $ wire tc + erc = decodeFrame defaultSettings bin + case erc of + Left h2err -> case err tc of + Nothing -> do + putStrLn file -- fixme + print h2err + Just errs -> do + let e = fromErrorCodeId $ errorCodeId h2err + errs `shouldContain` [e] + Right frm -> do + case frame tc of + Just fp -> do + fpFrame fp `shouldBe` frm + let einfo = EncodeInfo { + encodeFlags = flags $ frameHeader $ fpFrame fp + , encodeStreamId = streamId (frameHeader frm) + , encodePadding = unPad <$> fpPad fp + } + payload = framePayload frm + encodeFrame einfo payload `shouldBe` bin + Nothing -> putStrLn file -- fixme + +spec :: Spec +spec = do + describe "decodeFrame and encodeFrame" $ do + it "decodes test cases well" $ do + files <- getTestFiles testDir + forM_ files check diff --git a/test-hpack/HPACKDecode.hs b/test-hpack/HPACKDecode.hs --- a/test-hpack/HPACKDecode.hs +++ b/test-hpack/HPACKDecode.hs @@ -13,8 +13,8 @@ #endif import Control.Exception import Control.Monad (when) +import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Char8 as B8 -import Data.Hex import Data.List (sort) import Network.HPACK import Network.HPACK.Table @@ -74,7 +74,7 @@ return $ Just $ "Headers are different in " ++ B8.unpack wirehex ++ ":\n" ++ show hs ++ "\n" ++ show hs' where wirehex = wire c - Just inp = unhex wirehex + inp = fst $ B16.decode wirehex hs = headers c -- | Printing 'HeaderList'. diff --git a/test-hpack/HPACKEncode.hs b/test-hpack/HPACKEncode.hs --- a/test-hpack/HPACKEncode.hs +++ b/test-hpack/HPACKEncode.hs @@ -9,9 +9,9 @@ import Control.Monad (when) import Data.ByteString (ByteString) +import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Char8 as C8 import Data.Char -import Data.Hex import Network.HPACK import Network.HPACK.Table @@ -46,7 +46,7 @@ -> IO ByteString test conf c dyntbl = do out <- enc conf dyntbl hs - let hex' = hex out + let hex' = B16.encode out when (debug conf) $ do putStrLn "---- Output context" printDynamicTable dyntbl diff --git a/test/HPACK/DecodeSpec.hs b/test/HPACK/DecodeSpec.hs --- a/test/HPACK/DecodeSpec.hs +++ b/test/HPACK/DecodeSpec.hs @@ -27,6 +27,10 @@ h2 `shouldBe` d62h h3 <- decodeHeader dyntabl d63b h3 `shouldBe` d63h + it "decodes HeaderList in response (deny max table size update to 0)" $ + withDynamicTableForDecoding 256 4096 $ \dyntabl -> do + h1 <- decodeHeader dyntabl d81b + h1 `shouldBe` d81h it "decodes HeaderList even if an entry is larger than DynamicTable" $ withDynamicTableForEncoding 64 $ \etbl -> withDynamicTableForDecoding 64 4096 $ \dtbl -> do diff --git a/test/HPACK/HeaderBlock.hs b/test/HPACK/HeaderBlock.hs --- a/test/HPACK/HeaderBlock.hs +++ b/test/HPACK/HeaderBlock.hs @@ -3,12 +3,11 @@ module HPACK.HeaderBlock where import Data.ByteString (ByteString) -import Data.Hex -import Data.Maybe (fromJust) +import Data.ByteString.Base16 import Network.HPACK.Types fromHexString :: ByteString -> ByteString -fromHexString = fromJust . unhex +fromHexString = fst . decode ---------------------------------------------------------------- @@ -75,3 +74,17 @@ d63b :: ByteString d63b = fromHexString "88c16196d07abe941054d444a8200595040b8166e084a62d1bffc05a839bd9ab77ad94e7821dd7f2e6c7b335dfdfcd5b3960d5af27087f3672c1ab270fb5291f9587316065c003ed4ee5b1063d5007" + +---------------------------------------------------------------- + +d81h :: HeaderList +d81h = [(":status","403") + ,("server","nginx/1.14.0") + ,("date","Wed, 13 Feb 2019 14:57:11 GMT") + ,("content-type","text/html") + ,("content-length","169") + ] + +d81b :: ByteString +d81b = fromHexString "2048033430337689aa6355e580ae1697076196e4593e940b2a612c6a08017d40b571b76e042a62d1bf5f87497ca589d34d1f5c03313639" + diff --git a/test/HPACK/HuffmanSpec.hs b/test/HPACK/HuffmanSpec.hs --- a/test/HPACK/HuffmanSpec.hs +++ b/test/HPACK/HuffmanSpec.hs @@ -6,10 +6,9 @@ import Control.Applicative ((<$>)) #endif import Data.ByteString (ByteString) +import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Char8 as BS import Data.Char (toLower) -import Data.Hex -import Data.Maybe (fromJust) import Network.HPACK import Network.HPACK.Huffman import Test.Hspec @@ -32,16 +31,16 @@ shouldBeEncoded :: ByteString -> ByteString -> Expectation shouldBeEncoded inp out = do - out' <- BS.map toLower . hex <$> encodeHuffman inp + out' <- BS.map toLower . B16.encode <$> encodeHuffman inp out' `shouldBe` out shouldBeDecoded :: ByteString -> ByteString -> Expectation shouldBeDecoded inp out = do - out' <- decodeHuffman $ fromJust $ unhex inp + out' <- decodeHuffman $ fst $ B16.decode inp out' `shouldBe` out tryDecode :: ByteString -> IO ByteString -tryDecode inp = decodeHuffman $ fromJust $ unhex inp +tryDecode inp = decodeHuffman $ fst $ B16.decode inp spec :: Spec spec = do