http3 0.1.4 → 0.1.5

raw patch · 22 files changed

+621/−99 lines, 22 filesdep ~http2PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: http2

API changes (from Hackage documentation)

Files

• ChangeLog.md +17/−0
• Network/HTTP3/Client.hs +3/−6
• Network/HTTP3/Context.hs +21/−6
• Network/HTTP3/Control.hs +46/−13
• Network/HTTP3/Error.hs +17/−0
• Network/HTTP3/Frame.hs +59/−14
• Network/HTTP3/Recv.hs +58/−12
• Network/HTTP3/Server.hs +36/−21
• Network/HTTP3/Settings.hs +13/−2
• Network/QPACK.hs +1/−1
• Network/QPACK/Error.hs +2/−0
• Network/QPACK/HeaderBlock/Decode.hs +27/−14
• Network/QPACK/Table/Dynamic.hs +23/−2
• Network/QPACK/Table/Static.hs +5/−1
• http3.cabal +4/−2
• test/HTTP3/Error.hs +123/−2
• test/HTTP3/ErrorSpec.hs +10/−2
• test/HTTP3/FrameSpec.hs +45/−0
• test/HTTP3/Server.hs +32/−1
• test/HTTP3/ServerSpec.hs +27/−0
• test/QPACK/HeaderBlockSpec.hs +35/−0
• test/QPACK/TableSpec.hs +17/−0

@@ -1,5 +1,22 @@ # Revision history for http3 +## 0.1.5++* Security fixes.  Requiring http2 v5.4.5, whose HPACK integer decoder is+  bounded; QPACK decodes its integers with it.+* Refusing a QPACK index that names nothing, at both ends of both tables.+* Putting a ceiling on the frame payload we will hold.+* Sizing the Huffman scratch buffer to what it has to hold.+* Reading a unidirectional stream type as the variable-length integer it is.+* Not handing the application a request we have already rejected.+* Checking a message against the content-length it declared.+* Reading the whole SETTINGS frame, noticing a repeated identifier, and+  refusing one that stops mid-parameter.+* Giving the application the peer's address, not our own.+* This is a patch release, but `Network.HTTP3.Internal` and+  `Network.QPACK.Internal` changed: `parseH3Frame` takes the payload limit,+  `IFrame` has `ITooLong`, and `DecodeError` has `IllegalDynamicIndex`.+ ## 0.1.4  * adding ecUseHuffman to defaultQEncoderConfig

@@ -48,7 +48,6 @@ import Network.HTTP3.Config import Network.HTTP3.Context import Network.HTTP3.Error-import Network.HTTP3.Frame import Network.HTTP3.Recv import Network.HTTP3.Send import Network.QPACK@@ -112,11 +111,9 @@                 threadDelay 100000                 -- just for type inference                 E.throwIO $ QUIC.ApplicationProtocolErrorIsSent H3MessageError ""-            Just vt -> do-                refI <- newIORef IInit-                refH <- newIORef Nothing-                let readB = recvBody ctx sid src refI refH-                    rsp = Response $ InpObj vt Nothing readB refH+            Just vt@(_, valtbl) -> do+                (readB, refH) <- newBodyReader ctx sid src valtbl+                let rsp = Response $ InpObj vt Nothing readB refH                 processResponse rsp   where     hdr = outObjHeaders outobj

@@ -19,6 +19,7 @@     Hooks (..), -- re-export     getMySockAddr,     getPeerSockAddr,+    getMaxFieldSectionSize,     forkManaged,     forkManagedTimeout,     forkManagedTimeoutFinally,@@ -27,7 +28,6 @@  import qualified Control.Exception as E import Control.Monad (void)-import qualified Data.ByteString as BS import Data.IORef import Network.HTTP.Semantics.Client import Network.QUIC@@ -52,6 +52,9 @@     , ctxHooks :: Hooks     , ctxMySockAddr :: SockAddr     , ctxPeerSockAddr :: SockAddr+    , ctxMaxFieldSectionSize :: Int+    -- ^ What we told the peer we would accept, and so the most of any one+    -- frame we are willing to hold in memory while it arrives.     }  withContext :: Connection -> Config -> (Context -> IO a) -> IO a@@ -65,7 +68,8 @@     (ctxQEncoder, handleDI, dyntblE) <- newQEncoder (confQEncoderConfig conf) sendEI     -- newQDecoder passes dyntbl for decoder to handleEI internally     (ctxQDecoder, handleEI) <- newQDecoder (confQDecoderConfig conf) sendDI-    ctl <- controlStream conn dyntblE <$> newIORef IInit+    let ctxMaxFieldSectionSize = dcMaxFieldSectionSize $ confQDecoderConfig conf+    ctl <- controlStream conn ctxMaxFieldSectionSize dyntblE <$> newIORef IInit     info <- getConnectionInfo conn     let handleDI' recv = handleDI recv `E.catch` abortWith QpackDecoderStreamError         handleEI' recv = handleEI recv `E.catch` abortWith QpackEncoderStreamError@@ -119,9 +123,17 @@  unidirectional :: Context -> Stream -> IO () unidirectional Context{..} strm = do-    w8 : _ <- BS.unpack <$> recvStream strm 1 -- fixme: variable length-    let typ = toH3StreamType $ fromIntegral w8-    ctxUniSwitch typ (recvStream strm)+    -- The type is a variable-length integer (RFC 9114, section 6.2), so one,+    -- two, four or eight octets -- not the single one it used to be read as,+    -- which cut anything from 0x40 up in half and handed the tail of the type+    -- to a handler as though it were the stream's contents.+    mtyp <- recvQInt (recvStream strm)+    case mtyp of+        -- The peer opened a unidirectional stream and closed it without+        -- saying what it was for.  Nothing to dispatch to; this used to be a+        -- pattern match failure.+        Nothing -> return ()+        Just i -> ctxUniSwitch (toH3StreamType i) (recvStream strm)  withHandle :: Context -> (T.Handle -> IO ()) -> IO () withHandle Context{..} action = void $ T.withHandle ctxThreadManager (return ()) action@@ -154,4 +166,7 @@ getMySockAddr = ctxMySockAddr  getPeerSockAddr :: Context -> SockAddr-getPeerSockAddr = ctxMySockAddr+getPeerSockAddr = ctxPeerSockAddr++getMaxFieldSectionSize :: Context -> Int+getMaxFieldSectionSize = ctxMaxFieldSectionSize

@@ -8,6 +8,8 @@  import qualified Data.ByteString as BS import Data.IORef+import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet import Network.QUIC  import Imports@@ -54,8 +56,8 @@  -- DynamicTable for Encoder controlStream-    :: Connection -> TableOperation -> IORef IFrame -> InstructionHandler-controlStream conn tblop ref recv = loop0+    :: Connection -> Int -> TableOperation -> IORef IFrame -> InstructionHandler+controlStream conn lim tblop ref recv = loop0   where     loop0 = do         bs <- recv 1024@@ -73,7 +75,17 @@                 readIORef ref >>= parse bs >>= writeIORef ref                 loop     parse0 bs st0 = do-        case parseH3Frame st0 bs of+        case parseH3Frame lim st0 bs of+            st1'+                -- DATA is the one frame the cap does not cover, and it has no+                -- business on a control stream, so refuse it before any of it+                -- is buffered rather than after.+                | Just H3FrameData <- frameTypeOf st1' -> do+                    abortConnection conn H3FrameUnexpected ""+                    return (False, IInit)+            ITooLong _ _ -> do+                abortConnection conn H3ExcessiveLoad ""+                return (False, IInit)             IDone typ payload leftover -> do                 case typ of                     H3FrameSettings -> checkSettings conn tblop payload@@ -83,7 +95,14 @@             st1 -> return (False, st1)      parse bs st0 = do-        case parseH3Frame st0 bs of+        case parseH3Frame lim st0 bs of+            st1'+                | Just H3FrameData <- frameTypeOf st1' -> do+                    abortConnection conn H3FrameUnexpected ""+                    return IInit+            ITooLong _ _ -> do+                abortConnection conn H3ExcessiveLoad ""+                return IInit             IDone typ _payload leftover -> do                 case typ of                     H3FrameCancelPush -> return ()@@ -98,18 +117,28 @@  checkSettings :: Connection -> TableOperation -> ByteString -> IO () checkSettings conn tblop payload = do-    h3settings <- decodeH3Settings payload-    loop (0 :: Int) h3settings+    mh3settings <- decodeH3Settings payload+    case mh3settings of+        -- RFC 9114 section 7.1: a payload that "terminates before the end of+        -- the identified fields MUST be treated as a connection error of type+        -- H3_FRAME_ERROR".+        Nothing -> abortConnection conn H3FrameError ""+        Just h3settings -> loop IntSet.empty h3settings   where+    loop :: IntSet -> H3Settings -> IO ()     loop _ [] = return ()-    loop flags ((k@(H3SettingsKey i), v) : ss)-        | flags `testBit` i = abortConnection conn H3SettingsError ""+    loop seen ((k@(H3SettingsKey i), v) : ss)+        -- RFC 9114 section 7.2.4.1 lets a receiver refuse a repeated setting+        -- identifier, and this does.  A set rather than bits in an Int:+        -- identifiers are variable-length integers, so everything from 64 up+        -- fell off the end of the word and could repeat unnoticed.+        | i `IntSet.member` seen = abortConnection conn H3SettingsError ""         | otherwise = do-            let flags' = flags `setBit` i+            let seen' = IntSet.insert i seen             case k of                 SettingsQpackMaxTableCapacity -> do                     setCapacity tblop v-                    loop flags' ss+                    loop seen' ss                 -- This value is not used yet.                 -- RFC 9114: "A server that receives a larger field                 -- section than it is willing to handle can send an@@ -117,11 +146,15 @@                 -- code ([RFC6585])."                 SettingsMaxFieldSectionSize -> do                     setHeaderSize tblop v-                    loop flags' ss+                    loop seen' ss                 SettingsQpackBlockedStreams -> do                     setBlockedStreams tblop v-                    loop flags' ss+                    loop seen' ss                 _                     -- HTTP/2 settings                     | i <= 0x6 -> abortConnection conn H3SettingsError ""-                    | otherwise -> return ()+                    -- Unknown, so ignored -- but the rest of the frame is+                    -- not.  This used to stop here, which meant a peer+                    -- following section 7.2.4.1's advice to send a reserved+                    -- identifier had every setting after it dropped.+                    | otherwise -> loop seen' ss

@@ -1,6 +1,7 @@ {-# LANGUAGE PatternSynonyms #-}  module Network.HTTP3.Error (+    ContentLengthMismatch (..),     ApplicationProtocolError (         H3NoError,         H3GeneralProtocolError,@@ -22,7 +23,23 @@     ), ) where +import qualified Control.Exception as E import Network.QUIC++-- | A message whose content does not match the content-length it declared.+--+-- RFC 9114 section 4.1.2 makes such a message malformed. The body reader+-- raises this rather than resetting anything itself: it has no stream to hand,+-- and the handler that wraps the application turns it into the+-- H3_MESSAGE_ERROR reset the spec asks for -- which also stops the application+-- working on a message the receiver has already rejected.+data ContentLengthMismatch = ContentLengthMismatch+    { declaredLength :: Int+    , actualLength :: Int+    }+    deriving (Eq, Show)++instance E.Exception ContentLengthMismatch  {- FOURMOLU_DISABLE -} pattern H3NoError                :: ApplicationProtocolError

@@ -11,8 +11,10 @@     decodeH3Frame,     IFrame (..),     parseH3Frame,+    frameTypeOf,     QInt (..),     parseQInt,+    recvQInt,     permittedInControlStream,     permittedInRequestStream,     permittedInPushStream,@@ -161,6 +163,26 @@ toLen :: Word8 -> ByteString -> Int64 toLen w0 bs = BS.foldl (\n w -> n * 256 + fromIntegral w) (fromIntegral w0) bs +-- | Read one variable-length integer from a byte source.+--+-- The source is asked for a byte at a time and answers with an empty string at+-- end of input, which is 'recvStream'\'s contract.  'Nothing' means the input+-- ended before a whole integer arrived.+--+-- A unidirectional stream announces its type this way (RFC 9114, section 6.2),+-- which is one, two, four or eight octets -- not the single one it is tempting+-- to read.+recvQInt :: (Int -> IO ByteString) -> IO (Maybe Int64)+recvQInt recv = loop QInit+  where+    loop st = do+        bs <- recv 1+        if BS.null bs+            then return Nothing+            else case parseQInt st bs of+                QDone i _ -> return $ Just i+                st' -> loop st'+ data IFrame     = -- | Parsing is about to start       IInit@@ -179,28 +201,51 @@         H3FrameType         ByteString -- Payload (entire or sentinel)         ByteString -- Leftover+    | -- | The frame says it is longer than we are willing to hold+      ITooLong+        H3FrameType+        Int -- The length it claimed     deriving (Eq, Show) -parseH3Frame :: IFrame -> ByteString -> IFrame-parseH3Frame st "" = st-parseH3Frame IInit bs = case parseQInt QInit bs of+-- | The frame type, once the parse has got far enough to know it.+frameTypeOf :: IFrame -> Maybe H3FrameType+frameTypeOf IInit = Nothing+frameTypeOf (IType _) = Nothing+frameTypeOf (ILen typ _) = Just typ+frameTypeOf (IPay typ _ _ _) = Just typ+frameTypeOf (IDone typ _ _) = Just typ+frameTypeOf (ITooLong typ _) = Just typ++-- | Feed bytes to a frame parse.+--+-- The first argument caps the payload of any frame that has to be held whole+-- before it can be used -- everything but DATA, whose payload is handed to the+-- caller as it arrives.  A length is a variable-length integer, so without a+-- cap a peer can announce up to 2^62-1 octets and have us buffer whatever it+-- then sends towards that.  DATA is exempt because a large body is a perfectly+-- ordinary thing to send; a caller that does /not/ drain DATA must refuse it+-- on sight instead.+parseH3Frame :: Int -> IFrame -> ByteString -> IFrame+parseH3Frame _ st "" = st+parseH3Frame lim IInit bs = case parseQInt QInit bs of     QDone i bs' ->         let typ = toH3FrameType i-         in parseH3Frame (ILen typ QInit) bs'+         in parseH3Frame lim (ILen typ QInit) bs'     ist -> IType ist-parseH3Frame (IType ist) bs = case parseQInt ist bs of+parseH3Frame lim (IType ist) bs = case parseQInt ist bs of     QDone i bs' ->         let typ = toH3FrameType i-         in parseH3Frame (ILen typ QInit) bs'+         in parseH3Frame lim (ILen typ QInit) bs'     ist' -> IType ist'-parseH3Frame (ILen typ ist) bs = case parseQInt ist bs of-    QDone i bs' ->-        let reqLen = fromIntegral i-         in if reqLen == 0-                then IDone typ "" bs'-                else parseH3Frame (IPay typ reqLen 0 []) bs'+parseH3Frame lim (ILen typ ist) bs = case parseQInt ist bs of+    QDone i bs'+        | reqLen == 0 -> IDone typ "" bs'+        | typ /= H3FrameData && reqLen > lim -> ITooLong typ reqLen+        | otherwise -> parseH3Frame lim (IPay typ reqLen 0 []) bs'+      where+        reqLen = fromIntegral i     ist' -> ILen typ ist'-parseH3Frame (IPay typ reqLen len0 bss0) bs0 = case len1 `compare` reqLen of+parseH3Frame _ (IPay typ reqLen len0 bss0) bs0 = case len1 `compare` reqLen of     LT -> IPay typ reqLen len1 (bs0 : bss0)     EQ -> IDone typ (compose bs0 bss0) ""     GT ->@@ -208,7 +253,7 @@          in IDone typ (compose bs2 bss0) leftover   where     len1 = len0 + BS.length bs0-parseH3Frame st _ = st+parseH3Frame _ st _ = st  compose :: ByteString -> [ByteString] -> ByteString compose bs bss = BS.concat $ reverse (bs : bss)

@@ -7,10 +7,12 @@     readSource,     readSource',     recvHeader,-    recvBody,+    newBodyReader, ) where +import qualified Control.Exception as E import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8 import Data.IORef import Network.QUIC @@ -48,18 +50,27 @@ recvHeader :: Context -> StreamId -> Source -> IO (Maybe TokenHeaderTable) recvHeader ctx sid src = loop IInit   where+    lim = getMaxFieldSectionSize ctx     loop st = do         bs <- readSource src         if bs == ""             then return Nothing-            else case parseH3Frame st bs of+            else case parseH3Frame lim st bs of+                ITooLong _ _ -> do+                    abort ctx H3ExcessiveLoad+                    loop IInit -- dummy+                st0+                    -- Nothing here drains DATA, so it is not covered by the+                    -- length cap; and it is not allowed before HEADERS+                    -- anyway.  Refuse it as soon as the type is known, rather+                    -- than after buffering whatever length it claimed.+                    | Just H3FrameData <- frameTypeOf st0 -> do+                        abort ctx H3FrameUnexpected+                        loop IInit -- dummy                 IDone typ payload leftover                     | typ == H3FrameHeaders -> do                         pushbackSource src leftover                         Just <$> qpackDecode ctx sid payload-                    | typ == H3FrameData -> do-                        abort ctx H3FrameUnexpected-                        loop IInit -- dummy                     | permittedInRequestStream typ -> do                         pushbackSource src leftover                         loop IInit@@ -68,41 +79,76 @@                         loop IInit -- dummy                 st' -> loop st' +-- | A body reader for one message, and the place its trailers will appear.+--+-- The reader counts what it hands out and checks the total against+-- content-length when the body ends, since a message whose content does not+-- match what it declared is malformed (RFC 9114, section 4.1.2).+--+-- Only what is actually read is counted, so a body the application never asks+-- for is never checked. Answering that would mean draining it on the+-- application's behalf, which is a different design from the one here.+newBodyReader+    :: Context+    -> StreamId+    -> Source+    -> ValueTable+    -> IO (IO (ByteString, Bool), IORef (Maybe TokenHeaderTable))+newBodyReader ctx sid src vt = do+    refI <- newIORef IInit+    refH <- newIORef Nothing+    refL <- newIORef 0+    let mcl = fst <$> (getFieldValue tokenContentLength vt >>= C8.readInt)+    return (recvBody ctx sid src refI refH mcl refL, refH)+ recvBody     :: Context     -> StreamId     -> Source     -> IORef IFrame     -> IORef (Maybe TokenHeaderTable)+    -> Maybe Int+    -> IORef Int     -> IO (ByteString, Bool)-recvBody ctx sid src refI refH = do+recvBody ctx sid src refI refH mcl refL = do     st <- readIORef refI     loop st   where+    lim = getMaxFieldSectionSize ctx+    endOfBody = do+        forM_ mcl $ \cl -> do+            len <- readIORef refL+            when (cl /= len) $ E.throwIO $ ContentLengthMismatch cl len+        return ("", True)+    chunk bs = do+        modifyIORef' refL (+ BS.length bs)+        return (bs, False)     loop st = do         bs <- readSource src         if bs == ""-            then return ("", True)-            else case parseH3Frame st bs of+            then endOfBody+            else case parseH3Frame lim st bs of+                ITooLong _ _ -> do+                    abort ctx H3ExcessiveLoad+                    return ("", True) -- dummy                 IPay H3FrameData siz received bss -> do                     let st' = IPay H3FrameData siz received []                     if null bss                         then loop st'                         else do                             writeIORef refI st'-                            let ret = BS.concat $ reverse bss-                            return (ret, False)+                            chunk $ BS.concat $ reverse bss                 IDone typ payload leftover                     | typ == H3FrameHeaders -> do                         writeIORef refI IInit                         -- pushbackSource src leftover -- fixme                         hdr <- qpackDecode ctx sid payload                         writeIORef refH $ Just hdr-                        return ("", True)+                        endOfBody                     | typ == H3FrameData -> do                         writeIORef refI IInit                         pushbackSource src leftover-                        return (payload, False)+                        chunk payload                     | permittedInRequestStream typ -> do                         pushbackSource src leftover                         loop IInit

@@ -109,14 +109,18 @@     case mvt of         Nothing -> QUIC.resetStream strm H3MessageError         Just ht -> do-            req <- mkRequest ctx strm src ht-            let aux =-                    defaultAux-                        { auxTimeHandle = th-                        , auxMySockAddr = getMySockAddr ctx-                        , auxPeerSockAddr = getPeerSockAddr ctx-                        }-            server req aux $ sendResponse ctx strm th+            mreq <- mkRequest ctx strm src ht+            case mreq of+                -- Malformed; 'mkRequest' has reset the stream.+                Nothing -> return ()+                Just req -> do+                    let aux =+                            defaultAux+                                { auxTimeHandle = th+                                , auxMySockAddr = getMySockAddr ctx+                                , auxPeerSockAddr = getPeerSockAddr ctx+                                }+                    server req aux $ sendResponse ctx strm th   where     sid = QUIC.streamId strm     reset se@@ -132,8 +136,10 @@     case mvt of         Nothing -> QUIC.resetStream strm H3MessageError         Just ht -> do-            req <- mkRequest ctx strm src ht-            put (strm, req)+            mreq <- mkRequest ctx strm src ht+            case mreq of+                Nothing -> return ()+                Just req -> put (strm, req)   where     sid = QUIC.streamId strm     reset se@@ -142,28 +148,37 @@             abort ctx QpackDecompressionFailed         | otherwise = QUIC.resetStream strm H3MessageError +-- | Build the 'Request', or reset the stream and answer 'Nothing' when the+-- message is malformed.+--+-- RFC 9114 section 4.1.2 makes a malformed request one the server "MUST treat+-- \[...\] as malformed", responding or resetting -- either way it is not a+-- request to serve.  The stream was being reset and then the request handed to+-- the application regardless, so a message the server had already rejected+-- still reached whatever was running behind it, on a stream it could no+-- longer answer on. mkRequest     :: Context     -> Stream     -> Source     -> (TokenHeaderList, ValueTable)-    -> IO Request+    -> IO (Maybe Request) mkRequest ctx strm src ht@(_, vt) = do     let mMethod = getFieldValue tokenMethod vt         mScheme = getFieldValue tokenScheme vt         mAuthority = getFieldValue tokenAuthority vt         mPath = getFieldValue tokenPath vt     case (mMethod, mScheme, mAuthority, mPath) of-        (Just "CONNECT", _, Just _, _) -> return ()-        (Just _, Just _, Just _, Just _) -> return ()-        _ -> QUIC.resetStream strm H3MessageError-    -- fixme: Content-Length-    refI <- newIORef IInit-    refH <- newIORef Nothing-    let sid = QUIC.streamId strm-    let readB = recvBody ctx sid src refI refH-        req = Request $ InpObj ht Nothing readB refH-    return req+        (Just "CONNECT", _, Just _, _) -> Just <$> build+        (Just _, Just _, Just _, Just _) -> Just <$> build+        _ -> do+            QUIC.resetStream strm H3MessageError+            return Nothing+  where+    build = do+        let sid = QUIC.streamId strm+        (readB, refH) <- newBodyReader ctx sid src vt+        return $ Request $ InpObj ht Nothing readB refH  sendResponse     :: Context -> Stream -> T.Handle -> Response -> [PushPromise] -> IO ()

@@ -2,6 +2,7 @@  module Network.HTTP3.Settings where +import qualified Control.Exception as E import Network.ByteOrder import Network.QUIC.Internal @@ -36,8 +37,18 @@         encodeInt' wbuf $ fromIntegral k         encodeInt' wbuf $ fromIntegral v -decodeH3Settings :: ByteString -> IO H3Settings-decodeH3Settings bs = withReadBuffer bs $ \rbuf -> loop rbuf id+-- | Decode a SETTINGS payload, or 'Nothing' if it stops in the middle of a+-- parameter.+--+-- Each parameter is two variable-length integers, and the loop can only tell+-- there is /something/ left, not whether there is a whole pair.  Reading off+-- the end raises 'BufferOverrun', which no HTTP\/3 handler knows what to do+-- with; caught here it becomes an answer the caller can turn into the+-- H3_FRAME_ERROR that RFC 9114 section 7.1 asks for.+decodeH3Settings :: ByteString -> IO (Maybe H3Settings)+decodeH3Settings bs =+    (withReadBuffer bs $ \rbuf -> Just <$> loop rbuf id)+        `E.catch` \BufferOverrun -> return Nothing   where     dec rbuf = do         k <- H3SettingsKey . fromIntegral <$> decodeInt' rbuf

@@ -120,7 +120,7 @@ -- | Default configuration for QPACK encoder. -- -- >>> defaultQEncoderConfig--- QEncoderConfig {ecMaxTableCapacity = 4096, ecHeaderBlockBufferSize = 4096, ecInstructionBufferSize = 4096}+-- QEncoderConfig {ecMaxTableCapacity = 4096, ecHeaderBlockBufferSize = 4096, ecInstructionBufferSize = 4096, ecUseHuffman = True} defaultQEncoderConfig :: QEncoderConfig defaultQEncoderConfig =     QEncoderConfig

@@ -29,6 +29,8 @@  data DecodeError     = IllegalStaticIndex Int+    | -- | An absolute index outside the dynamic table's live window+      IllegalDynamicIndex Int     | IllegalInsertCount     | BlockedStreamsOverflow     deriving (Eq, Show)

@@ -38,9 +38,7 @@         checkRequiredInsertCount dyntbl reqInsertCount         decreaseStreams dyntbl     checkRequiredInsertCount dyntbl reqInsertCount-    let bufsiz = 2048-    gcbuf <- mallocPlainForeignPtrBytes 2048-    let hufdec = decodeH gcbuf bufsiz+    hufdec <- newHuffmanDecoder rbuf     tbl <- decodeSophisticated (toTokenHeader dyntbl bp hufdec) rbuf     return (tbl, needAck) @@ -53,13 +51,32 @@     ok <- checkRequiredInsertCountNB dyntbl reqInsertCount     if ok         then do-            let bufsiz = 2048-            gcbuf <- mallocPlainForeignPtrBytes 2048-            let hufdec = decodeH gcbuf bufsiz+            hufdec <- newHuffmanDecoder rbuf             hs <- decodeSimple (toTokenHeader dyntbl bp hufdec) rbuf             return $ Just (hs, needAck)         else return Nothing +-- | A Huffman decoder with room for anything the rest of this field section+-- can decode to.+--+-- The scratch buffer has to hold one decoded string, and the shortest Huffman+-- code is five bits, so an encoded string of n octets cannot come to more than+-- 8n\/5 symbols -- and the section that contains it is itself at most what is+-- left in the buffer.  Sizing from that means a header field is refused only+-- when the section it is in is, rather than at a fixed 2048 that nothing+-- announced: a 2100-octet value used to fail to decode while the section+-- carrying it was under 1.4K, well inside the SETTINGS_MAX_FIELD_SECTION_SIZE+-- we advertise.+--+-- Allocated per section rather than held on the table, because sections from+-- different streams decode concurrently and this buffer is not shared.+newHuffmanDecoder :: ReadBuffer -> IO HuffmanDecoder+newHuffmanDecoder rbuf = do+    siz <- remainingSize rbuf+    let bufsiz = max 1 ((siz * 8) `div` 5)+    gcbuf <- mallocPlainForeignPtrBytes bufsiz+    return $ decodeH gcbuf bufsiz+ {- FOURMOLU_DISABLE -} toTokenHeader     :: DynamicTable@@ -91,8 +108,7 @@             | static = SIndex $ AbsoluteIndex i             | otherwise = DIndex $ fromPreBaseIndex (PreBaseIndex i) bp     ret <- atomically (entryTokenHeader <$> toIndexedEntry dyntbl hidx)-    qpackDebug dyntbl $ do-        checkHIndex dyntbl hidx+    qpackDebug dyntbl $         putStrLn $             "IndexedFieldLine (" ++ show hidx ++ ") " ++ showTokenHeader ret     return ret@@ -104,8 +120,7 @@     i <- decodeI 4 (w8 .&. 0b00001111) rbuf     let hidx = DIndex $ fromPostBaseIndex (PostBaseIndex i) bp     ret <- atomically (entryTokenHeader <$> toIndexedEntry dyntbl hidx)-    qpackDebug dyntbl $ do-        checkHIndex dyntbl hidx+    qpackDebug dyntbl $         putStrLn $             "IndexedFieldLineWithPostBaseIndex ("                 ++ show hidx@@ -134,8 +149,7 @@     key <- atomically (entryToken <$> toIndexedEntry dyntbl hidx)     val <- decodeS (`clearBit` 7) (`testBit` 7) 7 hufdec rbuf     let ret = (key, val)-    qpackDebug dyntbl $ do-        checkHIndex dyntbl hidx+    qpackDebug dyntbl $         putStrLn $             "LiteralFieldLineWithNameReference ("                 ++ show hidx@@ -157,8 +171,7 @@     key <- atomically (entryToken <$> toIndexedEntry dyntbl hidx)     val <- decodeS (`clearBit` 7) (`testBit` 7) 7 hufdec rbuf     let ret = (key, val)-    qpackDebug dyntbl $ do-        checkHIndex dyntbl hidx+    qpackDebug dyntbl $         putStrLn $             "LiteralFieldLineWithPostBaseNameReference ("                 ++ show hidx

@@ -115,6 +115,7 @@  ) import System.IO.Unsafe (unsafePerformIO) +import Network.QPACK.Error import Network.QPACK.Table.RevIndex import Network.QPACK.Types import Network.QUIC (StreamId)@@ -278,12 +279,32 @@     modifyTVar' tableSize (+ entrySize ent)     return $ AbsoluteIndex insp +-- | Look up an entry of the dynamic table by absolute index.+--+-- The live window is the most recent 'maxNumOfEntries' insertions. An index+-- outside it names nothing, and the @mod@ below would fold it back into the+-- table and hand over whichever slot it landed on -- a header nobody sent.+-- RFC 9204 section 2.1.2 asks for an error instead, and this one reaches the+-- peer as QPACK_DECOMPRESSION_FAILED from a field section, or as+-- QPACK_ENCODER_STREAM_ERROR from an encoder instruction.+--+-- The window is empty until a capacity has been set, which is also what keeps+-- the @mod@ from dividing by zero: 'maxNumOfEntries' starts at 0 and a field+-- section can reach here before the peer has sent us a capacity at all. toDynamicEntry :: DynamicTable -> AbsoluteIndex -> STM Entry toDynamicEntry DynamicTable{..} (AbsoluteIndex idx) = do     maxN <- readTVar maxNumOfEntries-    let i = idx `mod` maxN+    InsertionPoint ip <- readTVar insertionPoint+    -- @max 0@ because early on the table holds fewer than maxN entries and+    -- @ip - maxN@ is negative, which would let a negative index through; the+    -- index conversions produce those readily, since a pre-base index larger+    -- than the base gives one.+    let lo = max 0 (ip - maxN)+    when (maxN == 0 || idx < lo || idx >= ip) $+        throwSTM $+            IllegalDynamicIndex idx     table <- readTVar circularTable-    unsafeRead table i+    unsafeRead table (idx `mod` maxN)  ---------------------------------------------------------------- 

@@ -33,7 +33,11 @@ -- Entry 53 (Token {tokenIx = 21, shouldBeIndexed = True, isPseudo = False, tokenKey = "Content-Type"}) "image/png" toStaticEntry :: AbsoluteIndex -> Entry toStaticEntry (AbsoluteIndex sidx)-    | sidx < staticTableSize = staticTable `unsafeAt` sidx+    -- Both ends, since the read below is unchecked.  Nothing reaches here with+    -- a negative index today -- http2's decodeI has been bounded since 5.4.5 --+    -- but that is a guarantee from another package standing in front of an+    -- unsafeAt, which is not where such a guarantee belongs.+    | 0 <= sidx && sidx < staticTableSize = staticTable `unsafeAt` sidx     | otherwise = E.throw $ IllegalStaticIndex sidx  -- | Pre-defined static table.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               http3-version:            0.1.4+version:            0.1.5 license:            BSD-3-Clause license-file:       LICENSE maintainer:         Kazu Yamamoto <kazu@iij.ad.jp>@@ -83,7 +83,7 @@         containers,         http-semantics >= 0.4 && <0.5,         http-types,-        http2 >=5.4 && <5.5,+        http2 >=5.4.5 && <5.5,         iproute >= 1.7 && < 1.8,         network,         network-byte-order,@@ -207,8 +207,10 @@         HTTP3.Config         HTTP3.Error         HTTP3.ErrorSpec+        HTTP3.FrameSpec         HTTP3.Server         HTTP3.ServerSpec+        QPACK.HeaderBlockSpec         QPACK.InstructionSpec         QPACK.QIFSpec         QPACK.QIF2Spec

@@ -10,6 +10,7 @@ import Data.ByteString () import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8+import Data.IORef import Network.HTTP.Types import qualified Network.HTTP3.Client as H3 import Network.HTTP3.Internal@@ -46,7 +47,33 @@         threadDelay 100000         return ret -h3ErrorSpec :: ClientConfig -> H3.ClientConfig -> Millisecond -> SpecWith a+-- | Like 'runC', but sending a request of our own choosing.+runCReq+    :: H3.Request+    -> ClientConfig+    -> H3.ClientConfig+    -> H3.Config+    -> Millisecond+    -> IO (Maybe ())+runCReq req qcc cconf conf ms = timeout us $ run qcc $ \conn -> do+    info <- getConnectionInfo conn+    case alpn info of+        Just proto | "hq" `BS.isPrefixOf` proto -> do+            waitEstablished conn+            E.throwIO $ ApplicationProtocolErrorIsReceived H3InternalError ""+        _ -> H3.run conn cconf conf client+  where+    us = ms * 1000+    client sendRequest _aux = do+        ret <- sendRequest req $ \_rsp -> return ()+        threadDelay 100000+        return ret++h3ErrorSpec+    :: ClientConfig+    -> H3.ClientConfig+    -> Millisecond+    -> SpecWith (ThreadId, IORef Int) h3ErrorSpec qcc cconf ms = do     conf0 <- runIO H3.allocSimpleConfig     describe "HTTP/3 servers" $ do@@ -63,11 +90,16 @@                 `shouldThrow` applicationProtocolErrorsIn [H3MessageError]         it             "MUST send H3_MESSAGE_ERROR if mandatory pseudo-header fields are absent [HTTP/3 4.1.3]"-            $ \_ -> do+            $ \(_, served) -> do                 let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader0                     qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")+                before' <- readIORef served                 runC qcc' cconf conf ms                     `shouldThrow` applicationProtocolErrorsIn [H3MessageError]+                -- And it must not have reached the application: the stream was+                -- reset and then the request handed over anyway.+                threadDelay 200000+                readIORef served `shouldReturn` before'         it             "MUST send H3_MESSAGE_ERROR if prohibited pseudo-header fields are present[HTTP/3 4.1.3]"             $ \_ -> do@@ -83,6 +115,16 @@                 runC qcc' cconf conf ms                     `shouldThrow` applicationProtocolErrorsIn [H3MessageError]         it+            "MUST treat content that does not match content-length as malformed [HTTP/3 4.1.2]"+            $ \_ -> do+                -- content-length says five octets and the request carries+                -- none.  /drain reads the body, which is where the count is+                -- checked; a body nobody reads is never counted.+                let req = H3.requestNoBody methodPost "/drain" [("content-length", "5")]+                    qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")+                runCReq req qcc' cconf conf0 ms+                    `shouldThrow` applicationProtocolErrorsIn [H3MessageError]+        it             "MUST send H3_MISSING_SETTINGS if the first control frame is not SETTINGS [HTTP/3 6.2.1]"             $ \_ -> do                 let conf = addHook conf0 $ setOnControlFrameCreated startWithNonSettings@@ -118,6 +160,24 @@                 runC qcc cconf conf ms                     `shouldThrow` applicationProtocolErrorsIn [H3SettingsError]         it+            "MUST send H3_FRAME_ERROR if a SETTINGS frame stops mid-parameter [HTTP/3 7.1]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlFrameCreated truncatedSettings+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3FrameError]+        it+            "MUST NOT stop reading settings at a reserved identifier [HTTP/3 7.2.4.1]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlFrameCreated greaseThenHttp2Setting+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3SettingsError]+        it+            "treats a repeated setting identifier as an error whatever its value [HTTP/3 7.2.4.1]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlFrameCreated duplicateLargeSetting+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3SettingsError]+        it             "MUST send H3_FRAME_UNEXPECTED if CANCEL_PUSH is received in a request stream [HTTP/3 7.2.5]"             $ \_ -> do                 let conf = addHook conf0 $ setOnHeadersFrameCreated requestCancelPush@@ -130,6 +190,18 @@                 runC qcc cconf conf ms                     `shouldThrow` applicationProtocolErrorsIn [QpackDecompressionFailed]         it+            "MUST send QPACK_DECOMPRESSION_FAILED if a field line references a dynamic table entry that is not there [QPACK 2.1.2]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader5+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [QpackDecompressionFailed]+        it+            "MUST NOT buffer a frame longer than SETTINGS_MAX_FIELD_SECTION_SIZE [HTTP/3 7.1]"+            $ \_ -> do+                let conf = addHook conf0 $ setOnControlStreamCreated overLongFrame+                runC qcc cconf conf ms+                    `shouldThrow` applicationProtocolErrorsIn [H3ExcessiveLoad]+        it             "MUST send QPACK_ENCODER_STREAM_ERROR if a new dynamic table capacity value exceeds the limit [QPACK 4.1.3]"             $ \_ -> do                 let conf = addHook conf0 $ setOnEncoderStreamCreated largeTableCapacity@@ -248,6 +320,21 @@         "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xff\x24"     ] +-- [(":method","GET")+-- ,(":scheme","https")+-- ,(":authority","127.0.0.1")+-- ,(":path","/")] ++ dynamic index 0+--+-- The Required Insert Count in the prefix is 0 and nothing has been inserted,+-- so there is no entry 0 to name.  The decoder used to fold the index back+-- into the table and hand over whatever slot it landed on.+illegalHeader5 :: [H3Frame] -> [H3Frame]+illegalHeader5 _ =+    [ H3Frame+        H3FrameHeaders+        "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\x80"+    ]+ {- -- [(SettingsQpackBlockedStreams,100) -- ,(SettingsQpackMaxTableCapacity,4096)@@ -261,6 +348,32 @@ -- ,(H3SettingsKey 0x2,200) -- HTTP/2 Settings -- ,(SettingsQpackMaxTableCapacity,4096) -- ,(SettingsMaxFieldSectionSize,32768)]+-- An identifier with no value behind it.+--+-- Each parameter is a pair of variable-length integers; this frame stops+-- between them, which section 7.1 makes H3_FRAME_ERROR.  Reading off the end+-- used to raise BufferOverrun, which nothing here catches, so the peer was+-- told nothing at all.+truncatedSettings :: [H3Frame] -> [H3Frame]+truncatedSettings _ = [H3Frame H3FrameSettings "\x01"]++-- [(H3SettingsKey 0x21,0) -- reserved, to be ignored+-- ,(H3SettingsKey 0x2,0)]  -- HTTP/2 Settings, which must be refused+--+-- 0x21 is the first of the identifiers section 7.2.4.1 reserves and tells+-- endpoints they SHOULD send.  Reading used to stop at it, so the HTTP/2+-- setting behind it went unseen -- along with anything else a peer put there.+greaseThenHttp2Setting :: [H3Frame] -> [H3Frame]+greaseThenHttp2Setting _ = [H3Frame H3FrameSettings "\x21\x00\x02\x00"]++-- [(H3SettingsKey 0x40,0)+-- ,(H3SettingsKey 0x40,0)] -- the same identifier twice+--+-- 64 in the two-octet form.  The duplicate check was bits in an Int, so+-- identifiers this large repeated unnoticed.+duplicateLargeSetting :: [H3Frame] -> [H3Frame]+duplicateLargeSetting _ = [H3Frame H3FrameSettings "\x40\x40\x00\x40\x40\x00"]+ illegalSettings1 :: [H3Frame] -> [H3Frame] illegalSettings1 _ =     [ H3Frame@@ -269,6 +382,14 @@     ]  ----------------------------------------------------------------++-- A GOAWAY frame announcing 2^30 octets and then sending none of them.+--+-- A frame length is a variable-length integer, so a peer can claim up to+-- 2^62-1 and have the other end hold whatever it sends towards that.  Nothing+-- has to arrive for the claim to be refused.+overLongFrame :: Stream -> IO ()+overLongFrame strm = sendStream strm "\x07\xc0\x00\x00\x00\x40\x00\x00\x00"  -- SetDynamicTableCapacity 10000000000 largeTableCapacity :: Stream -> IO ()

@@ -1,14 +1,22 @@ module HTTP3.ErrorSpec where  import Data.ByteString ()+import Data.IORef import Test.Hspec  import HTTP3.Config import HTTP3.Error import HTTP3.Server +-- | The server counts the requests it is handed, so that a test can check a+-- rejected one never got that far. spec :: Spec spec =-    beforeAll (setup server 4096) $-        afterAll teardown $+    beforeAll start $+        afterAll (teardown . fst) $             h3ErrorSpec testClientConfig testH3ClientConfig 2000 -- 2 seconds+  where+    start = do+        ref <- newIORef 0+        tid <- setup (countingServer ref) 4096+        return (tid, ref)

@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}++module HTTP3.FrameSpec where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.IORef+import Network.HTTP3.Internal+import Test.Hspec++-- | A byte source in the shape 'recvStream' has: hands out at most the+-- requested number of octets, then empty strings for ever after.+sourceOf :: ByteString -> IO (Int -> IO ByteString)+sourceOf bs0 = do+    ref <- newIORef bs0+    return $ \n -> atomicModifyIORef' ref $ \bs ->+        let (taken, rest) = BS.splitAt n bs in (rest, taken)++spec :: Spec+spec = do+    describe "recvQInt" $ do+        it "reads a variable-length integer of each width" $ do+            -- RFC 9000 section 16: one, two, four and eight octet forms.+            -- The stream type of a unidirectional stream is one of these, and+            -- reading only the first octet cut everything from 0x40 up in half.+            recvOn "\x03" `shouldReturn` Just 3+            recvOn "\x40\x03" `shouldReturn` Just 3+            recvOn "\x80\x00\x00\x03" `shouldReturn` Just 3+            recvOn "\x25" `shouldReturn` Just 0x25+            recvOn "\x40\x25" `shouldReturn` Just 0x25+            recvOn "\x7b\xbd" `shouldReturn` Just 15293++        it "leaves the rest of the stream alone" $ do+            src <- sourceOf "\x40\x03rest"+            recvQInt src `shouldReturn` Just 3+            src 4 `shouldReturn` "rest"++        it "gives up when the stream ends first" $ do+            -- A peer may open a unidirectional stream and close it without+            -- ever saying what it was for.+            recvOn "" `shouldReturn` Nothing+            recvOn "\x40" `shouldReturn` Nothing+            recvOn "\x80\x00" `shouldReturn` Nothing+  where+    recvOn bs = sourceOf bs >>= recvQInt

@@ -4,6 +4,7 @@ module HTTP3.Server (     setup,     server,+    countingServer,     teardown,     trailersMaker,     firstTrailerValue,@@ -22,6 +23,7 @@ import qualified Data.ByteString as B import Data.ByteString.Builder (byteString) import qualified Data.ByteString.Char8 as C8+import Data.IORef import Data.IP () import Network.HPACK import Network.HTTP.Types@@ -51,13 +53,31 @@ teardown :: ThreadId -> IO () teardown tid = killThread tid +-- | 'server', but counting how many times it is handed a request.+--+-- A request the server has already rejected must not reach the application at+-- all, and the only place that shows is here.+countingServer :: IORef Int -> Server+countingServer ref req aux sendResponse = do+    atomicModifyIORef' ref $ \n -> (n + 1, ())+    server req aux sendResponse+ server :: Server-server req _aux sendResponse = case requestMethod req of+server req aux sendResponse = case requestMethod req of     Just "GET" -> case requestPath req of         Just "/" -> sendResponse responseHello []+        Just "/sockaddr" -> sendResponse (responseSockAddr aux) []         _ -> sendResponse response404 []     Just "POST" -> case requestPath req of         Just "/echo" -> sendResponse (responseEcho req) []+        -- Reads the body and says nothing about it, so that a test can be+        -- about what reading the body does rather than about trailers.+        Just "/drain" -> do+            let loop = do+                    bs <- getRequestBodyChunk req+                    unless (B.null bs) loop+            loop+            sendResponse responseHello []         _ -> sendResponse responseHello []     _ -> sendResponse response405 [] @@ -66,6 +86,17 @@   where     header = [("Content-Type", "text/plain")]     body = byteString "Hello, world!\n"++-- | Hands back the two addresses the server was given, so that a test can+-- check they are not the same one twice over.+responseSockAddr :: Aux -> Response+responseSockAddr aux = responseBuilder ok200 header body+  where+    header = [("Content-Type", "text/plain")]+    body =+        byteString $+            C8.pack $+                show (auxMySockAddr aux) ++ " " ++ show (auxPeerSockAddr aux)  response404 :: Response response404 = responseNoBody notFound404 []

@@ -23,6 +23,8 @@ h3spec = do     describe "H3 server" $ do         it "handles normal cases" $ \_ -> runClient+        it "tells the application the peer's address, not its own" $ \_ ->+            runSockAddrClient  runClient :: IO () runClient = QUIC.run testClientConfig $ \conn ->@@ -38,6 +40,31 @@             , client2 sendRequest _aux             , client3 sendRequest _aux             ]++-- | The server reports both addresses it was handed; they must differ.+--+-- Over loopback the host part is 127.0.0.1 either way, so it is the port that+-- tells them apart: the server's is fixed, the client's is ephemeral.+-- 'getPeerSockAddr' used to return the server's own address, which made these+-- two identical and left every application logging or filtering on the client+-- address looking at itself.+runSockAddrClient :: IO ()+runSockAddrClient = QUIC.run testClientConfig $ \conn ->+    E.bracket allocSimpleConfig freeSimpleConfig $ \conf ->+        C.run conn testH3ClientConfig conf $ \sendRequest _aux -> do+            let req = C.requestNoBody methodGet "/sockaddr" []+            sendRequest req $ \rsp -> do+                C.responseStatus rsp `shouldBe` Just ok200+                body <- consume rsp+                case B.split 0x20 body of+                    [mine, peer] -> peer `shouldNotBe` mine+                    _ -> expectationFailure $ "unexpected body: " ++ show body+  where+    consume rsp = go id+      where+        go build = do+            bs <- C.getResponseBodyChunk rsp+            if B.null bs then return (B.concat (build [])) else go (build . (bs :))  client0 :: C.Client () client0 sendRequest _aux = do

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module QPACK.HeaderBlockSpec where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8+import Network.HPACK.Token (toToken)+import Network.QPACK+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]++roundTrip :: Int -> IO ()+roundTrip n = do+    (enc, _, _) <-+        newQEncoder+            defaultQEncoderConfig{ecHeaderBlockBufferSize = 262144}+            (\_ -> return ())+    (dec, _) <- newQDecoder defaultQDecoderConfig (\_ -> return ())+    let val = C8.replicate n 'a'+    blk <- enc 0 [(toToken ":status", "200"), (toToken "x-big", val)]+    (ths, _) <- dec 0 blk+    -- The encoded section stays well under the announced limit; it is only+    -- the decoded value that is large.+    BS.length blk `shouldSatisfy` (< dcMaxFieldSectionSize defaultQDecoderConfig)+    lookup (toToken "x-big") ths `shouldBe` Just val

@@ -1,5 +1,7 @@ module QPACK.TableSpec where +import Control.Concurrent.STM+import qualified Control.Exception as E import Network.QPACK.Internal import Test.Hspec import Test.Hspec.QuickCheck@@ -7,6 +9,21 @@  spec :: Spec spec = do+    describe "toIndexedEntry" $ do+        it "refuses a static index outside the table" $ do+            dyntbl <- newDynamicTableForDecoding 2048 (\_ -> return ())+            -- Entry has no Eq, so keep only whether it came back at all.+            let look i = do+                    r <-+                        E.try $+                            atomically (toIndexedEntry dyntbl (SIndex (AbsoluteIndex i)))+                                >>= E.evaluate+                    return $ either Left (const (Right ())) r+            -- Past the end was already refused; below the start was not, and+            -- the read behind it is unchecked.+            look 1000 `shouldReturn` Left (IllegalStaticIndex 1000)+            look (-1) `shouldReturn` Left (IllegalStaticIndex (-1))+     describe "encodeRequiredInsertCount and decodeRequiredInsertCount" $ do         prop "duality" $ \(Triple m ei di) -> do             let ereq = encodeRequiredInsertCount m (RequiredInsertCount ei)