quic 0.3.10 → 0.3.11

raw patch · 15 files changed

+499/−19 lines, 15 filesdep ~crypto-tokenPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: crypto-token

API changes (from Hackage documentation)

Files

• ChangeLog.md +61/−0
• Network/QUIC/Packet.hs +1/−0
• Network/QUIC/Packet/Token.hs +47/−6
• Network/QUIC/Parameters.hs +2/−2
• Network/QUIC/Receiver.hs +61/−2
• Network/QUIC/Server/Reader.hs +26/−6
• Network/QUIC/Server/Run.hs +10/−2
• Network/QUIC/Stream.hs +5/−0
• Network/QUIC/Stream/Misc.hs +70/−0
• Network/QUIC/Stream/Types.hs +20/−0
• Network/QUIC/Types/Constants.hs +19/−0
• quic.cabal +3/−1
• test/IOSpec.hs +91/−0
• test/TokenSpec.hs +58/−0
• test/TransportError.hs +25/−0

@@ -1,5 +1,66 @@ # ChangeLog +## 0.3.11++A security fix, two things RFC 9000 asks of a receiver that were not+there, and a default that left a peer no room.++* Bind an address validation token to the address it was issued to.+  RFC 9000 Sec 8.1.3: tokens sent in NEW_TOKEN frames MUST carry+  something the server can check the client's address against, and if+  the address has changed the server MUST keep to the anti-amplification+  limit.  Ours carried a version, a lifetime and, for a Retry, the+  connection IDs -- no address -- and a fresh one was taken as proof, so+  a client need only keep the NEW_TOKEN it was given and send it back+  with someone else's address in the header: the server treated that+  address as validated and answered it, certificate and all, having had+  nothing proved to it.  A token from before this cannot be decoded and+  is already treated as no token at all, which is to say as an address+  that has proved nothing.+  [#133](https://github.com/kazu-yamamoto/quic/pull/133)++* Hold a peer to the final size it gave for a stream.  FINAL_SIZE_ERROR+  was in the error table and was never sent: where a stream ends, once+  said, cannot be said differently, and nothing may arrive past it+  (RFC 9000 Sec 4.5), but the final size a RESET_STREAM carries went to+  a hook and nowhere else.  That section also asks a receiver to count+  the final size in its connection-level flow controller, and ours+  counted what arrived; a peer counts the final size, so every stream it+  reset with data still in flight left the two further apart, and the+  window we advertise fell behind what the peer believed it had spent --+  by the tail of every reset, until it had none left.  HTTP/3 cancels+  requests as a matter of course.+  [#136](https://github.com/kazu-yamamoto/quic/pull/136)++* Open the stream a STREAM_DATA_BLOCKED arrives for.  RFC 9000 Sec 3.2+  has the receiving part of a peer's stream created by the first STREAM,+  STREAM_DATA_BLOCKED or RESET_STREAM frame for it; the last was done in+  0.3.10 and this is the other.  Both blocked frames also refuse a+  packet that may not carry them: Table 3 has them in 0-RTT and 1-RTT+  only, and Sec 12.4 makes a frame in a packet that may not carry it a+  PROTOCOL_VIOLATION.+  [#134](https://github.com/kazu-yamamoto/quic/pull/134)++* **The default `initial_max_streams_uni` is 10, where it was 3.**  Three+  is what HTTP/3 needs and no more -- a control stream and the two QPACK+  streams (RFC 9114 Sec 6.2) -- so a peer given three could open nothing+  else: no push stream, no stream of a type from an extension, and none+  of the reserved types it is meant to open now and then so that the+  types stay extensible.  A client on these defaults could never be+  pushed to.  Ten leaves room for those without leaving the peer+  unbounded, since 0.3.9 counts what is open at once and a stream gives+  its place back when it is closed.+  [#135](https://github.com/kazu-yamamoto/quic/pull/135)++* Say why a server connection ended.  `runServer` logged the reason to a+  logger that discards what it is given, so a connection that ended of+  anything `closure` does not turn into a CONNECTION_CLOSE went without+  a word to the peer and without a word in the log -- the peer talking+  on to a connection that is gone until the dispatcher, a second later,+  answers it with a Stateless Reset.  From the outside that looks like a+  server that froze.+  [#138](https://github.com/kazu-yamamoto/quic/pull/138)+ ## 0.3.10  Two for the server: one that answered on a stream it should never have

@@ -33,6 +33,7 @@     -- * Token     CryptoToken (..),     isRetryToken,+    isTokenAddress,     generateToken,     generateRetryToken,     encryptToken,

@@ -4,6 +4,7 @@ module Network.QUIC.Packet.Token (     CryptoToken (..),     isRetryToken,+    isTokenAddress,     generateToken,     generateRetryToken,     encryptToken,@@ -12,9 +13,15 @@  import Codec.Serialise import qualified Crypto.Token as CT+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Data.UnixTime import GHC.Generics+import Network.Socket (+    SockAddr (..),+    hostAddress6ToTuple,+    hostAddressToTuple,+ )  import Network.QUIC.Imports import Network.QUIC.Types@@ -26,6 +33,8 @@     , tokenLifeTime :: Word32     , tokenCreatedTime :: TimeMicrosecond     , tokenCIDs :: Maybe (CID, CID, CID) -- local, remote, orig local+    , tokenAddress :: ByteString+    -- ^ The address the token was issued to, as 'addressForToken' writes it     }     deriving (Generic) @@ -35,17 +44,49 @@ isRetryToken :: CryptoToken -> Bool isRetryToken token = isJust $ tokenCIDs token +-- | Whether the token was issued to this address.+--+-- RFC 9000 Sec 8.1.3: "Tokens sent in NEW_TOKEN frames MUST include+-- information that allows the server to verify that the client IP address+-- has not changed from when the token was issued."  Without it, whoever+-- holds a token can have the server treat any address as validated, and the+-- three-times anti-amplification limit is off for an address that has proved+-- nothing -- the same hole #114 closed for a token the server cannot read at+-- all, left open for one it can.+isTokenAddress :: CryptoToken -> SockAddr -> Bool+isTokenAddress token sa = tokenAddress token == addressForToken sa++-- | The address alone, without the port: four octets for IPv4 and sixteen+--   for IPv6.+--+-- A NAT hands a client a new port whenever it pleases, and it is the address+-- RFC 9000 Sec 8.1.3 asks about.  The token goes back and forth in Initial+-- packets, so it is written as the octets rather than as the text of the+-- address, which runs to thirty-nine characters for an IPv6 one.+addressForToken :: SockAddr -> ByteString+addressForToken (SockAddrInet _ ha) = BS.pack [a, b, c, d]+  where+    (a, b, c, d) = hostAddressToTuple ha+addressForToken (SockAddrInet6 _ _ ha6 _) = BS.pack $ concatMap octets [a, b, c, d, e, f, g, h]+  where+    (a, b, c, d, e, f, g, h) = hostAddress6ToTuple ha6+    octets w = [fromIntegral (w `shiftR` 8), fromIntegral w]+addressForToken _ = BS.empty+ ---------------------------------------------------------------- -generateToken :: Version -> Int -> IO CryptoToken-generateToken ver life = do+generateToken :: Version -> Int -> SockAddr -> IO CryptoToken+generateToken ver life sa = do     t <- getTimeMicrosecond-    return $ CryptoToken ver (fromIntegral life) t Nothing+    return $ CryptoToken ver (fromIntegral life) t Nothing $ addressForToken sa -generateRetryToken :: Version -> Int -> CID -> CID -> CID -> IO CryptoToken-generateRetryToken ver life l r o = do+generateRetryToken+    :: Version -> Int -> CID -> CID -> CID -> SockAddr -> IO CryptoToken+generateRetryToken ver life l r o sa = do     t <- getTimeMicrosecond-    return $ CryptoToken ver (fromIntegral life) t $ Just (l, r, o)+    return $+        CryptoToken ver (fromIntegral life) t (Just (l, r, o)) $+            addressForToken sa  ---------------------------------------------------------------- 

@@ -339,7 +339,7 @@ -- | An example parameters obsoleted in the near future. -- -- >>> defaultParameters--- Parameters {originalDestinationConnectionId = Nothing, maxIdleTimeout = 30000, statelessResetToken = Nothing, maxUdpPayloadSize = 2048, initialMaxData = 16777216, initialMaxStreamDataBidiLocal = 262144, initialMaxStreamDataBidiRemote = 262144, initialMaxStreamDataUni = 262144, initialMaxStreamsBidi = 64, initialMaxStreamsUni = 3, ackDelayExponent = 3, maxAckDelay = 25, disableActiveMigration = False, preferredAddress = Nothing, activeConnectionIdLimit = 5, initialSourceConnectionId = Nothing, retrySourceConnectionId = Nothing, grease = Nothing, greaseQuicBit = True, versionInformation = Nothing, maxDatagramFrameSize = 0}+-- Parameters {originalDestinationConnectionId = Nothing, maxIdleTimeout = 30000, statelessResetToken = Nothing, maxUdpPayloadSize = 2048, initialMaxData = 16777216, initialMaxStreamDataBidiLocal = 262144, initialMaxStreamDataBidiRemote = 262144, initialMaxStreamDataUni = 262144, initialMaxStreamsBidi = 64, initialMaxStreamsUni = 10, ackDelayExponent = 3, maxAckDelay = 25, disableActiveMigration = False, preferredAddress = Nothing, activeConnectionIdLimit = 5, initialSourceConnectionId = Nothing, retrySourceConnectionId = Nothing, grease = Nothing, greaseQuicBit = True, versionInformation = Nothing, maxDatagramFrameSize = 0} defaultParameters :: Parameters defaultParameters =     baseParameters@@ -350,7 +350,7 @@         , initialMaxStreamDataBidiRemote = defaultMaxStreamData -- 256K         , initialMaxStreamDataUni = defaultMaxStreamData -- 256K         , initialMaxStreamsBidi = defaultMaxStreams -- 64-        , initialMaxStreamsUni = 3+        , initialMaxStreamsUni = defaultMaxStreamsUni -- 10         , activeConnectionIdLimit = 5         , greaseQuicBit = True         , maxDatagramFrameSize = 0

@@ -225,6 +225,15 @@     | isClient conn = isClientInitiated sid     | otherwise = isServerInitiated sid +-- | Closing the connection over a final size that does not hold together+--   (RFC 9000 Sec 4.5).+closeOverFinalSize :: Connection -> Maybe FinalSizeProblem -> IO ()+closeOverFinalSize conn = mapM_ $ closeConnection conn FinalSizeError . reason+  where+    reason FinalSizeChanged = "a final size that is not the one already known"+    reason FinalSizeTooSmall = "a final size below what the stream has reached"+    reason DataPastFinalSize = "stream data beyond the final size"+ guardStream :: Connection -> StreamId -> Maybe Stream -> IO () guardStream conn sid Nothing =     streamNotCreatedYet@@ -319,6 +328,25 @@     case mstrm of         Nothing -> return ()         Just strm -> do+            -- RFC 9000 Sec 4.5, as for a STREAM frame that ends the stream.+            noteRxFinalSize strm finlen >>= closeOverFinalSize conn+            -- FLOW CONTROL: MAX_DATA: recv: the octets the peer spent on the+            -- stream that will now never arrive.  Left uncounted, the window+            -- we advertise falls behind what the peer believes it has spent,+            -- by the tail of every stream it resets, until it has none left.+            unarrived <- takeRxUncounted strm+            when (unarrived > 0) $ do+                ok <- checkRxMaxData conn unarrived+                unless ok $+                    closeConnection conn FlowControlError "Flow control error for connection"+                mx <- updateFlowRx conn unarrived+                forM_ mx $ \newMax -> do+                    sendFrames conn RTT1Level [MaxData newMax]+                    fire conn (Microseconds 50000) $+                        sendFrames conn RTT1Level [MaxData newMax]+            -- After the two checks above, not before: the application has no+            -- business serving a stream the frame that opened it is about to+            -- close the connection over.  As for a STREAM frame (#131).             deliverStream conn mstrm0 strm             onResetStreamReceived (connHooks conn) strm aerr             -- Before the pseudo FIN below, so that whoever reads it can@@ -389,6 +417,9 @@     forM_ mstrm' $ \strm -> do         let len = BS.length dat             rx = RxStreamData dat off len fin+        -- RFC 9000 Sec 4.5: where the stream ends, once said, cannot be said+        -- differently, and nothing may arrive past it.+        noteRxFrame strm (off + len) fin >>= closeOverFinalSize conn         fc <- putRxStreamData strm rx         case fc of             -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit@@ -401,6 +432,7 @@                 closeConnection conn QUIC.InternalError "Too many stream fragments"             Duplicated -> return ()             Reassembled -> do+                addRxCounted strm len                 ok' <- checkRxMaxData conn len                 -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit                 unless ok' $@@ -434,6 +466,9 @@     forM_ mstrm' $ \strm -> do         let len = BS.length dat             rx = RxStreamData dat off len fin+        -- RFC 9000 Sec 4.5: where the stream ends, once said, cannot be said+        -- differently, and nothing may arrive past it.+        noteRxFrame strm (off + len) fin >>= closeOverFinalSize conn         fc <- putRxStreamData strm rx         case fc of             -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit@@ -446,6 +481,7 @@                 closeConnection conn QUIC.InternalError "Too many stream fragments"             Duplicated -> return ()             Reassembled -> do+                addRxCounted strm len                 ok' <- checkRxMaxData conn len                 -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit                 unless ok' $@@ -475,8 +511,31 @@     if dir == Bidirectional         then setTxMaxStreams conn n         else setTxUniMaxStreams conn n-processFrame _conn _lvl DataBlocked{} = return ()-processFrame _conn _lvl (StreamDataBlocked _sid _) = return ()+processFrame conn lvl DataBlocked{} =+    when (lvl == InitialLevel || lvl == HandshakeLevel) $+        closeConnection conn ProtocolViolation "DATA_BLOCKED in Initial or Handshake"+processFrame conn lvl (StreamDataBlocked sid _) = do+    when (lvl == InitialLevel || lvl == HandshakeLevel) $+        closeConnection+            conn+            ProtocolViolation+            "STREAM_DATA_BLOCKED in Initial or Handshake"+    when (isSendOnly conn sid) $+        closeConnection conn StreamStateError "Received in a send-only stream"+    updatePeerStreamId conn sid+    -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit+    ok <- checkRxMaxStreams conn sid+    unless ok $ closeConnection conn StreamLimitError "stream id is too large"+    mstrm0 <- findStream conn sid+    guardStream conn sid mstrm0+    -- RFC 9000 Sec 3.2: the receiving part of a stream the peer opened is+    -- created by the first STREAM, STREAM_DATA_BLOCKED or RESET_STREAM frame+    -- for it.  #129 did the last of the three; this is the other.  The peer+    -- has nothing it can send on the stream and is saying so, which is a+    -- thing to hear only when we have told it nothing may be sent -- an+    -- initial_max_stream_data of zero for that kind of stream.+    mstrm <- maybe (openStream conn sid) (return . Just) mstrm0+    forM_ mstrm $ deliverStream conn mstrm0 processFrame conn lvl (StreamsBlocked _dir n) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $         closeConnection conn ProtocolViolation "STREAMS_BLOCKED in Initial or Handshake"

@@ -277,9 +277,21 @@                                 if ok then pushToAcceptRetried ct else sendRetry                             | otherwise -> do                                 -- A token we issued in NEW_TOKEN.  It carries-                                -- a lifetime, so honour it.+                                -- a lifetime and the address it was issued+                                -- to, and both have to hold.+                                --+                                -- RFC 9000 Sec 8.1.3: "Tokens sent in+                                -- NEW_TOKEN frames MUST include information+                                -- that allows the server to verify that the+                                -- client IP address has not changed from when+                                -- the token was issued.  ...  If the client IP+                                -- address has changed, the server MUST adhere+                                -- to the anti-amplification limit".  The token+                                -- is still a token -- we do not answer with a+                                -- Retry -- but the address it arrives from has+                                -- proved nothing.                                 fresh <- isTokenFresh ct-                                pushToAcceptFirst fresh+                                pushToAcceptFirst $ fresh && isTokenAddress ct peersa                         -- A token we cannot decrypt is not a token.  RFC 9000                         -- section 8.1.3: "If the token is invalid, then the                         -- server SHOULD proceed as if the client did not have@@ -347,7 +359,7 @@         -- initial_source_connection_id       = S3   (dCID)  S2 in our server         -- original_destination_connection_id = S1   (o)         -- retry_source_connection_id         = S2   (dCID)-        pushToAcceptRetried (CryptoToken _ _ _ (Just (_, _, o))) = do+        pushToAcceptRetried (CryptoToken _ _ _ (Just (_, _, o)) _) = do             let myAuthCIDs =                     defaultAuthCIDs                         { initSrcCID = Just dCID@@ -360,10 +372,10 @@                         }             pushToAcceptQ myAuthCIDs peerAuthCIDs True         pushToAcceptRetried _ = return ()-        isTokenFresh (CryptoToken _ life etim _) = do+        isTokenFresh (CryptoToken _ life etim _ _) = do             diff <- getElapsedTimeMicrosecond etim             return $ diff <= Microseconds (fromIntegral life * 1000000)-        isRetryTokenValid (CryptoToken _tver life etim (Just (l, r, _))) = do+        isRetryTokenValid ct@(CryptoToken _tver life etim (Just (l, r, _)) _) = do             diff <- getElapsedTimeMicrosecond etim             return $                 diff <= Microseconds (fromIntegral life * 1000000)@@ -372,10 +384,18 @@                     -- Initial for ACK contains the retry token but                     -- the version would be already version 2, sigh.                     && _tver == peerVer+                    -- The address it was issued to, as for NEW_TOKEN above.+                    -- The hole is the same one: whoever holds a token of+                    -- ours can otherwise have any address treated as+                    -- validated, and the CIDs this is tied to were ours to+                    -- give and are known to whoever we gave them to.  A+                    -- Retry is answered within the round trip that prompted+                    -- it, so a client's address has had no chance to move.+                    && isTokenAddress ct peersa         isRetryTokenValid _ = return False         sendRetry = do             newdCID <- newCID-            retryToken <- generateRetryToken peerVer scTicketLifetime newdCID sCID dCID+            retryToken <- generateRetryToken peerVer scTicketLifetime newdCID sCID dCID peersa             mnewtoken <-                 timeout (Microseconds 100000) "sendRetry" $ encryptToken tokenMgr retryToken             case mnewtoken of

@@ -143,7 +143,14 @@         let conn = connResConnection connRes         setDead conn         freeResources conn-    debugLog _conn _msg = return ()+    -- Say why the connection ended.  This used to discard it, so a server+    -- connection that died of anything 'closure' does not turn into a+    -- CONNECTION_CLOSE -- which is to say anything but the four it names --+    -- went without a word to the peer and without a word in the log.  The+    -- peer talks on to a connection that is gone until the dispatcher, a+    -- second later once the connection IDs are unregistered, answers it with+    -- a Stateless Reset.+    debugLog conn msg = connDebugLog conn $ "runServer: " <> msg  createServerConnection     :: ServerConfig@@ -230,7 +237,8 @@     register (cidInfoCID cidInfo) conn     --     ver <- getVersion conn-    cryptoToken <- generateToken ver scTicketLifetime+    pathInfo <- getPathInfo conn+    cryptoToken <- generateToken ver scTicketLifetime $ peerSockAddr pathInfo     mgr <- getTokenManager conn     token <- encryptToken mgr cryptoToken     let ncid = NewConnectionID cidInfo 0

@@ -23,6 +23,11 @@     resetReceived,     setResetReceived,     markReleased,+    FinalSizeProblem (..),+    noteRxFrame,+    noteRxFinalSize,+    addRxCounted,+    takeRxUncounted,     readStreamFlowTx,     addTxStreamData,     setTxMaxStreamData,

@@ -12,6 +12,11 @@     resetReceived,     setResetReceived,     markReleased,+    FinalSizeProblem (..),+    noteRxFrame,+    noteRxFinalSize,+    addRxCounted,+    takeRxUncounted,     --     readStreamFlowTx,     addTxStreamData,@@ -126,3 +131,68 @@ checkRxMaxStreamData Stream{..} len =     atomicModifyIORef' streamFlowRx $ checkRxLimit len -}++----------------------------------------------------------------++-- | What is wrong with where a peer says its stream ends.+--+-- RFC 9000 Sec 4.5: "Once a final size for a stream is known, it cannot+-- change.  If a RESET_STREAM or STREAM frame is received indicating a change+-- in the final size for the stream, an endpoint SHOULD respond with an error+-- of type FINAL_SIZE_ERROR. ... A receiver SHOULD treat receipt of data at or+-- beyond the final size as an error of type FINAL_SIZE_ERROR, even after a+-- stream is closed."+data FinalSizeProblem+    = -- | A final size that is not the one already known+      FinalSizeChanged+    | -- | A final size below what has already been seen of the stream+      FinalSizeTooSmall+    | -- | Data at or beyond a final size already known+      DataPastFinalSize+    deriving (Eq, Show)++-- | Taking in where one STREAM frame says the stream reaches, and whether it+--   ends it.  Nothing is counted here: a frame may still turn out to be a+--   duplicate, and only what is taken counts.+noteRxFrame :: Stream -> Int -> Bool -> IO (Maybe FinalSizeProblem)+noteRxFrame Stream{..} end fin = atomicModifyIORef' streamRxBounds note+  where+    note b@RxBounds{..}+        | fin = case rxFinal of+            Just f+                | f /= end -> (b, Just FinalSizeChanged)+            _+                | end < rxHighest -> (b, Just FinalSizeTooSmall)+                | otherwise ->+                    (b{rxFinal = Just end, rxHighest = max rxHighest end}, Nothing)+        | otherwise = case rxFinal of+            Just f+                | end > f -> (b, Just DataPastFinalSize)+            _ -> (b{rxHighest = max rxHighest end}, Nothing)++-- | The same for the final size a RESET_STREAM carries.+noteRxFinalSize :: Stream -> Int -> IO (Maybe FinalSizeProblem)+noteRxFinalSize s end = noteRxFrame s end True++-- | Counting octets the connection's flow controller has taken for the+--   stream.+addRxCounted :: Stream -> Int -> IO ()+addRxCounted Stream{..} n =+    atomicModifyIORef'' streamRxBounds $ \b -> b{rxCounted = rxCounted b + n}++-- | The octets the peer spent on the stream that will never arrive, and+--   which the connection's flow controller has therefore not counted.+--+-- RFC 9000 Sec 4.5: "A receiver SHOULD use the final size to account for all+-- bytes sent on the stream in its connection-level flow controller."  Left+-- uncounted, the window we advertise falls behind what the peer believes it+-- has spent, by the tail of every stream it resets, until it has none left.+--+-- Answered once: whatever is asked for here is counted from then on.+takeRxUncounted :: Stream -> IO Int+takeRxUncounted Stream{..} = atomicModifyIORef' streamRxBounds take'+  where+    take' b@RxBounds{..} = case rxFinal of+        Just f+            | f > rxCounted -> (b{rxCounted = f}, f - rxCounted)+        _ -> (b, 0)

@@ -5,6 +5,8 @@     newStream,     TxStreamData (..),     StreamState (..),+    RxBounds (..),+    emptyRxBounds,     RecvStreamQ (..),     RxStreamData (..),     Length,@@ -45,8 +47,25 @@     -- ^ The error code of a RESET_STREAM from the peer     , streamReleased :: IORef Bool     -- ^ Whether we are done with it and have counted it so+    , streamRxBounds :: IORef RxBounds+    -- ^ What has been seen of the stream's end (RFC 9000 Sec 4.5)     } +-- | What the receiving side has seen of where a stream ends.+data RxBounds = RxBounds+    { rxCounted :: Int+    -- ^ Octets of this stream the connection's flow controller has counted:+    --   every frame taken for it, in order or not+    , rxHighest :: Int+    -- ^ The largest offset plus length seen for it+    , rxFinal :: Maybe Int+    -- ^ Its final size, once that is known+    }+    deriving (Eq, Show)++emptyRxBounds :: RxBounds+emptyRxBounds = RxBounds 0 0 Nothing+ instance Show Stream where     show s = show $ streamId s @@ -62,6 +81,7 @@     streamSyncFinTx <- newEmptyMVar     streamResetRx   <- newIORef Nothing     streamReleased  <- newIORef False+    streamRxBounds  <- newIORef emptyRxBounds     return Stream{..} {- FOURMOLU_ENABLE -} 

@@ -27,6 +27,25 @@  ---------------------------------------------------------------- +-- | How many unidirectional streams a peer may have open at once, to begin+--   with.+--+-- Three is what HTTP/3 needs and no more: a control stream and the two QPACK+-- streams (RFC 9114 Sec 6.2).  A peer given three can open nothing else --+-- not a push stream, not a stream of a type from an extension, and not one+-- of the reserved types it is meant to open now and then so that the types+-- stay extensible.  It was three here, so a client on these defaults could+-- never be pushed to, and an unknown stream type could never be tried on+-- one.+--+-- Ten leaves room for those without leaving the peer unbounded: the limit+-- counts what is open at once, and a stream gives its place back when it is+-- closed.+defaultMaxStreamsUni :: Int+defaultMaxStreamsUni = 10++----------------------------------------------------------------+ idleTimeout :: Milliseconds idleTimeout = Milliseconds 30000 

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               quic-version:            0.3.10+version:            0.3.11 license:            BSD3 license-file:       LICENSE maintainer:         kazu@iij.ad.jp@@ -238,6 +238,7 @@         QLoggerSpec         RecoverySpec         TLSSpec+        TokenSpec         TransportError         TypesSpec @@ -255,6 +256,7 @@         base16-bytestring >=1.0,         bytestring,         containers,+        crypto-token,         crypton,         directory,         filepath,

@@ -127,6 +127,20 @@             withPipe (DropClientPacket []) $ testResetOnly cc sc waitS         it "accepts a reset that overtook the data it followed" $ do             withPipe (DropClientPacket []) $ testResetOvertakes cc sc waitS+        it "accepts a stream the peer is only blocked on" $ do+            withPipe (DropClientPacket []) $ testDataBlockedOpens cc sc waitS+    describe "final size" $ do+        it "refuses a final size that is not the one already known" $ do+            withPipe (DropClientPacket []) $+                testFinalSize cc sc waitS [StreamF 0 0 ["ab"] True, StreamF 0 0 ["abcd"] True]+        it "refuses a final size below what the stream has reached" $ do+            withPipe (DropClientPacket []) $+                testFinalSize cc sc waitS [StreamF 0 0 ["abcd"] False, StreamF 0 0 ["ab"] True]+        it "refuses stream data beyond the final size" $ do+            withPipe (DropClientPacket []) $+                testFinalSize cc sc waitS [StreamF 0 0 ["ab"] True, StreamF 0 2 ["cd"] False]+        it "counts a reset stream's final size against the connection" $ do+            withPipe (DropClientPacket []) $ testResetCountsAgainstTheWindow cc sc waitS     describe "port handover" $ do         it "ignores a leftover datagram from the connection that just closed" $             withPipeStray (Randomly 20) $@@ -597,3 +611,80 @@                 unless (bs == "") recvEOF         recvEOF         resetReceived strm >>= putMVar got++-- | RFC 9000, section 3.2 again, for the other frame of the three: a+--   STREAM_DATA_BLOCKED opens the stream it names as well.+testDataBlockedOpens :: C.ClientConfig -> ServerConfig -> IO () -> IO ()+testDataBlockedOpens cc0 sc waitS = do+    got <- newEmptyMVar+    withAsync (server got) $ \_ -> do+        client+        r <- Timeout.timeout 1000000 $ takeMVar got+        r `shouldBe` Just 0+  where+    cc = cc0{ccHooks = (ccHooks cc0){onPlainCreated = blockedOnStream0}}+    blockedOnStream0 lvl plain+        | lvl == RTT1Level =+            plain{plainFrames = StreamDataBlocked 0 0 : plainFrames plain}+        | otherwise = plain+    client = do+        waitS+        -- No stream of its own: the frame above is all the server hears of+        -- stream 0.+        C.run cc $ \_conn -> threadDelay 300000+    server got = run sc $ \conn -> do+        strm <- acceptStream conn+        putMVar got $ streamId strm++-- | RFC 9000, section 4.5: where a stream ends, once said, cannot be said+--   differently, and nothing may arrive past it.  The frames go in by a hook,+--   since a well-behaved client sends none of these.+testFinalSize+    :: C.ClientConfig -> ServerConfig -> IO () -> [Frame] -> IO ()+testFinalSize cc0 sc waitS frames =+    withAsync quietServer $ \_ -> client `shouldThrow` finalSizeError+  where+    quietServer = run sc $ \conn -> forever $ void $ acceptStream conn+    cc = cc0{ccHooks = (ccHooks cc0){onPlainCreated = inject}}+    inject lvl plain+        | lvl == RTT1Level = plain{plainFrames = frames ++ plainFrames plain}+        | otherwise = plain+    client = do+        waitS+        C.run cc $ \_conn -> threadDelay 1000000++finalSizeError :: QUICException -> Bool+finalSizeError (TransportErrorIsReceived FinalSizeError _) = True+finalSizeError _ = False++flowControlError :: QUICException -> Bool+flowControlError (TransportErrorIsReceived FlowControlError _) = True+flowControlError _ = False++-- | RFC 9000, section 4.5: "A receiver SHOULD use the final size to account+--   for all bytes sent on the stream in its connection-level flow+--   controller."  A hundred thousand octets is well past what this server+--   allows for the whole connection, so a stream reset at that final size,+--   none of which arrives, is over the limit and should be answered as one.+--+-- Uncounted, as it was, it cost the peer nothing at all: the window we+-- advertise fell behind what the peer believed it had spent, by the tail of+-- every stream it reset, and nothing here noticed.+testResetCountsAgainstTheWindow+    :: C.ClientConfig -> ServerConfig -> IO () -> IO ()+testResetCountsAgainstTheWindow cc0 sc0 waitS =+    withAsync quietServer $ \_ -> client `shouldThrow` flowControlError+  where+    sc = sc0{scParameters = (scParameters sc0){initialMaxData = 1000}}+    quietServer = run sc $ \conn -> forever $ void $ acceptStream conn+    cc = cc0{ccHooks = (ccHooks cc0){onPlainCreated = inject}}+    inject lvl plain+        | lvl == RTT1Level =+            plain+                { plainFrames =+                    ResetStream 0 (ApplicationProtocolError 0) 100000 : plainFrames plain+                }+        | otherwise = plain+    client = do+        waitS+        C.run cc $ \_conn -> threadDelay 1000000

@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}++module TokenSpec where++import qualified Control.Exception as E+import qualified Crypto.Token as CT+import qualified Data.ByteString as BS+import Network.Socket+import Test.Hspec++import Network.QUIC.Internal++spec :: Spec+spec = do+    describe "a token the server issued" $ do+        it "is for the address it was issued to" $ do+            token <- generateToken Version1 3600 $ addr "127.0.0.1" 1234+            isTokenAddress token (addr "127.0.0.1" 1234) `shouldBe` True+        it "is not for another address" $ do+            token <- generateToken Version1 3600 $ addr "127.0.0.1" 1234+            isTokenAddress token (addr "127.0.0.2" 1234) `shouldBe` False+        it "is for the same address on another port" $ do+            -- A NAT hands a client a new port whenever it pleases, and+            -- RFC 9000 Sec 8.1.3 asks about the address.+            token <- generateToken Version1 3600 $ addr "127.0.0.1" 1234+            isTokenAddress token (addr "127.0.0.1" 5678) `shouldBe` True+        it "writes an IPv4 address as four octets" $ do+            token <- generateToken Version1 3600 $ addr "127.0.0.1" 1234+            tokenAddress token `shouldBe` "\127\0\0\1"+        it "writes an IPv6 address as sixteen octets" $ do+            let sa = SockAddrInet6 1234 0 (0x20010db8, 0, 0, 1) 0+            token <- generateToken Version1 3600 sa+            BS.length (tokenAddress token) `shouldBe` 16+            isTokenAddress token (SockAddrInet6 5678 0 (0x20010db8, 0, 0, 1) 0)+                `shouldBe` True+            isTokenAddress token (SockAddrInet6 1234 0 (0x20010db8, 0, 0, 2) 0)+                `shouldBe` False+        it "still knows its address after a round trip" $ do+            let cid = makeCID "01234567"+            withManager $ \mgr -> do+                token <- generateRetryToken Version1 3600 cid cid cid $ addr "127.0.0.1" 1234+                bs <- encryptToken mgr token+                mtoken <- decryptToken mgr bs+                case mtoken of+                    Nothing -> expectationFailure "the token did not come back"+                    Just token' -> do+                        isTokenAddress token' (addr "127.0.0.1" 9999) `shouldBe` True+                        isTokenAddress token' (addr "127.0.0.2" 1234) `shouldBe` False++addr :: String -> Int -> SockAddr+addr ip port = SockAddrInet (fromIntegral port) $ tupleToHostAddress $ quad ip+  where+    quad "127.0.0.1" = (127, 0, 0, 1)+    quad "127.0.0.2" = (127, 0, 0, 2)+    quad _ = error "quad"++withManager :: (CT.TokenManager -> IO a) -> IO a+withManager = E.bracket (CT.spawnTokenManager CT.defaultConfig) CT.killTokenManager

@@ -138,6 +138,16 @@                 let cc = addHook cc0 $ setOnPlainCreated handshakePathChallenge                 runCnoOp cc ms `shouldThrow` transportError         it+            "MUST send PROTOCOL_VIOLATION if STREAM_DATA_BLOCKED in Handshake is received [Transport 12.4]"+            $ \_ -> do+                let cc = addHook cc0 $ setOnPlainCreated handshakeStreamDataBlocked+                runCnoOp cc ms `shouldThrow` transportError+        it+            "MUST send PROTOCOL_VIOLATION if DATA_BLOCKED in Handshake is received [Transport 12.4]"+            $ \_ -> do+                let cc = addHook cc0 $ setOnPlainCreated handshakeDataBlocked+                runCnoOp cc ms `shouldThrow` transportError+        it             "MUST send PROTOCOL_VIOLATION if reserved bits in Short are non-zero [Transport 17.2]"             $ \_ -> do                 let cc = addHook cc0 $ setOnPlainCreated $ rrBits RTT1Level@@ -394,6 +404,21 @@ handshakePathChallenge lvl plain     | lvl == HandshakeLevel =         plain{plainFrames = PathChallenge (PathData "01234567") : plainFrames plain}+    | otherwise = plain++-- RFC 9000 Table 3 has STREAM_DATA_BLOCKED and DATA_BLOCKED in 0-RTT and+-- 1-RTT packets only, and Sec 12.4 makes a frame in a packet that may not+-- carry it a connection error of type PROTOCOL_VIOLATION.+handshakeStreamDataBlocked :: EncryptionLevel -> Plain -> Plain+handshakeStreamDataBlocked lvl plain+    | lvl == HandshakeLevel =+        plain{plainFrames = StreamDataBlocked 0 0 : plainFrames plain}+    | otherwise = plain++handshakeDataBlocked :: EncryptionLevel -> Plain -> Plain+handshakeDataBlocked lvl plain+    | lvl == HandshakeLevel =+        plain{plainFrames = DataBlocked 0 : plainFrames plain}     | otherwise = plain  noFrames :: EncryptionLevel -> Plain -> Plain