├── README.md ├── h3spec.cabal ├── LICENSE ├── fourmolu.yaml ├── h3spec.hs ├── HTTP3Error.hs └── TransportError.hs /README.md: -------------------------------------------------------------------------------- 1 | # h3spec 2 | 3 | `h3spec` is a tool to test error cases of QUIC and HTTP/3. You can find binaries for macOS and Linux in [releases](https://github.com/kazu-yamamoto/h3spec/releases). 4 | 5 | Please read [Testing QUIC servers with h3spec](https://kazu-yamamoto.hatenablog.jp/entry/2020/11/19/160606) for more information. -------------------------------------------------------------------------------- /h3spec.cabal: -------------------------------------------------------------------------------- 1 | name: h3spec 2 | version: 0.1.13 3 | synopsis: QUIC 4 | description: Test tool for error cases of QUIC and HTTP/3 5 | license: BSD3 6 | license-file: LICENSE 7 | author: Kazu Yamamoto 8 | maintainer: kazu@iij.ad.jp 9 | -- copyright: 10 | category: Web 11 | build-type: Simple 12 | -- extra-source-files: ChangeLog.md 13 | cabal-version: >= 1.10 14 | 15 | executable h3spec 16 | default-language: Haskell2010 17 | hs-source-dirs: . 18 | main-is: h3spec.hs 19 | other-modules: HTTP3Error 20 | TransportError 21 | Paths_h3spec 22 | ghc-options: -Wall -threaded -rtsopts 23 | build-depends: base >= 4.9 && < 5 24 | , bytestring 25 | , hspec 26 | , hspec-core 27 | , http-types 28 | , http3 >= 0.0.22 29 | , network 30 | , quic >= 0.2.10 && < 0.3 31 | , tls 32 | default-extensions: Strict StrictData 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020, IIJ Innovation Institute Inc. 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in 12 | the documentation and/or other materials provided with the 13 | distribution. 14 | * Neither the name of the copyright holders nor the names of its 15 | contributors may be used to endorse or promote products derived 16 | from this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 27 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 28 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 29 | POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /fourmolu.yaml: -------------------------------------------------------------------------------- 1 | # Number of spaces per indentation step 2 | indentation: 4 3 | 4 | # Max line length for automatic line breaking 5 | column-limit: 80 6 | 7 | # Styling of arrows in type signatures (choices: trailing, leading, or leading-args) 8 | function-arrows: leading 9 | 10 | # How to place commas in multi-line lists, records, etc. (choices: leading or trailing) 11 | comma-style: leading 12 | 13 | # Styling of import/export lists (choices: leading, trailing, or diff-friendly) 14 | import-export-style: diff-friendly 15 | 16 | # Whether to full-indent or half-indent 'where' bindings past the preceding body 17 | indent-wheres: false 18 | 19 | # Whether to leave a space before an opening record brace 20 | record-brace-space: false 21 | 22 | # Number of spaces between top-level declarations 23 | newlines-between-decls: 1 24 | 25 | # How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact) 26 | haddock-style: single-line 27 | 28 | # How to print module docstring 29 | haddock-style-module: null 30 | 31 | # Styling of let blocks (choices: auto, inline, newline, or mixed) 32 | let-style: inline 33 | 34 | # How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space) 35 | in-style: right-align 36 | 37 | # Whether to put parentheses around a single constraint (choices: auto, always, or never) 38 | single-constraint-parens: never 39 | 40 | # Output Unicode syntax (choices: detect, always, or never) 41 | unicode: never 42 | 43 | # Give the programmer more choice on where to insert blank lines 44 | respectful: true 45 | 46 | # Fixity information for operators 47 | fixities: [] 48 | 49 | -------------------------------------------------------------------------------- /h3spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Control.Monad (when) 6 | import Data.List (foldl', intersperse) 7 | import Data.Version (showVersion) 8 | import qualified Network.HTTP3.Client as H3 9 | import Network.QUIC.Internal 10 | import System.Console.GetOpt 11 | import System.Environment (getArgs, withArgs) 12 | import System.Exit (exitFailure, exitSuccess) 13 | import qualified Test.Hspec.Core.Runner as H 14 | 15 | import HTTP3Error 16 | import qualified Paths_h3spec as P 17 | import TransportError 18 | 19 | data Options = Options 20 | { optVersion :: Bool 21 | , optDebugLog :: Bool 22 | , optValidate :: Bool 23 | , optMatch :: [String] 24 | , optSkip :: [String] 25 | , optQLogDir :: Maybe FilePath 26 | , optKeyLogFile :: Maybe FilePath 27 | , optTimeout :: Int 28 | } 29 | deriving (Show) 30 | 31 | defaultOptions :: Options 32 | defaultOptions = 33 | Options 34 | { optVersion = False 35 | , optDebugLog = False 36 | , optValidate = True 37 | , optMatch = [] 38 | , optSkip = [] 39 | , optQLogDir = Nothing 40 | , optKeyLogFile = Nothing 41 | , optTimeout = 2000 -- 2 milliseconds 42 | } 43 | 44 | options :: [OptDescr (Options -> Options)] 45 | options = 46 | [ Option 47 | ['v'] 48 | ["version"] 49 | (NoArg (\o -> o{optVersion = True})) 50 | "Print version" 51 | , Option 52 | ['d'] 53 | ["debug"] 54 | (NoArg (\o -> o{optDebugLog = True})) 55 | "print debug info" 56 | , Option 57 | ['m'] 58 | ["match"] 59 | (ReqArg (\m o -> o{optMatch = m : optMatch o}) "") 60 | "Select test cases" 61 | , Option 62 | ['s'] 63 | ["skip"] 64 | (ReqArg (\m o -> o{optSkip = m : optSkip o}) "") 65 | "Skip test cases" 66 | , Option 67 | ['q'] 68 | ["qlog-dir"] 69 | (ReqArg (\dir o -> o{optQLogDir = Just dir}) "") 70 | "directory to store qlog" 71 | , Option 72 | ['l'] 73 | ["key-log-file"] 74 | (ReqArg (\file o -> o{optKeyLogFile = Just file}) "") 75 | "a file to store negotiated secrets" 76 | , Option 77 | ['t'] 78 | ["timeout"] 79 | (ReqArg (\ms o -> o{optTimeout = read ms}) "") 80 | "timeout for each test case (2000)" 81 | , Option 82 | ['n'] 83 | ["no-validate"] 84 | (NoArg (\o -> o{optValidate = False})) 85 | "no validating server certificates" 86 | ] 87 | 88 | showUsageAndExit :: String -> IO a 89 | showUsageAndExit msg = do 90 | putStrLn msg 91 | putStrLn $ usageInfo usage options 92 | exitFailure 93 | 94 | usage :: String 95 | usage = "Usage: h3spec " 96 | 97 | main :: IO () 98 | main = do 99 | args0 <- getArgs 100 | (opts, args) <- case getOpt Permute options args0 of 101 | (o, n, []) -> return (foldl' (flip id) defaultOptions o, n) 102 | (_, _, errs) -> showUsageAndExit $ concat errs 103 | when (optVersion opts) $ do 104 | putStrLn $ "h3spec " ++ showVersion P.version 105 | exitSuccess 106 | (host, port) <- case args of 107 | [h, p] -> return (h, p) 108 | _ -> showUsageAndExit "" 109 | let cc = 110 | defaultClientConfig 111 | { ccServerName = host 112 | , ccPortName = port 113 | , ccALPN = \_ -> return $ Just ["h3", "h3-29", "hq-interop", "hq-29"] 114 | , ccDebugLog = optDebugLog opts 115 | , ccQLog = optQLogDir opts 116 | , ccKeyLog = getLogger $ optKeyLogFile opts 117 | , ccValidate = optValidate opts 118 | } 119 | qcArgs0 120 | | null (optMatch opts) = [] 121 | | otherwise = 122 | "--match" : (intersperse "--match" $ reverse $ optMatch opts) 123 | qcArgs 124 | | null (optSkip opts) = qcArgs0 125 | | otherwise = 126 | "--skip" : (intersperse "--skip" $ reverse $ optSkip opts) 127 | h3cc = H3.ClientConfig "https" host 128 | ms = optTimeout opts 129 | H.readConfig H.defaultConfig qcArgs 130 | >>= withArgs [] . H.runSpec (transportErrorSpec cc ms >> h3ErrorSpec cc h3cc ms) 131 | >>= H.evaluateSummary 132 | 133 | getLogger :: Maybe FilePath -> (String -> IO ()) 134 | getLogger Nothing = \_ -> return () 135 | getLogger (Just file) = \msg -> appendFile file (msg ++ "\n") 136 | -------------------------------------------------------------------------------- /HTTP3Error.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | 4 | module HTTP3Error ( 5 | h3ErrorSpec, 6 | ) where 7 | 8 | import Control.Concurrent 9 | import qualified Control.Exception as E 10 | import Data.ByteString () 11 | import qualified Data.ByteString as BS 12 | import qualified Data.ByteString.Char8 as C8 13 | import Network.HTTP.Types 14 | import qualified Network.HTTP3.Client as H3 15 | import Network.HTTP3.Internal 16 | import Network.QPACK.Internal 17 | import Network.QUIC 18 | import Network.QUIC.Client 19 | import Network.QUIC.Internal hiding (timeout) 20 | import System.Timeout 21 | import Test.Hspec 22 | 23 | ---------------------------------------------------------------- 24 | 25 | type Millisecond = Int 26 | 27 | runC 28 | :: ClientConfig -> H3.ClientConfig -> H3.Config -> Millisecond -> IO (Maybe ()) 29 | runC qcc cconf conf ms = timeout us $ run qcc $ \conn -> do 30 | info <- getConnectionInfo conn 31 | case alpn info of 32 | Just proto | "hq" `BS.isPrefixOf` proto -> do 33 | waitEstablished conn 34 | putStrLn $ 35 | "Warning: " 36 | ++ C8.unpack proto 37 | ++ " is negotiated. Skipping this test. Use \"h3spec -s HTTP/3\" next time." 38 | E.throwIO $ ApplicationProtocolErrorIsReceived H3InternalError "" 39 | _ -> H3.run conn cconf conf client 40 | where 41 | us = ms * 1000 42 | client :: H3.Client () 43 | client sendRequest _aux = do 44 | let req = H3.requestNoBody methodGet "/" [] 45 | ret <- sendRequest req $ \_rsp -> return () 46 | threadDelay 100000 47 | return ret 48 | 49 | h3ErrorSpec :: ClientConfig -> H3.ClientConfig -> Millisecond -> SpecWith a 50 | h3ErrorSpec qcc cconf ms = do 51 | conf0 <- runIO H3.allocSimpleConfig 52 | describe "HTTP/3 servers" $ do 53 | it 54 | "MUST send H3_FRAME_UNEXPECTED if DATA is received before HEADERS [HTTP/3 4.1]" 55 | $ \_ -> do 56 | let conf = addHook conf0 $ setOnHeadersFrameCreated requestIllegalData 57 | runC qcc cconf conf ms 58 | `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected] 59 | it "MUST send H3_MESSAGE_ERROR if a pseudo-header is duplicated [HTTP/3 4.1.1]" $ \_ -> do 60 | let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader3 61 | qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "") 62 | runC qcc' cconf conf ms 63 | `shouldThrow` applicationProtocolErrorsIn [H3MessageError] 64 | it 65 | "MUST send H3_MESSAGE_ERROR if mandatory pseudo-header fields are absent [HTTP/3 4.1.3]" 66 | $ \_ -> do 67 | let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader0 68 | qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "") 69 | runC qcc' cconf conf ms 70 | `shouldThrow` applicationProtocolErrorsIn [H3MessageError] 71 | it 72 | "MUST send H3_MESSAGE_ERROR if prohibited pseudo-header fields are present[HTTP/3 4.1.3]" 73 | $ \_ -> do 74 | let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader1 75 | qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "") 76 | runC qcc' cconf conf ms 77 | `shouldThrow` applicationProtocolErrorsIn [H3MessageError] 78 | it 79 | "MUST send H3_MESSAGE_ERROR if pseudo-header fields exist after fields [HTTP/3 4.1.3]" 80 | $ \_ -> do 81 | let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader2 82 | qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "") 83 | runC qcc' cconf conf ms 84 | `shouldThrow` applicationProtocolErrorsIn [H3MessageError] 85 | it 86 | "MUST send H3_MISSING_SETTINGS if the first control frame is not SETTINGS [HTTP/3 6.2.1]" 87 | $ \_ -> do 88 | let conf = addHook conf0 $ setOnControlFrameCreated startWithNonSettings 89 | runC qcc cconf conf ms 90 | `shouldThrow` applicationProtocolErrorsIn [H3MissingSettings] 91 | it 92 | "MUST send H3_FRAME_UNEXPECTED if a DATA frame is received on a control stream [HTTP/3 7.2.1]" 93 | $ \_ -> do 94 | let conf = addHook conf0 $ setOnControlFrameCreated controlData 95 | runC qcc cconf conf ms 96 | `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected] 97 | it 98 | "MUST send H3_FRAME_UNEXPECTED if a HEADERS frame is received on a control stream [HTTP/3 7.2.2]" 99 | $ \_ -> do 100 | let conf = addHook conf0 $ setOnControlFrameCreated controlHeaders 101 | runC qcc cconf conf ms 102 | `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected] 103 | it 104 | "MUST send H3_FRAME_UNEXPECTED if a second SETTINGS frame is received [HTTP/3 7.2.4]" 105 | $ \_ -> do 106 | let conf = addHook conf0 $ setOnControlFrameCreated doubleSettings 107 | runC qcc cconf conf ms 108 | `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected] 109 | {- this is MAY 110 | it "MUST send H3_SETTINGS_ERROR if duplicate setting identifiers exist [HTTP/3 7.2.4]" $ \_ -> do 111 | let conf = addHook conf0 $ setOnControlFrameCreated illegalSettings0 112 | runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3SettingsError] 113 | -} 114 | it 115 | "MUST send H3_SETTINGS_ERROR if HTTP/2 settings are included [HTTP/3 7.2.4.1]" 116 | $ \_ -> do 117 | let conf = addHook conf0 $ setOnControlFrameCreated illegalSettings1 118 | runC qcc cconf conf ms 119 | `shouldThrow` applicationProtocolErrorsIn [H3SettingsError] 120 | it 121 | "MUST send H3_FRAME_UNEXPECTED if CANCEL_PUSH is received in a request stream [HTTP/3 7.2.5]" 122 | $ \_ -> do 123 | let conf = addHook conf0 $ setOnHeadersFrameCreated requestCancelPush 124 | runC qcc cconf conf ms 125 | `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected] 126 | it 127 | "MUST send QPACK_DECOMPRESSION_FAILED if an invalid static table index exits in a field line representation [QPACK 3.1]" 128 | $ \_ -> do 129 | let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader4 130 | runC qcc cconf conf ms 131 | `shouldThrow` applicationProtocolErrorsIn [QpackDecompressionFailed] 132 | it 133 | "MUST send QPACK_ENCODER_STREAM_ERROR if a new dynamic table capacity value exceeds the limit [QPACK 4.1.3]" 134 | $ \_ -> do 135 | let conf = addHook conf0 $ setOnEncoderStreamCreated largeTableCapacity 136 | runC qcc cconf conf ms 137 | `shouldThrow` applicationProtocolErrorsIn [QpackEncoderStreamError] 138 | it 139 | "MUST send H3_CLOSED_CRITICAL_STREAM if a control stream is closed [QPACK 4.2]" 140 | $ \_ -> do 141 | let conf = addHook conf0 $ setOnControlStreamCreated closeStream 142 | runC qcc cconf conf ms 143 | `shouldThrow` applicationProtocolErrorsIn [H3ClosedCriticalStream] 144 | it 145 | "MUST send QPACK_DECODER_STREAM_ERROR if Insert Count Increment is 0 [QPACK 4.4.3]" 146 | $ \_ -> do 147 | let conf = addHook conf0 $ setOnDecoderStreamCreated zeroInsertCountIncrement 148 | runC qcc cconf conf ms 149 | `shouldThrow` applicationProtocolErrorsIn [QpackDecoderStreamError] 150 | 151 | ---------------------------------------------------------------- 152 | 153 | addHook :: H3.Config -> (H3.Hooks -> H3.Hooks) -> H3.Config 154 | addHook conf modify = conf' 155 | where 156 | hooks = H3.confHooks conf 157 | hooks' = modify hooks 158 | conf' = conf{H3.confHooks = hooks'} 159 | 160 | setOnControlFrameCreated :: ([H3Frame] -> [H3Frame]) -> H3.Hooks -> H3.Hooks 161 | setOnControlFrameCreated f hooks = hooks{H3.onControlFrameCreated = f} 162 | 163 | setOnHeadersFrameCreated :: ([H3Frame] -> [H3Frame]) -> H3.Hooks -> H3.Hooks 164 | setOnHeadersFrameCreated f hooks = hooks{H3.onHeadersFrameCreated = f} 165 | 166 | setOnControlStreamCreated :: (Stream -> IO ()) -> H3.Hooks -> H3.Hooks 167 | setOnControlStreamCreated f hooks = hooks{H3.onControlStreamCreated = f} 168 | 169 | setOnEncoderStreamCreated :: (Stream -> IO ()) -> H3.Hooks -> H3.Hooks 170 | setOnEncoderStreamCreated f hooks = hooks{H3.onEncoderStreamCreated = f} 171 | 172 | setOnDecoderStreamCreated :: (Stream -> IO ()) -> H3.Hooks -> H3.Hooks 173 | setOnDecoderStreamCreated f hooks = hooks{H3.onDecoderStreamCreated = f} 174 | 175 | ---------------------------------------------------------------- 176 | 177 | startWithNonSettings :: [H3Frame] -> [H3Frame] 178 | startWithNonSettings fs = H3Frame H3FrameMaxPushId "\x01" : fs 179 | 180 | doubleSettings :: [H3Frame] -> [H3Frame] 181 | doubleSettings fs = fs ++ [H3Frame H3FrameSettings ""] 182 | 183 | controlData :: [H3Frame] -> [H3Frame] 184 | controlData fs = fs ++ [H3Frame H3FrameData ""] 185 | 186 | controlHeaders :: [H3Frame] -> [H3Frame] 187 | controlHeaders fs = fs ++ [H3Frame H3FrameHeaders ""] 188 | 189 | requestCancelPush :: [H3Frame] -> [H3Frame] 190 | requestCancelPush fs = H3Frame H3FrameCancelPush "" : fs 191 | 192 | requestIllegalData :: [H3Frame] -> [H3Frame] 193 | requestIllegalData fs = H3Frame H3FrameData "" : fs 194 | 195 | -- [(":method","GET") 196 | -- ,(":scheme","https") 197 | -- ,(":path","/") 198 | -- ] -- the absence of mandatory pseudo-header fields 199 | illegalHeader0 :: [H3Frame] -> [H3Frame] 200 | illegalHeader0 _ = [H3Frame H3FrameHeaders "\x00\x00\xd1\xd7\xc1"] 201 | 202 | -- [(":method","GET") 203 | -- ,(":scheme","https") 204 | -- ,(":autority","127.0.0.1") 205 | -- ,(":path","/") 206 | -- ,(":foo","bar") -- the presence of prohibited fields or pseudo-header fields, 207 | -- ] 208 | illegalHeader1 :: [H3Frame] -> [H3Frame] 209 | illegalHeader1 _ = 210 | [ H3Frame 211 | H3FrameHeaders 212 | "\x00\x00\xd1\xd7\x27\x02\x3a\x61\x75\x74\x6f\x72\x69\x74\x79\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\x24\x3a\x66\x6f\x6f\x03\x62\x61\x72" 213 | ] 214 | 215 | -- [(":method","GET") 216 | -- ,(":scheme","https") 217 | -- ,(":autority","127.0.0.1") 218 | -- ,("foo","bar") 219 | -- ,(":path","/") -- pseudo-header fields after fields 220 | -- ] 221 | illegalHeader2 :: [H3Frame] -> [H3Frame] 222 | illegalHeader2 _ = 223 | [ H3Frame 224 | H3FrameHeaders 225 | "\x00\x00\xd1\xd7\x27\x02\x3a\x61\x75\x74\x6f\x72\x69\x74\x79\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\x23\x66\x6f\x6f\x03\x62\x61\x72\xc1" 226 | ] 227 | 228 | -- [(":method","GET") 229 | -- ,(":scheme","https") 230 | -- ,(":authority","127.0.0.1") 231 | -- ,(":path","/") 232 | -- ,(":method","GET")] 233 | illegalHeader3 :: [H3Frame] -> [H3Frame] 234 | illegalHeader3 _ = 235 | [ H3Frame 236 | H3FrameHeaders 237 | "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xd1" 238 | ] 239 | 240 | -- [(":method","GET") 241 | -- ,(":scheme","https") 242 | -- ,(":authority","127.0.0.1") 243 | -- ,(":path","/")] ++ static index 99 244 | illegalHeader4 :: [H3Frame] -> [H3Frame] 245 | illegalHeader4 _ = 246 | [ H3Frame 247 | H3FrameHeaders 248 | "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xff\x24" 249 | ] 250 | 251 | {- 252 | -- [(SettingsQpackBlockedStreams,100) 253 | -- ,(SettingsQpackMaxTableCapacity,4096) 254 | -- ,(SettingsMaxFieldSectionSize,32768) 255 | -- ,(SettingsQpackBlockedStreams,100)] -- duplicated 256 | illegalSettings0 :: [H3Frame]-> [H3Frame] 257 | illegalSettings0 _ = [H3Frame H3FrameSettings "\x07\x40\x64\x01\x50\x00\x06\x80\x00\x80\x00\x07\x40\x64"] 258 | -} 259 | 260 | -- [(SettingsQpackBlockedStreams,100) 261 | -- ,(H3SettingsKey 0x2,200) -- HTTP/2 Settings 262 | -- ,(SettingsQpackMaxTableCapacity,4096) 263 | -- ,(SettingsMaxFieldSectionSize,32768)] 264 | illegalSettings1 :: [H3Frame] -> [H3Frame] 265 | illegalSettings1 _ = 266 | [ H3Frame 267 | H3FrameSettings 268 | "\x07\x40\x64\x02\x40\xc8\x01\x50\x00\x06\x80\x00\x80\x00" 269 | ] 270 | 271 | ---------------------------------------------------------------- 272 | 273 | -- SetDynamicTableCapacity 10000000000 274 | largeTableCapacity :: Stream -> IO () 275 | largeTableCapacity strm = sendStream strm "\x3f\xe1\xc7\xaf\xa0\x25" 276 | 277 | -- InsertCountIncrement 0 278 | zeroInsertCountIncrement :: Stream -> IO () 279 | zeroInsertCountIncrement strm = sendStream strm "\x00" 280 | 281 | ---------------------------------------------------------------- 282 | 283 | addQUICHook :: ClientConfig -> (Hooks -> Hooks) -> ClientConfig 284 | addQUICHook cc modify = cc' 285 | where 286 | cc' = cc{ccHooks = modify $ ccHooks cc} 287 | 288 | setOnResetStreamReceived 289 | :: (Stream -> ApplicationProtocolError -> IO ()) -> Hooks -> Hooks 290 | setOnResetStreamReceived f hooks = hooks{onResetStreamReceived = f} 291 | 292 | ---------------------------------------------------------------- 293 | 294 | applicationProtocolError :: QUICException -> Bool 295 | applicationProtocolError (ApplicationProtocolErrorIsReceived ae _) = ae `elem` [H3GeneralProtocolError, H3InternalError] 296 | applicationProtocolError _ = False 297 | 298 | applicationProtocolErrorsIn 299 | :: [ApplicationProtocolError] -> QUICException -> Bool 300 | applicationProtocolErrorsIn aes qe@(ApplicationProtocolErrorIsReceived ae _) = (ae `elem` aes) || applicationProtocolError qe 301 | applicationProtocolErrorsIn _ _ = False 302 | -------------------------------------------------------------------------------- /TransportError.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module TransportError ( 4 | transportErrorSpec, 5 | ) where 6 | 7 | import Control.Concurrent 8 | import Control.Monad 9 | import Data.ByteString () 10 | import qualified Data.ByteString as BS 11 | import qualified Network.TLS as TLS 12 | import Network.TLS.QUIC (ExtensionID (..), ExtensionRaw (..)) 13 | import System.Timeout 14 | import Test.Hspec 15 | 16 | import Network.QUIC.Client 17 | import Network.QUIC.Internal hiding (timeout) 18 | 19 | ---------------------------------------------------------------- 20 | 21 | type Millisecond = Int 22 | 23 | runC :: ClientConfig -> Millisecond -> (Connection -> IO a) -> IO (Maybe a) 24 | runC cc ms body = timeout us $ run cc body' 25 | where 26 | us = ms * 1000 27 | body' conn = do 28 | waitEstablished conn 29 | threadDelay 100000 30 | body conn 31 | 32 | runCnoOp :: ClientConfig -> Millisecond -> IO (Maybe ()) 33 | runCnoOp cc ms = timeout us $ run cc body' 34 | where 35 | us = ms * 1000 36 | body' conn = do 37 | waitEstablished conn 38 | threadDelay us 39 | 40 | transportErrorSpec :: ClientConfig -> Millisecond -> SpecWith a 41 | transportErrorSpec cc0 ms = do 42 | describe "QUIC servers" $ do 43 | it 44 | "MUST send FLOW_CONTROL_ERROR if a STREAM frame with a large offset is received [Transport 4.1]" 45 | $ \_ -> do 46 | let cc = addHook cc0 $ setOnPlainCreated largeOffset 47 | runCnoOp cc ms `shouldThrow` transportErrorsIn [FlowControlError] 48 | it "MUST send STREAM_LIMIT_ERROR if a stream ID exceeding the limit" $ \_ -> do 49 | let cc = addHook cc0 $ setOnPlainCreated largeStreamId 50 | runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamLimitError] 51 | it 52 | "MUST send TRANSPORT_PARAMETER_ERROR if initial_source_connection_id is missing [Transport 7.3]" 53 | $ \_ -> do 54 | let cc = addHook cc0 $ setOnTransportParametersCreated dropInitialSourceConnectionId 55 | runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError] 56 | it 57 | "MUST send TRANSPORT_PARAMETER_ERROR if original_destination_connection_id is received [Transport 18.2]" 58 | $ \_ -> do 59 | let cc = 60 | addHook cc0 $ setOnTransportParametersCreated setOriginalDestinationConnectionId 61 | runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError] 62 | it 63 | "MUST send TRANSPORT_PARAMETER_ERROR if preferred_address, is received [Transport 18.2]" 64 | $ \_ -> do 65 | let cc = addHook cc0 $ setOnTransportParametersCreated setPreferredAddress 66 | runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError] 67 | it 68 | "MUST send TRANSPORT_PARAMETER_ERROR if retry_source_connection_id is received [Transport 18.2]" 69 | $ \_ -> do 70 | let cc = addHook cc0 $ setOnTransportParametersCreated setRetrySourceConnectionId 71 | runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError] 72 | it 73 | "MUST send TRANSPORT_PARAMETER_ERROR if stateless_reset_token is received [Transport 18.2]" 74 | $ \_ -> do 75 | let cc = addHook cc0 $ setOnTransportParametersCreated setStatelessResetToken 76 | runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError] 77 | it 78 | "MUST send TRANSPORT_PARAMETER_ERROR if max_udp_payload_size < 1200 [Transport 7.4 and 18.2]" 79 | $ \_ -> do 80 | let cc = addHook cc0 $ setOnTransportParametersCreated setMaxUdpPayloadSize 81 | runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError] 82 | it 83 | "MUST send TRANSPORT_PARAMETER_ERROR if ack_delay_exponen > 20 [Transport 7.4 and 18.2]" 84 | $ \_ -> do 85 | let cc = addHook cc0 $ setOnTransportParametersCreated setAckDelayExponent 86 | runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError] 87 | it 88 | "MUST send TRANSPORT_PARAMETER_ERROR if max_ack_delay >= 2^14 [Transport 7.4 and 18.2]" 89 | $ \_ -> do 90 | let cc = addHook cc0 $ setOnTransportParametersCreated setMaxAckDelay 91 | runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError] 92 | it 93 | "MUST send FRAME_ENCODING_ERROR if a frame of unknown type is received [Transport 12.4]" 94 | $ \_ -> do 95 | let cc = addHook cc0 $ setOnPlainCreated unknownFrame 96 | runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError] 97 | it "MUST send PROTOCOL_VIOLATION on no frames [Transport 12.4]" $ \_ -> do 98 | let cc = addHook cc0 $ setOnPlainCreated noFrames 99 | runCnoOp cc ms `shouldThrow` transportError 100 | it 101 | "MUST send PROTOCOL_VIOLATION if reserved bits in Handshake are non-zero [Transport 17.2]" 102 | $ \_ -> do 103 | let cc = addHook cc0 $ setOnPlainCreated $ rrBits HandshakeLevel 104 | runCnoOp cc ms `shouldThrow` transportError 105 | it 106 | "MUST send PROTOCOL_VIOLATION if PATH_CHALLENGE in Handshake is received [Transport 17.2.4]" 107 | $ \_ -> do 108 | let cc = addHook cc0 $ setOnPlainCreated handshakePathChallenge 109 | runCnoOp cc ms `shouldThrow` transportError 110 | it 111 | "MUST send PROTOCOL_VIOLATION if reserved bits in Short are non-zero [Transport 17.2]" 112 | $ \_ -> do 113 | let cc = addHook cc0 $ setOnPlainCreated $ rrBits RTT1Level 114 | runCnoOp cc ms `shouldThrow` transportError 115 | it 116 | "MUST send STREAM_STATE_ERROR if RESET_STREAM is received for a send-only stream [Transport 19.4]" 117 | $ \_ -> do 118 | let cc = addHook cc0 $ setOnPlainCreated resetStrm 119 | runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError] 120 | it 121 | "MUST send STREAM_STATE_ERROR if STOP_SENDING is received for a non-existing stream [Transport 19.5]" 122 | $ \_ -> do 123 | let cc = addHook cc0 $ setOnPlainCreated stopSending 124 | runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError] 125 | it "MUST send PROTOCOL_VIOLATION if NEW_TOKEN is received [Transport 19.7]" $ \_ -> do 126 | let cc = addHook cc0 $ setOnPlainCreated newToken 127 | runCnoOp cc ms `shouldThrow` transportError 128 | it 129 | "MUST send STREAM_STATE_ERROR if it receives a STREAM frame for a locally-initiated stream that has not yet been created [Transport 19.8]" 130 | $ \_ -> do 131 | let cc = addHook cc0 $ setOnPlainCreated localInitiatedNotCreatedYet 132 | runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError] 133 | it 134 | "MUST send STREAM_STATE_ERROR if it receives a STREAM frame for a send-only stream [Transport 19.8]" 135 | $ \_ -> do 136 | let cc = addHook cc0 $ setOnPlainCreated sendOnlyStream 137 | runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError] 138 | it 139 | "MUST send STREAM_STATE_ERROR if MAX_STREAM_DATA is received for a stream that has not yet been created [Transport 19.10]" 140 | $ \_ -> do 141 | let cc = addHook cc0 $ setOnPlainCreated maxStreamData 142 | runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError] 143 | it 144 | "MUST send STREAM_STATE_ERROR if MAX_STREAM_DATA is received for a receive-only stream [Transport 19.10]" 145 | $ \_ -> do 146 | let cc = addHook cc0 $ setOnPlainCreated maxStreamData2 147 | runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError] 148 | it 149 | "MUST send FRAME_ENCODING_ERROR if invalid MAX_STREAMS is received [Transport 19.11]" 150 | $ \_ -> do 151 | let cc = addHook cc0 $ setOnPlainCreated maxStreams' 152 | runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError] 153 | it 154 | "MUST send STREAM_LIMIT_ERROR or FRAME_ENCODING_ERROR if invalid STREAMS_BLOCKED is received [Transport 19.14]" 155 | $ \_ -> do 156 | let cc = addHook cc0 $ setOnPlainCreated streamsBlocked 157 | runCnoOp cc ms 158 | `shouldThrow` transportErrorsIn [FrameEncodingError, StreamLimitError] 159 | it 160 | "MUST send FRAME_ENCODING_ERROR if NEW_CONNECTION_ID with invalid Retire_Prior_To is received [Transport 19.15]" 161 | $ \_ -> do 162 | let cc = addHook cc0 $ setOnPlainCreated $ newConnectionID ncidLargeRPT 163 | runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError] 164 | it 165 | "MUST send FRAME_ENCODING_ERROR if NEW_CONNECTION_ID with 0-byte CID is received [Transport 19.15]" 166 | $ \_ -> do 167 | let cc = addHook cc0 $ setOnPlainCreated $ newConnectionID ncidZeroCID 168 | runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError] 169 | it 170 | "MUST send PROTOCOL_VIOLATION if HANDSHAKE_DONE is received [Transport 19.20]" 171 | $ \_ -> do 172 | let cc = addHook cc0 $ setOnPlainCreated handshakeDone 173 | runCnoOp cc ms `shouldThrow` transportError 174 | it 175 | "MUST send unexpected_message TLS alert if KeyUpdate in Handshake is received [TLS 6]" 176 | $ \_ -> do 177 | let cc = addHook cc0 $ setOnTLSHandshakeCreated cryptoKeyUpdate 178 | runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.UnexpectedMessage] 179 | it 180 | "MUST send unexpected_message TLS alert if KeyUpdate in 1-RTT is received [TLS 6]" 181 | $ \_ -> do 182 | let cc = addHook cc0 $ setOnTLSHandshakeCreated cryptoKeyUpdate2 183 | runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.UnexpectedMessage] 184 | it 185 | "MUST send no_application_protocol TLS alert if no application protocols are supported [TLS 8.1]" 186 | $ \_ -> do 187 | let cc = cc0{ccALPN = \_ -> return $ Just ["dummy"]} 188 | runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.NoApplicationProtocol] 189 | it 190 | "MUST send missing_extension TLS alert if the quic_transport_parameters extension does not included [TLS 8.2]" 191 | $ \_ -> do 192 | let cc = addHook cc0 $ setOnTLSExtensionCreated (const []) 193 | runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.MissingExtension] 194 | it 195 | "MUST send missing_extension TLS alert if the quic_transport_parameters extension does not included [TLS 8.2]" 196 | $ \_ -> do 197 | let f [ExtensionRaw _ v] = [ExtensionRaw (ExtensionID 0xffa5) v] 198 | f _ = error "f" 199 | cc = addHook cc0 $ setOnTLSExtensionCreated f 200 | runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.MissingExtension] 201 | it 202 | "MUST send unexpected_message TLS alert if EndOfEarlyData is received [TLS 8.3]" 203 | $ \_ -> do 204 | let cc = addHook cc0 $ setOnTLSHandshakeCreated cryptoEndOfEarlyData 205 | runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.UnexpectedMessage] 206 | it "MUST send PROTOCOL_VIOLATION if CRYPTO in 0-RTT is received [TLS 8.3]" $ \_ -> do 207 | mres <- runC cc0 ms getResumptionInfo 208 | case mres of 209 | Just res 210 | | is0RTTPossible res -> do 211 | let cc1 = addHook cc0 $ setOnTLSHandshakeCreated crypto0RTT 212 | cc = 213 | cc1 214 | { ccResumption = res 215 | , ccUse0RTT = True 216 | } 217 | runCnoOp cc ms `shouldThrow` transportError 218 | _ -> do 219 | putStrLn 220 | "Warning: 0-RTT is not possible. Skipping this test. Use \"h3spec -s 0-RTT\" next time." 221 | when (ccDebugLog cc0) $ print mres 222 | 223 | ---------------------------------------------------------------- 224 | 225 | addHook :: ClientConfig -> (Hooks -> Hooks) -> ClientConfig 226 | addHook cc modify = cc' 227 | where 228 | cc' = cc{ccHooks = modify $ ccHooks cc} 229 | 230 | setOnPlainCreated :: (EncryptionLevel -> Plain -> Plain) -> Hooks -> Hooks 231 | setOnPlainCreated f hooks = hooks{onPlainCreated = f} 232 | 233 | setOnTransportParametersCreated :: (Parameters -> Parameters) -> Hooks -> Hooks 234 | setOnTransportParametersCreated f hooks = hooks{onTransportParametersCreated = f} 235 | 236 | setOnTLSExtensionCreated :: ([ExtensionRaw] -> [ExtensionRaw]) -> Hooks -> Hooks 237 | setOnTLSExtensionCreated f params = params{onTLSExtensionCreated = f} 238 | 239 | setOnTLSHandshakeCreated 240 | :: ([(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool)) 241 | -> Hooks 242 | -> Hooks 243 | setOnTLSHandshakeCreated f hooks = hooks{onTLSHandshakeCreated = f} 244 | 245 | ---------------------------------------------------------------- 246 | 247 | rrBits :: EncryptionLevel -> EncryptionLevel -> Plain -> Plain 248 | rrBits lvl0 lvl plain 249 | | lvl0 == lvl = 250 | if plainPacketNumber plain /= 0 251 | then plain{plainFlags = Flags 0x08} 252 | else plain 253 | | otherwise = plain 254 | 255 | dropInitialSourceConnectionId :: Parameters -> Parameters 256 | dropInitialSourceConnectionId params = params{initialSourceConnectionId = Nothing} 257 | 258 | dummyCID :: Maybe CID 259 | dummyCID = Just $ toCID "DUMMY" 260 | 261 | setOriginalDestinationConnectionId :: Parameters -> Parameters 262 | setOriginalDestinationConnectionId params = params{originalDestinationConnectionId = dummyCID} 263 | 264 | setPreferredAddress :: Parameters -> Parameters 265 | setPreferredAddress params = params{preferredAddress = Just prefAddr} 266 | where 267 | prefAddr = 268 | BS.concat 269 | [ "\x7f\x00\x00\x01" 270 | , "\x01\xbb" 271 | , "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" 272 | , "\x00\x00" 273 | , "\x08" 274 | , "\x00\x01\x02\x03\x04\x05\x06\x07" 275 | , "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f" 276 | ] 277 | 278 | setRetrySourceConnectionId :: Parameters -> Parameters 279 | setRetrySourceConnectionId params = params{retrySourceConnectionId = dummyCID} 280 | 281 | setStatelessResetToken :: Parameters -> Parameters 282 | setStatelessResetToken params = params{statelessResetToken = Just $ StatelessResetToken "DUMMY"} 283 | 284 | ---------------------------------------------------------------- 285 | 286 | setMaxUdpPayloadSize :: Parameters -> Parameters 287 | setMaxUdpPayloadSize params = params{maxUdpPayloadSize = 1090} 288 | 289 | setAckDelayExponent :: Parameters -> Parameters 290 | setAckDelayExponent params = params{ackDelayExponent = 30} 291 | 292 | setMaxAckDelay :: Parameters -> Parameters 293 | setMaxAckDelay params = params{maxAckDelay = 2 ^ (15 :: Int)} 294 | 295 | ---------------------------------------------------------------- 296 | 297 | -- Stream 0 is not created internally. It is assumed that a server 298 | -- send CC without sending back Stream 0. If the server send back any 299 | -- data for Stream 0, `streamNotCreatedYet` throws an exception, sigh. 300 | largeOffset :: EncryptionLevel -> Plain -> Plain 301 | largeOffset lvl plain 302 | | lvl == RTT1Level = plain{plainFrames = fake : plainFrames plain} 303 | | otherwise = plain 304 | where 305 | fake = StreamF 0 100000000 ["GET /\r\n"] True 306 | 307 | largeStreamId :: EncryptionLevel -> Plain -> Plain 308 | largeStreamId lvl plain 309 | | lvl == RTT1Level = plain{plainFrames = fake : plainFrames plain} 310 | | otherwise = plain 311 | where 312 | fake = StreamF 1000000000 0 ["GET /\r\n"] True 313 | 314 | unknownFrame :: EncryptionLevel -> Plain -> Plain 315 | unknownFrame lvl plain 316 | | lvl == RTT1Level = 317 | plain{plainFrames = UnknownFrame 0x20 : plainFrames plain} 318 | | otherwise = plain 319 | 320 | handshakePathChallenge :: EncryptionLevel -> Plain -> Plain 321 | handshakePathChallenge lvl plain 322 | | lvl == HandshakeLevel = 323 | plain{plainFrames = PathChallenge (PathData "01234567") : plainFrames plain} 324 | | otherwise = plain 325 | 326 | noFrames :: EncryptionLevel -> Plain -> Plain 327 | noFrames lvl plain 328 | | lvl == RTT1Level = 329 | plain 330 | { plainFrames = [] 331 | , plainMarks = set4bytesPN $ setNoPaddings $ plainMarks plain 332 | } 333 | | otherwise = plain 334 | 335 | handshakeDone :: EncryptionLevel -> Plain -> Plain 336 | handshakeDone lvl plain 337 | | lvl == RTT1Level = plain{plainFrames = HandshakeDone : plainFrames plain} 338 | | otherwise = plain 339 | 340 | newToken :: EncryptionLevel -> Plain -> Plain 341 | newToken lvl plain 342 | | lvl == RTT1Level = 343 | plain{plainFrames = NewToken "DUMMY" : plainFrames plain} 344 | | otherwise = plain 345 | 346 | localInitiatedNotCreatedYet :: EncryptionLevel -> Plain -> Plain 347 | localInitiatedNotCreatedYet lvl plain 348 | | lvl == RTT1Level = 349 | plain{plainFrames = StreamF 1 0 [""] False : plainFrames plain} 350 | | otherwise = plain 351 | 352 | sendOnlyStream :: EncryptionLevel -> Plain -> Plain 353 | sendOnlyStream lvl plain 354 | | lvl == RTT1Level = 355 | plain{plainFrames = StreamF 3 0 [""] False : plainFrames plain} 356 | | otherwise = plain 357 | 358 | resetStrm :: EncryptionLevel -> Plain -> Plain 359 | resetStrm lvl plain 360 | | lvl == RTT1Level = 361 | plain 362 | { plainFrames = ResetStream 3 (ApplicationProtocolError 0) 0 : plainFrames plain 363 | } 364 | | otherwise = plain 365 | 366 | stopSending :: EncryptionLevel -> Plain -> Plain 367 | stopSending lvl plain 368 | | lvl == RTT1Level = 369 | plain 370 | { plainFrames = StopSending 101 (ApplicationProtocolError 0) : plainFrames plain 371 | } 372 | | otherwise = plain 373 | 374 | maxStreamData :: EncryptionLevel -> Plain -> Plain 375 | maxStreamData lvl plain 376 | | lvl == RTT1Level = 377 | plain{plainFrames = MaxStreamData 101 1000000 : plainFrames plain} 378 | | otherwise = plain 379 | 380 | maxStreamData2 :: EncryptionLevel -> Plain -> Plain 381 | maxStreamData2 lvl plain 382 | | lvl == RTT1Level = 383 | plain{plainFrames = MaxStreamData 2 1000000 : plainFrames plain} 384 | | otherwise = plain 385 | 386 | maxStreams' :: EncryptionLevel -> Plain -> Plain 387 | maxStreams' lvl plain 388 | | lvl == RTT1Level = 389 | plain 390 | { plainFrames = MaxStreams Bidirectional (2 ^ (60 :: Int) + 1) : plainFrames plain 391 | } 392 | | otherwise = plain 393 | 394 | streamsBlocked :: EncryptionLevel -> Plain -> Plain 395 | streamsBlocked lvl plain 396 | | lvl == RTT1Level = 397 | plain 398 | { plainFrames = 399 | StreamsBlocked Bidirectional (2 ^ (60 :: Int) + 1) : plainFrames plain 400 | } 401 | | otherwise = plain 402 | 403 | newConnectionID :: (Frame -> Frame) -> EncryptionLevel -> Plain -> Plain 404 | newConnectionID f lvl plain 405 | | lvl == RTT1Level = plain{plainFrames = map f $ plainFrames plain} 406 | | otherwise = plain 407 | 408 | ncidZeroCID :: Frame -> Frame 409 | ncidZeroCID (NewConnectionID cidinfo0 rpt) = NewConnectionID cidinfo rpt 410 | where 411 | cidinfo = cidinfo0{cidInfoCID = CID ""} 412 | ncidZeroCID frame = frame 413 | 414 | ncidLargeRPT :: Frame -> Frame 415 | ncidLargeRPT (NewConnectionID cidinfo rpt) = NewConnectionID cidinfo (rpt + 10) 416 | ncidLargeRPT frame = frame 417 | 418 | ---------------------------------------------------------------- 419 | 420 | cryptoKeyUpdate 421 | :: [(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool) 422 | cryptoKeyUpdate [(HandshakeLevel, fin)] = ([(HandshakeLevel, BS.append fin "\x18\x00\x00\x01\x01")], False) 423 | cryptoKeyUpdate lcs = (lcs, False) 424 | 425 | cryptoKeyUpdate2 426 | :: [(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool) 427 | -- [] is intentionally created in RTT1Level for h3spec 428 | cryptoKeyUpdate2 [] = ([(RTT1Level, "\x18\x00\x00\x01\x01")], False) 429 | cryptoKeyUpdate2 lcs = (lcs, False) 430 | 431 | cryptoEndOfEarlyData 432 | :: [(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool) 433 | cryptoEndOfEarlyData [(HandshakeLevel, fin)] = ([(HandshakeLevel, BS.append "\x05\x00\x00\x00" fin)], False) 434 | cryptoEndOfEarlyData lcs = (lcs, False) 435 | 436 | crypto0RTT 437 | :: [(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool) 438 | crypto0RTT [(InitialLevel, ch)] = ([(InitialLevel, ch), (RTT0Level, "\x08\x00\x00\x02\x00\x00")], True) 439 | crypto0RTT lcs = (lcs, False) 440 | 441 | ---------------------------------------------------------------- 442 | 443 | transportError :: QUICException -> Bool 444 | transportError (TransportErrorIsReceived te _) = te `elem` [ProtocolViolation, InternalError] 445 | transportError _ = False 446 | 447 | -- Transport Sec 11: 448 | -- In particular, an endpoint MAY use any applicable error code when 449 | -- it detects an error condition; a generic error code (such as 450 | -- PROTOCOL_VIOLATION or INTERNAL_ERROR) can always be used in place 451 | -- of specific error codes. 452 | transportErrorsIn :: [TransportError] -> QUICException -> Bool 453 | transportErrorsIn tes qe@(TransportErrorIsReceived te _) = (te `elem` tes) || transportError qe 454 | transportErrorsIn _ _ = False 455 | 456 | cryptoErrorX :: QUICException -> Bool 457 | cryptoErrorX (TransportErrorIsReceived te _) = te `elem` [cryptoError TLS.InternalError, cryptoError TLS.HandshakeFailure] 458 | cryptoErrorX _ = False 459 | 460 | -- Crypto Sec 4.8: QUIC permits the use of a generic code in place of 461 | -- a specific error code; see Section 11 of [QUIC-TRANSPORT]. For TLS 462 | -- alerts, this includes replacing any alert with a generic alert, 463 | -- such as handshake_failure (0x128 in QUIC). Endpoints MAY use a 464 | -- generic error code to avoid possibly exposing confidential 465 | -- information. 466 | cryptoErrorsIn :: [TLS.AlertDescription] -> QUICException -> Bool 467 | cryptoErrorsIn tes qe@(TransportErrorIsReceived te _) = (te `elem` map cryptoError tes) || cryptoErrorX qe 468 | cryptoErrorsIn _ _ = False 469 | --------------------------------------------------------------------------------