http3-0.1.6: test/QPACK/HeaderBlockSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module QPACK.HeaderBlockSpec where
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
import Data.IORef
import Data.Maybe (isNothing)
import Network.HPACK.Token (toToken)
import Network.QPACK
import Network.QPACK.Internal (
DecoderInstruction (..),
EncoderInstruction (..),
encodeDecoderInstructions,
encodeEncoderInstructions,
)
import System.Timeout (timeout)
import Test.Hspec
spec :: Spec
spec = do
describe "field section round trip" $ do
it "decodes a header value larger than the decoder's scratch buffer" $ do
-- The scratch buffer for Huffman decoding used to be a fixed 2048
-- octets, so a value above that failed to decode however small the
-- section carrying it was: 2100 octets here comes to well under
-- 1.4K encoded, far inside the SETTINGS_MAX_FIELD_SECTION_SIZE we
-- advertise.
mapM_ roundTrip [1000, 2100, 8000, 20000]
it "encodes a field larger than the encoder's buffers" $ do
-- With the default 4096-octet buffers. 4083 is the value that
-- makes the field come to exactly the buffer by the encoder's
-- estimate, which used to loop forever; anything larger was
-- refused with BufferOverrun. 100000 is also long enough for
-- its Huffman code to need a four-octet length.
forM_ [4083, 4084, 10000, 100000] $ \n -> do
r <- timeout 5000000 $ roundTripWith defaultQEncoderConfig n
void r `shouldBe` Just ()
it "agrees with the decoder on MaxEntries when the encoder uses less" $ do
-- The decoder offers 64K, the encoder settles for 4K. Required
-- Insert Count is encoded against the 64K both ends know about;
-- encoding it against the 4K made the two ends disagree once
-- 2*128 entries had been inserted.
roundTripMany 4096 65536 600
it "does not refer to an unacknowledged entry when blocking is not allowed" $ do
-- SETTINGS_QPACK_BLOCKED_STREAMS is 0, and no acknowledgement
-- ever arrives: every section has to be decodable with what the
-- decoder is known to hold, i.e. Required Insert Count 0. The
-- third one used to refer to the entry the second one inserted.
(enc, _, tblop) <- newQEncoder defaultQEncoderConfig (\_ -> return ())
setCapacity tblop 4096
setBlockedStreams tblop 0
forM_ [0 .. 4] $ \i -> do
blk <- enc (i * 4) [(toToken "x-foo", "bar")]
encodedInsertCount blk `shouldBe` 0
it "keeps the number of blocked streams within the decoder's limit" $ do
-- One blocked stream allowed, and nothing is ever acknowledged, so
-- every section that refers to the dynamic table is blocked: at
-- most one of them may do so.
(enc, _, tblop) <- newQEncoder defaultQEncoderConfig (\_ -> return ())
setCapacity tblop 4096
setBlockedStreams tblop 1
blks <- forM [0 .. 29] $ \i -> do
let hdr = [(toToken "x-foo", C8.pack (show (i `div` 3 :: Int)))]
enc (i * 4) hdr
length (filter ((/= 0) . encodedInsertCount) blks) `shouldSatisfy` (<= 1)
it "takes two outstanding sections on one stream one at a time" $ do
-- Headers and trailers on the same stream, both referring to the
-- dynamic table and so both acknowledged. The second used to
-- replace the first, and the second acknowledgement then found
-- nothing and was taken for a decoder stream error.
eiRef <- newIORef []
diRef <- newIORef []
let save ref bs = modifyIORef' ref (++ [bs])
(enc, handleDI, tblop) <- newQEncoder defaultQEncoderConfig (save eiRef)
(dec, handleEI) <- newQDecoder defaultQDecoderConfig (save diRef)
setCapacity tblop 4096
setBlockedStreams tblop 100
let hdr = [(toToken "x-foo", "bar")]
exchange sid = do
blk <- enc sid hdr
drain eiRef handleEI
(ths, _) <- dec sid blk
ths `shouldBe` hdr
return blk
-- Get the field into the table and acknowledged.
forM_ [0, 4, 8] $ \sid -> exchange sid >> drain diRef handleDI
blk1 <- exchange 12
blk2 <- exchange 12
map encodedInsertCount [blk1, blk2] `shouldSatisfy` all (/= 0)
drain diRef handleDI
it "keeps the decoder's entries across a change of capacity" $ do
-- The encoder may change the capacity at any time. The decoder
-- used to reallocate its table when told, so the entry inserted
-- before the change was gone when referred to after it.
eiRef <- newIORef []
(dec, handleEI) <- newQDecoder defaultQDecoderConfig (\_ -> return ())
ins <-
encodeEncoderInstructions
[ SetDynamicTableCapacity 4096
, InsertWithLiteralName (toToken "x-foo") "bar"
, SetDynamicTableCapacity 2048
]
False
writeIORef eiRef [ins]
drain eiRef handleEI
-- Required Insert Count 1 (encoded as 2 against 128 entries),
-- Delta Base 0, then an indexed field line for relative index 0.
(ths, _) <- dec 0 $ BS.pack [0x02, 0x00, 0x80]
ths `shouldBe` [(toToken "x-foo", "bar")]
it "stops counting a blocked stream whose wait is given up" $ do
-- One blocked stream allowed. A section waiting for an entry
-- that has not arrived is abandoned, as when its stream is reset.
-- The stream it was counted as used to stay counted, and the next
-- section that had to wait was refused as one too many.
eiRef <- newIORef []
(dec, handleEI) <-
newQDecoder defaultQDecoderConfig{dcBlockedSterams = 1} (\_ -> return ())
-- Required Insert Count 1, Delta Base 0, then an indexed field
-- line for relative index 0: the first entry, not inserted yet.
let blk = BS.pack [0x02, 0x00, 0x80]
withAsync (dec 0 blk) $ \a -> do
threadDelay 100000
poll a >>= (`shouldSatisfy` isNothing)
withAsync (dec 4 blk) $ \a -> do
threadDelay 100000
poll a >>= (`shouldSatisfy` isNothing)
ins <-
encodeEncoderInstructions
[ SetDynamicTableCapacity 4096
, InsertWithLiteralName (toToken "x-foo") "bar"
]
False
writeIORef eiRef [ins]
drain eiRef handleEI
(ths, _) <- wait a
ths `shouldBe` [(toToken "x-foo", "bar")]
it "evicts an entry nothing refers to once its insertion is acknowledged" $ do
-- No stream may block, and nothing is acknowledged at first, so
-- every entry is inserted without being referred to. Such an
-- entry used to be kept for good, and once the table was full
-- nothing new went in.
eiRef <- newIORef []
diRef <- newIORef []
(enc, handleDI, tblop) <-
newQEncoder defaultQEncoderConfig (\bs -> modifyIORef' eiRef (++ [bs]))
setCapacity tblop 256
setBlockedStreams tblop 0
let inserts i = do
writeIORef eiRef []
-- Twice, since a field is only inserted the second time
-- it is seen.
forM_ [0, 1] $ \j ->
enc ((i * 2 + j) * 4) [(toToken (C8.pack ("x-foo-" ++ show i)), "a")]
any (not . BS.null) <$> readIORef eiRef
-- 40 octets each: six fit in 256.
mapM inserts [0 .. 5] `shouldReturn` replicate 6 True
-- Full, and none of them acknowledged, so none is evictable.
inserts 6 `shouldReturn` False
di <- encodeDecoderInstructions [InsertCountIncrement 6]
writeIORef diRef [di]
drain diRef handleDI
inserts 7 `shouldReturn` True
it "releases the sections of a stream the decoder cancels" $ do
-- One blocked stream allowed, and nothing acknowledged. Stream 4
-- takes it, so stream 8 may not refer to the entry. Once the
-- decoder cancels stream 4, stream 12 may. The cancellation used
-- to be ignored, and stream 4 stayed blocked for good.
diRef <- newIORef []
(enc, handleDI, tblop) <- newQEncoder defaultQEncoderConfig (\_ -> return ())
setCapacity tblop 4096
setBlockedStreams tblop 1
let hdr = [(toToken "x-foo", "bar")]
-- Inserted the second time it is seen.
_ <- enc 0 hdr
enc 4 hdr >>= (`shouldSatisfy` (/= 0)) . encodedInsertCount
enc 8 hdr >>= (`shouldBe` 0) . encodedInsertCount
di <- encodeDecoderInstructions [StreamCancellation 4]
writeIORef diRef [di]
drain diRef handleDI
enc 12 hdr >>= (`shouldSatisfy` (/= 0)) . encodedInsertCount
it "refuses a section that decodes to more than the announced limit" $ do
-- A field line of one octet refers to a 1037-octet entry, so a
-- section of a few octets decodes to far more than its length.
-- Only the length of the frame used to be capped.
eiRef <- newIORef []
(dec, handleEI) <-
newQDecoder
defaultQDecoderConfig{dcMaxFieldSectionSize = 2000}
(\_ -> return ())
ins <-
encodeEncoderInstructions
[ SetDynamicTableCapacity 4096
, InsertWithLiteralName (toToken "x-foo") (C8.replicate 1000 'a')
]
False
writeIORef eiRef [ins]
drain eiRef handleEI
-- Required Insert Count 1, Delta Base 0, then indexed field
-- lines for relative index 0: once, and then twice.
(ths, _) <- dec 0 $ BS.pack [0x02, 0x00, 0x80]
map fst ths `shouldBe` [toToken "x-foo"]
dec 4 (BS.pack [0x02, 0x00, 0x80, 0x80])
`shouldThrow` (== FieldSectionTooLarge)
it "inserts with a reference to a name not yet acknowledged" $ do
-- No stream may block, and nothing is acknowledged. x-foo is in
-- the table, unacknowledged, so a field line may not refer to it;
-- but an insertion may, on the encoder stream, and x-foo: b is
-- inserted so. The encoder used to give that up and insert
-- nothing, since it guarded the insertion as though it were a
-- field line.
eiRef <- newIORef []
(enc, _, tblop) <-
newQEncoder defaultQEncoderConfig (\bs -> modifyIORef' eiRef (++ [bs]))
(dec, handleEI) <- newQDecoder defaultQDecoderConfig (\_ -> return ())
setCapacity tblop 4096
setBlockedStreams tblop 0
let hdr v = [(toToken "x-foo", v)]
-- Twice each, since a field is only inserted the second time it
-- is seen.
blks1 <- forM [0, 4] $ \sid -> enc sid (hdr "a")
eis1 <- readIORef eiRef
writeIORef eiRef []
blks2 <- forM [8, 12] $ \sid -> enc sid (hdr "b")
eis2 <- readIORef eiRef
BS.concat eis2 `shouldSatisfy` (not . BS.null)
-- And what went out still decodes.
eiQ <- newIORef [BS.concat (eis1 ++ eis2)]
drain eiQ handleEI
forM_ (zip [0, 4, 8, 12] (blks1 ++ blks2)) $ \(sid, blk) -> do
encodedInsertCount blk `shouldBe` 0
(ths, _) <- dec sid blk
ths `shouldSatisfy` (`elem` [hdr "a", hdr "b"])
it "refuses a section more than the peer will take" $ do
-- RFC 9114, section 4.2.2: "SHOULD NOT send". The peer's limit
-- used to be kept and never looked at. Refused before anything
-- is inserted, so the encoder stream carries nothing.
eiRef <- newIORef []
(enc, _, tblop) <-
newQEncoder defaultQEncoderConfig (\bs -> modifyIORef' eiRef (++ [bs]))
setCapacity tblop 4096
setHeaderSize tblop 100
writeIORef eiRef []
-- 5 + 100 + 32 octets as the limit counts them.
enc 0 [(toToken "x-foo", C8.replicate 100 'a')]
`shouldThrow` (== FieldSectionTooLargeForPeer 137 100)
BS.concat <$> readIORef eiRef `shouldReturn` ""
void $ enc 4 [(toToken "x-foo", "bar")]
-- | Feeding an instruction handler what has been queued for it, then an end
-- of stream, so that it returns -- or throws -- here.
drain :: IORef [BS.ByteString] -> ((Int -> IO BS.ByteString) -> IO ()) -> IO ()
drain ref handler = do
bss <- readIORef ref
writeIORef ref []
queue <- newIORef [BS.concat bss]
handler $ \_ -> atomicModifyIORef' queue $ \xs -> case xs of
[] -> ([], "")
y : ys -> (ys, y)
roundTrip :: Int -> IO ()
roundTrip n = do
blk <- roundTripWith defaultQEncoderConfig{ecHeaderBlockBufferSize = 262144} n
-- The encoded section stays well under the announced limit; it is only
-- the decoded value that is large.
BS.length blk `shouldSatisfy` (< dcMaxFieldSectionSize defaultQDecoderConfig)
-- | Encoding and decoding a field with an n-octet value; the encoded field
-- section is returned.
roundTripWith :: QEncoderConfig -> Int -> IO BS.ByteString
roundTripWith conf n = do
(enc, _, _) <- newQEncoder conf (\_ -> return ())
-- Room for the largest field here, which the default limit on a field
-- section is not.
(dec, _) <-
newQDecoder
defaultQDecoderConfig{dcMaxFieldSectionSize = 1000000}
(\_ -> return ())
let val = C8.replicate n 'a'
blk <- enc 0 [(toToken ":status", "200"), (toToken "x-big", val)]
(ths, _) <- dec 0 blk
lookup (toToken "x-big") ths `shouldBe` Just val
return blk
roundTripMany :: Int -> Int -> Int -> IO ()
roundTripMany encCap decCap n = do
eiQ <- newTQueueIO
diQ <- newTQueueIO
(enc, handleDI, tblop) <-
newQEncoder
defaultQEncoderConfig{ecMaxTableCapacity = encCap}
(atomically . writeTQueue eiQ)
(dec, handleEI) <-
newQDecoder
defaultQDecoderConfig{dcMaxTableCapacity = decCap}
(atomically . writeTQueue diQ)
-- What the decoder's SETTINGS would carry.
setCapacity tblop decCap
setBlockedStreams tblop 100
let recvFrom q _ = atomically $ readTQueue q
ricMax <- newIORef 0
withAsync (handleEI $ recvFrom eiQ) $ \_ ->
withAsync (handleDI $ recvFrom diQ) $ \_ ->
forM_ [0 .. n - 1] $ \i -> do
-- Twice each, since a field is only inserted the second
-- time it is seen.
forM_ [0, 1] $ \j -> do
let sid = (i * 2 + j) * 4
hdr = [(toToken "x-count", C8.pack (show i))]
blk <- enc sid hdr
modifyIORef' ricMax (max (encodedInsertCount blk))
(ths, _) <- dec sid blk
ths `shouldBe` hdr
-- Let acknowledgements reach the encoder, so that
-- entries can be evicted and inserting goes on.
atomically $ isEmptyTQueue diQ >>= check
-- Our own decoder would accept either reading of MaxEntries as long as
-- the encoder used the same one, so look at the prefix itself: against
-- the decoder's 2048 entries nothing here wraps, and the encoded count
-- goes past what 2*128 would have allowed.
readIORef ricMax >>= (`shouldSatisfy` (> 2 * (encCap `div` 32)))
-- | The encoded Required Insert Count: an integer with an 8-bit prefix.
encodedInsertCount :: BS.ByteString -> Int
encodedInsertCount blk = case BS.unpack blk of
w : ws
| w < 255 -> fromIntegral w
| otherwise -> 255 + go 0 0 ws
[] -> 0
where
go acc sh (x : xs)
| x < 128 = acc + fromIntegral x * 2 ^ (sh :: Int)
| otherwise = go (acc + fromIntegral (x - 128) * 2 ^ sh) (sh + 7) xs
go acc _ [] = acc