h3spec (empty) → 0.1.10
raw patch · 5 files changed
+963/−0 lines, 5 filesdep +basedep +bytestringdep +hspec
Dependencies added: base, bytestring, hspec, hspec-core, http-types, http3, network, quic, tls, unliftio
Files
- HTTP3Error.hs +301/−0
- LICENSE +29/−0
- TransportError.hs +465/−0
- h3spec.cabal +33/−0
- h3spec.hs +135/−0
+ HTTP3Error.hs view
@@ -0,0 +1,301 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++module HTTP3Error (+ h3ErrorSpec,+) where++import Control.Concurrent+import Data.ByteString ()+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8+import Network.HTTP.Types+import qualified Network.HTTP3.Client as H3+import Network.HTTP3.Internal+import Network.QPACK.Internal+import Network.QUIC+import Network.QUIC.Client+import Network.QUIC.Internal hiding (timeout)+import Test.Hspec+import qualified UnliftIO.Exception as E+import UnliftIO.Timeout++----------------------------------------------------------------++type Millisecond = Int++runC+ :: ClientConfig -> H3.ClientConfig -> H3.Config -> Millisecond -> IO (Maybe ())+runC 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+ putStrLn $+ "Warning: "+ ++ C8.unpack proto+ ++ " is negotiated. Skipping this test. Use \"h3spec -s HTTP/3\" next time."+ E.throwIO $ ApplicationProtocolErrorIsReceived H3InternalError ""+ _ -> H3.run conn cconf conf client+ where+ us = ms * 1000+ client :: H3.Client ()+ client sendRequest _aux = do+ let req = H3.requestNoBody methodGet "/" []+ ret <- sendRequest req $ \_rsp -> return ()+ threadDelay 100000+ return ret++h3ErrorSpec :: ClientConfig -> H3.ClientConfig -> Millisecond -> SpecWith a+h3ErrorSpec qcc cconf ms = do+ conf0 <- runIO H3.allocSimpleConfig+ describe "HTTP/3 servers" $ do+ it+ "MUST send H3_FRAME_UNEXPECTED if DATA is received before HEADERS [HTTP/3 4.1]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnHeadersFrameCreated requestIllegalData+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+ it "MUST send H3_MESSAGE_ERROR if a pseudo-header is duplicated [HTTP/3 4.1.1]" $ \_ -> do+ let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader3+ qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")+ runC qcc' cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3MessageError]+ it+ "MUST send H3_MESSAGE_ERROR if mandatory pseudo-header fields are absent [HTTP/3 4.1.3]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader0+ qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")+ runC qcc' cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3MessageError]+ it+ "MUST send H3_MESSAGE_ERROR if prohibited pseudo-header fields are present[HTTP/3 4.1.3]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader1+ qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")+ runC qcc' cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3MessageError]+ it+ "MUST send H3_MESSAGE_ERROR if pseudo-header fields exist after fields [HTTP/3 4.1.3]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader2+ qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "")+ runC qcc' cconf conf 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+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3MissingSettings]+ it+ "MUST send H3_FRAME_UNEXPECTED if a DATA frame is received on a control stream [HTTP/3 7.2.1]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnControlFrameCreated controlData+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+ it+ "MUST send H3_FRAME_UNEXPECTED if a HEADERS frame is received on a control stream [HTTP/3 7.2.2]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnControlFrameCreated controlHeaders+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+ it+ "MUST send H3_FRAME_UNEXPECTED if a second SETTINGS frame is received [HTTP/3 7.2.4]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnControlFrameCreated doubleSettings+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+ {- this is MAY+ it "MUST send H3_SETTINGS_ERROR if duplicate setting identifiers exist [HTTP/3 7.2.4]" $ \_ -> do+ let conf = addHook conf0 $ setOnControlFrameCreated illegalSettings0+ runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3SettingsError]+ -}+ it+ "MUST send H3_SETTINGS_ERROR if HTTP/2 settings are included [HTTP/3 7.2.4.1]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnControlFrameCreated illegalSettings1+ 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+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3FrameUnexpected]+ it+ "MUST send QPACK_DECOMPRESSION_FAILED if an invalid static table index exits in a field line representation [QPACK 3.1]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader4+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [QpackDecompressionFailed]+ 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+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [QpackEncoderStreamError]+ it+ "MUST send H3_CLOSED_CRITICAL_STREAM if a control stream is closed [QPACK 4.2]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnControlStreamCreated closeStream+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [H3ClosedCriticalStream]+ it+ "MUST send QPACK_DECODER_STREAM_ERROR if Insert Count Increment is 0 [QPACK 4.4.3]"+ $ \_ -> do+ let conf = addHook conf0 $ setOnDecoderStreamCreated zeroInsertCountIncrement+ runC qcc cconf conf ms+ `shouldThrow` applicationProtocolErrorsIn [QpackDecoderStreamError]++----------------------------------------------------------------++addHook :: H3.Config -> (H3.Hooks -> H3.Hooks) -> H3.Config+addHook conf modify = conf'+ where+ hooks = H3.confHooks conf+ hooks' = modify hooks+ conf' = conf{H3.confHooks = hooks'}++setOnControlFrameCreated :: ([H3Frame] -> [H3Frame]) -> H3.Hooks -> H3.Hooks+setOnControlFrameCreated f hooks = hooks{H3.onControlFrameCreated = f}++setOnHeadersFrameCreated :: ([H3Frame] -> [H3Frame]) -> H3.Hooks -> H3.Hooks+setOnHeadersFrameCreated f hooks = hooks{H3.onHeadersFrameCreated = f}++setOnControlStreamCreated :: (Stream -> IO ()) -> H3.Hooks -> H3.Hooks+setOnControlStreamCreated f hooks = hooks{H3.onControlStreamCreated = f}++setOnEncoderStreamCreated :: (Stream -> IO ()) -> H3.Hooks -> H3.Hooks+setOnEncoderStreamCreated f hooks = hooks{H3.onEncoderStreamCreated = f}++setOnDecoderStreamCreated :: (Stream -> IO ()) -> H3.Hooks -> H3.Hooks+setOnDecoderStreamCreated f hooks = hooks{H3.onDecoderStreamCreated = f}++----------------------------------------------------------------++startWithNonSettings :: [H3Frame] -> [H3Frame]+startWithNonSettings fs = H3Frame H3FrameMaxPushId "\x01" : fs++doubleSettings :: [H3Frame] -> [H3Frame]+doubleSettings fs = fs ++ [H3Frame H3FrameSettings ""]++controlData :: [H3Frame] -> [H3Frame]+controlData fs = fs ++ [H3Frame H3FrameData ""]++controlHeaders :: [H3Frame] -> [H3Frame]+controlHeaders fs = fs ++ [H3Frame H3FrameHeaders ""]++requestCancelPush :: [H3Frame] -> [H3Frame]+requestCancelPush fs = H3Frame H3FrameCancelPush "" : fs++requestIllegalData :: [H3Frame] -> [H3Frame]+requestIllegalData fs = H3Frame H3FrameData "" : fs++-- [(":method","GET")+-- ,(":scheme","https")+-- ,(":path","/")+-- ] -- the absence of mandatory pseudo-header fields+illegalHeader0 :: [H3Frame] -> [H3Frame]+illegalHeader0 _ = [H3Frame H3FrameHeaders "\x00\x00\xd1\xd7\xc1"]++-- [(":method","GET")+-- ,(":scheme","https")+-- ,(":autority","127.0.0.1")+-- ,(":path","/")+-- ,(":foo","bar") -- the presence of prohibited fields or pseudo-header fields,+-- ]+illegalHeader1 :: [H3Frame] -> [H3Frame]+illegalHeader1 _ =+ [ H3Frame+ H3FrameHeaders+ "\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"+ ]++-- [(":method","GET")+-- ,(":scheme","https")+-- ,(":autority","127.0.0.1")+-- ,("foo","bar")+-- ,(":path","/") -- pseudo-header fields after fields+-- ]+illegalHeader2 :: [H3Frame] -> [H3Frame]+illegalHeader2 _ =+ [ H3Frame+ H3FrameHeaders+ "\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"+ ]++-- [(":method","GET")+-- ,(":scheme","https")+-- ,(":authority","127.0.0.1")+-- ,(":path","/")+-- ,(":method","GET")]+illegalHeader3 :: [H3Frame] -> [H3Frame]+illegalHeader3 _ =+ [ H3Frame+ H3FrameHeaders+ "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xd1"+ ]++-- [(":method","GET")+-- ,(":scheme","https")+-- ,(":authority","127.0.0.1")+-- ,(":path","/")] ++ static index 99+illegalHeader4 :: [H3Frame] -> [H3Frame]+illegalHeader4 _ =+ [ H3Frame+ H3FrameHeaders+ "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xff\x24"+ ]++{-+-- [(SettingsQpackBlockedStreams,100)+-- ,(SettingsQpackMaxTableCapacity,4096)+-- ,(SettingsMaxFieldSectionSize,32768)+-- ,(SettingsQpackBlockedStreams,100)] -- duplicated+illegalSettings0 :: [H3Frame]-> [H3Frame]+illegalSettings0 _ = [H3Frame H3FrameSettings "\x07\x40\x64\x01\x50\x00\x06\x80\x00\x80\x00\x07\x40\x64"]+-}++-- [(SettingsQpackBlockedStreams,100)+-- ,(H3SettingsKey 0x2,200) -- HTTP/2 Settings+-- ,(SettingsQpackMaxTableCapacity,4096)+-- ,(SettingsMaxFieldSectionSize,32768)]+illegalSettings1 :: [H3Frame] -> [H3Frame]+illegalSettings1 _ =+ [ H3Frame+ H3FrameSettings+ "\x07\x40\x64\x02\x40\xc8\x01\x50\x00\x06\x80\x00\x80\x00"+ ]++----------------------------------------------------------------++-- SetDynamicTableCapacity 10000000000+largeTableCapacity :: Stream -> IO ()+largeTableCapacity strm = sendStream strm "\x3f\xe1\xc7\xaf\xa0\x25"++-- InsertCountIncrement 0+zeroInsertCountIncrement :: Stream -> IO ()+zeroInsertCountIncrement strm = sendStream strm "\x00"++----------------------------------------------------------------++addQUICHook :: ClientConfig -> (Hooks -> Hooks) -> ClientConfig+addQUICHook cc modify = cc'+ where+ cc' = cc{ccHooks = modify $ ccHooks cc}++setOnResetStreamReceived+ :: (Stream -> ApplicationProtocolError -> IO ()) -> Hooks -> Hooks+setOnResetStreamReceived f hooks = hooks{onResetStreamReceived = f}++----------------------------------------------------------------++applicationProtocolError :: QUICException -> Bool+applicationProtocolError (ApplicationProtocolErrorIsReceived ae _) = ae `elem` [H3GeneralProtocolError, H3InternalError]+applicationProtocolError _ = False++applicationProtocolErrorsIn+ :: [ApplicationProtocolError] -> QUICException -> Bool+applicationProtocolErrorsIn aes qe@(ApplicationProtocolErrorIsReceived ae _) = (ae `elem` aes) || applicationProtocolError qe+applicationProtocolErrorsIn _ _ = False
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2020, IIJ Innovation Institute Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in+ the documentation and/or other materials provided with the+ distribution.+ * Neither the name of the copyright holders nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ TransportError.hs view
@@ -0,0 +1,465 @@+{-# LANGUAGE OverloadedStrings #-}++module TransportError (+ transportErrorSpec,+) where++import Control.Monad+import Data.ByteString ()+import qualified Data.ByteString as BS+import qualified Network.TLS as TLS+import Network.TLS.QUIC (ExtensionID (..), ExtensionRaw (..))+import Test.Hspec+import UnliftIO.Concurrent+import UnliftIO.Timeout++import Network.QUIC.Client+import Network.QUIC.Internal hiding (timeout)++----------------------------------------------------------------++type Millisecond = Int++runC :: ClientConfig -> Millisecond -> (Connection -> IO a) -> IO (Maybe a)+runC cc ms body = timeout us $ run cc body'+ where+ us = ms * 1000+ body' conn = do+ waitEstablished conn+ threadDelay 100000+ body conn++runCnoOp :: ClientConfig -> Millisecond -> IO (Maybe ())+runCnoOp cc ms = timeout us $ run cc body'+ where+ us = ms * 1000+ body' conn = do+ waitEstablished conn+ threadDelay us++transportErrorSpec :: ClientConfig -> Millisecond -> SpecWith a+transportErrorSpec cc0 ms = do+ describe "QUIC servers" $ do+ it+ "MUST send FLOW_CONTROL_ERROR if a STREAM frame with a large offset is received [Transport 4.1]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated largeOffset+ runCnoOp cc ms `shouldThrow` transportErrorsIn [FlowControlError]+ it "MUST send STREAM_LIMIT_ERROR if a stream ID exceeding the limit" $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated largeStreamId+ runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamLimitError]+ it+ "MUST send TRANSPORT_PARAMETER_ERROR if initial_source_connection_id is missing [Transport 7.3]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTransportParametersCreated dropInitialSourceConnectionId+ runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+ it+ "MUST send TRANSPORT_PARAMETER_ERROR if original_destination_connection_id is received [Transport 18.2]"+ $ \_ -> do+ let cc =+ addHook cc0 $ setOnTransportParametersCreated setOriginalDestinationConnectionId+ runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+ it+ "MUST send TRANSPORT_PARAMETER_ERROR if preferred_address, is received [Transport 18.2]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTransportParametersCreated setPreferredAddress+ runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+ it+ "MUST send TRANSPORT_PARAMETER_ERROR if retry_source_connection_id is received [Transport 18.2]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTransportParametersCreated setRetrySourceConnectionId+ runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+ it+ "MUST send TRANSPORT_PARAMETER_ERROR if stateless_reset_token is received [Transport 18.2]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTransportParametersCreated setStatelessResetToken+ runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+ it+ "MUST send TRANSPORT_PARAMETER_ERROR if max_udp_payload_size < 1200 [Transport 7.4 and 18.2]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTransportParametersCreated setMaxUdpPayloadSize+ runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+ it+ "MUST send TRANSPORT_PARAMETER_ERROR if ack_delay_exponen > 20 [Transport 7.4 and 18.2]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTransportParametersCreated setAckDelayExponent+ runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+ it+ "MUST send TRANSPORT_PARAMETER_ERROR if max_ack_delay >= 2^14 [Transport 7.4 and 18.2]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTransportParametersCreated setMaxAckDelay+ runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+ it+ "MUST send FRAME_ENCODING_ERROR if a frame of unknown type is received [Transport 12.4]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated unknownFrame+ runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError]+ it "MUST send PROTOCOL_VIOLATION on no frames [Transport 12.4]" $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated noFrames+ runCnoOp cc ms `shouldThrow` transportError+ it+ "MUST send PROTOCOL_VIOLATION if reserved bits in Handshake are non-zero [Transport 17.2]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated $ rrBits HandshakeLevel+ runCnoOp cc ms `shouldThrow` transportError+ it+ "MUST send PROTOCOL_VIOLATION if PATH_CHALLENGE in Handshake is received [Transport 17.2.4]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated handshakePathChallenge+ 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+ runCnoOp cc ms `shouldThrow` transportError+ it+ "MUST send STREAM_STATE_ERROR if RESET_STREAM is received for a send-only stream [Transport 19.4]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated resetStrm+ runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+ it+ "MUST send STREAM_STATE_ERROR if STOP_SENDING is received for a non-existing stream [Transport 19.5]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated stopSending+ runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+ it "MUST send PROTOCOL_VIOLATION if NEW_TOKEN is received [Transport 19.7]" $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated newToken+ runCnoOp cc ms `shouldThrow` transportError+ it+ "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]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated localInitiatedNotCreatedYet+ runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+ it+ "MUST send STREAM_STATE_ERROR if it receives a STREAM frame for a send-only stream [Transport 19.8]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated sendOnlyStream+ runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+ it+ "MUST send STREAM_STATE_ERROR if MAX_STREAM_DATA is received for a stream that has not yet been created [Transport 19.10]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated maxStreamData+ runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+ it+ "MUST send STREAM_STATE_ERROR if MAX_STREAM_DATA is received for a receive-only stream [Transport 19.10]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated maxStreamData2+ runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+ it+ "MUST send FRAME_ENCODING_ERROR if invalid MAX_STREAMS is received [Transport 19.11]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated maxStreams'+ runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError]+ it+ "MUST send STREAM_LIMIT_ERROR or FRAME_ENCODING_ERROR if invalid STREAMS_BLOCKED is received [Transport 19.14]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated streamsBlocked+ runCnoOp cc ms+ `shouldThrow` transportErrorsIn [FrameEncodingError, StreamLimitError]+ it+ "MUST send FRAME_ENCODING_ERROR if NEW_CONNECTION_ID with invalid Retire_Prior_To is received [Transport 19.15]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated $ newConnectionID ncidLargeRPT+ runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError]+ it+ "MUST send FRAME_ENCODING_ERROR if NEW_CONNECTION_ID with 0-byte CID is received [Transport 19.15]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated $ newConnectionID ncidZeroCID+ runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError]+ it+ "MUST send PROTOCOL_VIOLATION if HANDSHAKE_DONE is received [Transport 19.20]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnPlainCreated handshakeDone+ runCnoOp cc ms `shouldThrow` transportError+ it+ "MUST send unexpected_message TLS alert if KeyUpdate in Handshake is received [TLS 6]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTLSHandshakeCreated cryptoKeyUpdate+ runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.UnexpectedMessage]+ it+ "MUST send unexpected_message TLS alert if KeyUpdate in 1-RTT is received [TLS 6]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTLSHandshakeCreated cryptoKeyUpdate2+ runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.UnexpectedMessage]+ it+ "MUST send no_application_protocol TLS alert if no application protocols are supported [TLS 8.1]"+ $ \_ -> do+ let cc = cc0{ccALPN = \_ -> return $ Just ["dummy"]}+ runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.NoApplicationProtocol]+ it+ "MUST send missing_extension TLS alert if the quic_transport_parameters extension does not included [TLS 8.2]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTLSExtensionCreated (const [])+ runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.MissingExtension]+ it+ "MUST send missing_extension TLS alert if the quic_transport_parameters extension does not included [TLS 8.2]"+ $ \_ -> do+ let f [ExtensionRaw _ v] = [ExtensionRaw (ExtensionID 0xffa5) v]+ f _ = error "f"+ cc = addHook cc0 $ setOnTLSExtensionCreated f+ runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.MissingExtension]+ it+ "MUST send unexpected_message TLS alert if EndOfEarlyData is received [TLS 8.3]"+ $ \_ -> do+ let cc = addHook cc0 $ setOnTLSHandshakeCreated cryptoEndOfEarlyData+ runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.UnexpectedMessage]+ it "MUST send PROTOCOL_VIOLATION if CRYPTO in 0-RTT is received [TLS 8.3]" $ \_ -> do+ mres <- runC cc0 ms getResumptionInfo+ case mres of+ Just res+ | is0RTTPossible res -> do+ let cc1 = addHook cc0 $ setOnTLSHandshakeCreated crypto0RTT+ cc =+ cc1+ { ccResumption = res+ , ccUse0RTT = True+ }+ runCnoOp cc ms `shouldThrow` transportError+ _ -> do+ putStrLn+ "Warning: 0-RTT is not possible. Skipping this test. Use \"h3spec -s 0-RTT\" next time."+ when (ccDebugLog cc0) $ print mres++----------------------------------------------------------------++addHook :: ClientConfig -> (Hooks -> Hooks) -> ClientConfig+addHook cc modify = cc'+ where+ cc' = cc{ccHooks = modify $ ccHooks cc}++setOnPlainCreated :: (EncryptionLevel -> Plain -> Plain) -> Hooks -> Hooks+setOnPlainCreated f hooks = hooks{onPlainCreated = f}++setOnTransportParametersCreated :: (Parameters -> Parameters) -> Hooks -> Hooks+setOnTransportParametersCreated f hooks = hooks{onTransportParametersCreated = f}++setOnTLSExtensionCreated :: ([ExtensionRaw] -> [ExtensionRaw]) -> Hooks -> Hooks+setOnTLSExtensionCreated f params = params{onTLSExtensionCreated = f}++setOnTLSHandshakeCreated+ :: ([(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool))+ -> Hooks+ -> Hooks+setOnTLSHandshakeCreated f hooks = hooks{onTLSHandshakeCreated = f}++----------------------------------------------------------------++rrBits :: EncryptionLevel -> EncryptionLevel -> Plain -> Plain+rrBits lvl0 lvl plain+ | lvl0 == lvl =+ if plainPacketNumber plain /= 0+ then plain{plainFlags = Flags 0x08}+ else plain+ | otherwise = plain++dropInitialSourceConnectionId :: Parameters -> Parameters+dropInitialSourceConnectionId params = params{initialSourceConnectionId = Nothing}++dummyCID :: Maybe CID+dummyCID = Just $ toCID "DUMMY"++setOriginalDestinationConnectionId :: Parameters -> Parameters+setOriginalDestinationConnectionId params = params{originalDestinationConnectionId = dummyCID}++setPreferredAddress :: Parameters -> Parameters+setPreferredAddress params = params{preferredAddress = Just prefAddr}+ where+ prefAddr =+ BS.concat+ [ "\x7f\x00\x00\x01"+ , "\x01\xbb"+ , "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"+ , "\x00\x00"+ , "\x08"+ , "\x00\x01\x02\x03\x04\x05\x06\x07"+ , "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"+ ]++setRetrySourceConnectionId :: Parameters -> Parameters+setRetrySourceConnectionId params = params{retrySourceConnectionId = dummyCID}++setStatelessResetToken :: Parameters -> Parameters+setStatelessResetToken params = params{statelessResetToken = Just $ StatelessResetToken "DUMMY"}++----------------------------------------------------------------++setMaxUdpPayloadSize :: Parameters -> Parameters+setMaxUdpPayloadSize params = params{maxUdpPayloadSize = 1090}++setAckDelayExponent :: Parameters -> Parameters+setAckDelayExponent params = params{ackDelayExponent = 30}++setMaxAckDelay :: Parameters -> Parameters+setMaxAckDelay params = params{maxAckDelay = 2 ^ (15 :: Int)}++----------------------------------------------------------------++largeOffset :: EncryptionLevel -> Plain -> Plain+largeOffset lvl plain+ | lvl == RTT1Level = plain{plainFrames = fake : plainFrames plain}+ | otherwise = plain+ where+ fake = StreamF 0 100000000 ["GET /\r\n"] True++largeStreamId :: EncryptionLevel -> Plain -> Plain+largeStreamId lvl plain+ | lvl == RTT1Level = plain{plainFrames = fake : plainFrames plain}+ | otherwise = plain+ where+ fake = StreamF 1000000000 0 ["GET /\r\n"] True++unknownFrame :: EncryptionLevel -> Plain -> Plain+unknownFrame lvl plain+ | lvl == RTT1Level =+ plain{plainFrames = UnknownFrame 0x20 : plainFrames plain}+ | otherwise = plain++handshakePathChallenge :: EncryptionLevel -> Plain -> Plain+handshakePathChallenge lvl plain+ | lvl == HandshakeLevel =+ plain{plainFrames = PathChallenge (PathData "01234567") : plainFrames plain}+ | otherwise = plain++noFrames :: EncryptionLevel -> Plain -> Plain+noFrames lvl plain+ | lvl == RTT1Level =+ plain+ { plainFrames = []+ , plainMarks = set4bytesPN $ setNoPaddings $ plainMarks plain+ }+ | otherwise = plain++handshakeDone :: EncryptionLevel -> Plain -> Plain+handshakeDone lvl plain+ | lvl == RTT1Level = plain{plainFrames = HandshakeDone : plainFrames plain}+ | otherwise = plain++newToken :: EncryptionLevel -> Plain -> Plain+newToken lvl plain+ | lvl == RTT1Level =+ plain{plainFrames = NewToken "DUMMY" : plainFrames plain}+ | otherwise = plain++localInitiatedNotCreatedYet :: EncryptionLevel -> Plain -> Plain+localInitiatedNotCreatedYet lvl plain+ | lvl == RTT1Level =+ plain{plainFrames = StreamF 1 0 [""] False : plainFrames plain}+ | otherwise = plain++sendOnlyStream :: EncryptionLevel -> Plain -> Plain+sendOnlyStream lvl plain+ | lvl == RTT1Level =+ plain{plainFrames = StreamF 3 0 [""] False : plainFrames plain}+ | otherwise = plain++resetStrm :: EncryptionLevel -> Plain -> Plain+resetStrm lvl plain+ | lvl == RTT1Level =+ plain+ { plainFrames = ResetStream 3 (ApplicationProtocolError 0) 0 : plainFrames plain+ }+ | otherwise = plain++stopSending :: EncryptionLevel -> Plain -> Plain+stopSending lvl plain+ | lvl == RTT1Level =+ plain+ { plainFrames = StopSending 101 (ApplicationProtocolError 0) : plainFrames plain+ }+ | otherwise = plain++maxStreamData :: EncryptionLevel -> Plain -> Plain+maxStreamData lvl plain+ | lvl == RTT1Level =+ plain{plainFrames = MaxStreamData 101 1000000 : plainFrames plain}+ | otherwise = plain++maxStreamData2 :: EncryptionLevel -> Plain -> Plain+maxStreamData2 lvl plain+ | lvl == RTT1Level =+ plain{plainFrames = MaxStreamData 2 1000000 : plainFrames plain}+ | otherwise = plain++maxStreams' :: EncryptionLevel -> Plain -> Plain+maxStreams' lvl plain+ | lvl == RTT1Level =+ plain+ { plainFrames = MaxStreams Bidirectional (2 ^ (60 :: Int) + 1) : plainFrames plain+ }+ | otherwise = plain++streamsBlocked :: EncryptionLevel -> Plain -> Plain+streamsBlocked lvl plain+ | lvl == RTT1Level =+ plain+ { plainFrames =+ StreamsBlocked Bidirectional (2 ^ (60 :: Int) + 1) : plainFrames plain+ }+ | otherwise = plain++newConnectionID :: (Frame -> Frame) -> EncryptionLevel -> Plain -> Plain+newConnectionID f lvl plain+ | lvl == RTT1Level = plain{plainFrames = map f $ plainFrames plain}+ | otherwise = plain++ncidZeroCID :: Frame -> Frame+ncidZeroCID (NewConnectionID cidinfo0 rpt) = NewConnectionID cidinfo rpt+ where+ cidinfo = cidinfo0{cidInfoCID = CID ""}+ncidZeroCID frame = frame++ncidLargeRPT :: Frame -> Frame+ncidLargeRPT (NewConnectionID cidinfo rpt) = NewConnectionID cidinfo (rpt + 10)+ncidLargeRPT frame = frame++----------------------------------------------------------------++cryptoKeyUpdate+ :: [(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool)+cryptoKeyUpdate [(HandshakeLevel, fin)] = ([(HandshakeLevel, BS.append fin "\x18\x00\x00\x01\x01")], False)+cryptoKeyUpdate lcs = (lcs, False)++cryptoKeyUpdate2+ :: [(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool)+-- [] is intentionally created in RTT1Level for h3spec+cryptoKeyUpdate2 [] = ([(RTT1Level, "\x18\x00\x00\x01\x01")], False)+cryptoKeyUpdate2 lcs = (lcs, False)++cryptoEndOfEarlyData+ :: [(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool)+cryptoEndOfEarlyData [(HandshakeLevel, fin)] = ([(HandshakeLevel, BS.append "\x05\x00\x00\x00" fin)], False)+cryptoEndOfEarlyData lcs = (lcs, False)++crypto0RTT+ :: [(EncryptionLevel, CryptoData)] -> ([(EncryptionLevel, CryptoData)], Bool)+crypto0RTT [(InitialLevel, ch)] = ([(InitialLevel, ch), (RTT0Level, "\x08\x00\x00\x02\x00\x00")], True)+crypto0RTT lcs = (lcs, False)++----------------------------------------------------------------++transportError :: QUICException -> Bool+transportError (TransportErrorIsReceived te _) = te `elem` [ProtocolViolation, InternalError]+transportError _ = False++-- Transport Sec 11:+-- In particular, an endpoint MAY use any applicable error code when+-- it detects an error condition; a generic error code (such as+-- PROTOCOL_VIOLATION or INTERNAL_ERROR) can always be used in place+-- of specific error codes.+transportErrorsIn :: [TransportError] -> QUICException -> Bool+transportErrorsIn tes qe@(TransportErrorIsReceived te _) = (te `elem` tes) || transportError qe+transportErrorsIn _ _ = False++cryptoErrorX :: QUICException -> Bool+cryptoErrorX (TransportErrorIsReceived te _) = te `elem` [cryptoError TLS.InternalError, cryptoError TLS.HandshakeFailure]+cryptoErrorX _ = False++-- Crypto Sec 4.8: QUIC permits the use of a generic code in place of+-- a specific error code; see Section 11 of [QUIC-TRANSPORT]. For TLS+-- alerts, this includes replacing any alert with a generic alert,+-- such as handshake_failure (0x128 in QUIC). Endpoints MAY use a+-- generic error code to avoid possibly exposing confidential+-- information.+cryptoErrorsIn :: [TLS.AlertDescription] -> QUICException -> Bool+cryptoErrorsIn tes qe@(TransportErrorIsReceived te _) = (te `elem` map cryptoError tes) || cryptoErrorX qe+cryptoErrorsIn _ _ = False
+ h3spec.cabal view
@@ -0,0 +1,33 @@+name: h3spec+version: 0.1.10+synopsis: QUIC+description: Test tool for error cases of QUIC and HTTP/3+license: BSD3+license-file: LICENSE+author: Kazu Yamamoto+maintainer: kazu@iij.ad.jp+-- copyright:+category: Web+build-type: Simple+-- extra-source-files: ChangeLog.md+cabal-version: >= 1.10++executable h3spec+ default-language: Haskell2010+ hs-source-dirs: .+ main-is: h3spec.hs+ other-modules: HTTP3Error+ TransportError+ Paths_h3spec+ ghc-options: -Wall -threaded -rtsopts+ build-depends: base >= 4.9 && < 5+ , bytestring+ , hspec+ , hspec-core+ , http-types+ , http3 >= 0.0.10+ , network+ , quic >= 0.1.20 && < 0.2+ , tls+ , unliftio+ default-extensions: Strict StrictData
+ h3spec.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (when)+import Data.List (foldl', intersperse)+import Data.Version (showVersion)+import qualified Network.HTTP3.Client as H3+import Network.QUIC.Internal+import System.Console.GetOpt+import System.Environment (getArgs, withArgs)+import System.Exit (exitFailure, exitSuccess)+import qualified Test.Hspec.Core.Runner as H++import HTTP3Error+import qualified Paths_h3spec as P+import TransportError++data Options = Options+ { optVersion :: Bool+ , optDebugLog :: Bool+ , optValidate :: Bool+ , optMatch :: [String]+ , optSkip :: [String]+ , optQLogDir :: Maybe FilePath+ , optKeyLogFile :: Maybe FilePath+ , optTimeout :: Int+ }+ deriving (Show)++defaultOptions :: Options+defaultOptions =+ Options+ { optVersion = False+ , optDebugLog = False+ , optValidate = True+ , optMatch = []+ , optSkip = []+ , optQLogDir = Nothing+ , optKeyLogFile = Nothing+ , optTimeout = 2000 -- 2 milliseconds+ }++options :: [OptDescr (Options -> Options)]+options =+ [ Option+ ['v']+ ["version"]+ (NoArg (\o -> o{optVersion = True}))+ "Print version"+ , Option+ ['d']+ ["debug"]+ (NoArg (\o -> o{optDebugLog = True}))+ "print debug info"+ , Option+ ['m']+ ["match"]+ (ReqArg (\m o -> o{optMatch = m : optMatch o}) "<test case description>")+ "Select test cases"+ , Option+ ['s']+ ["skip"]+ (ReqArg (\m o -> o{optSkip = m : optSkip o}) "<test case description>")+ "Skip test cases"+ , Option+ ['q']+ ["qlog-dir"]+ (ReqArg (\dir o -> o{optQLogDir = Just dir}) "<dir>")+ "directory to store qlog"+ , Option+ ['l']+ ["key-log-file"]+ (ReqArg (\file o -> o{optKeyLogFile = Just file}) "<file>")+ "a file to store negotiated secrets"+ , Option+ ['t']+ ["timeout"]+ (ReqArg (\ms o -> o{optTimeout = read ms}) "<milliseconds>")+ "timeout for each test case (2000)"+ , Option+ ['n']+ ["no-validate"]+ (NoArg (\o -> o{optValidate = False}))+ "no validating server certificates"+ ]++showUsageAndExit :: String -> IO a+showUsageAndExit msg = do+ putStrLn msg+ putStrLn $ usageInfo usage options+ exitFailure++usage :: String+usage = "Usage: h3spec <host> <port>"++main :: IO ()+main = do+ args0 <- getArgs+ (opts, args) <- case getOpt Permute options args0 of+ (o, n, []) -> return (foldl' (flip id) defaultOptions o, n)+ (_, _, errs) -> showUsageAndExit $ concat errs+ when (optVersion opts) $ do+ putStrLn $ "h3spec " ++ showVersion P.version+ exitSuccess+ (host, port) <- case args of+ [h, p] -> return (h, p)+ _ -> showUsageAndExit ""+ let cc =+ defaultClientConfig+ { ccServerName = host+ , ccPortName = port+ , ccALPN = \_ -> return $ Just ["h3", "h3-29", "hq-interop", "hq-29"]+ , ccDebugLog = optDebugLog opts+ , ccQLog = optQLogDir opts+ , ccKeyLog = getLogger $ optKeyLogFile opts+ , ccValidate = optValidate opts+ }+ qcArgs0+ | null (optMatch opts) = []+ | otherwise =+ "--match" : (intersperse "--match" $ reverse $ optMatch opts)+ qcArgs+ | null (optSkip opts) = qcArgs0+ | otherwise =+ "--skip" : (intersperse "--skip" $ reverse $ optSkip opts)+ h3cc = H3.ClientConfig "https" host+ ms = optTimeout opts+ H.readConfig H.defaultConfig qcArgs+ >>= withArgs [] . H.runSpec (transportErrorSpec cc ms >> h3ErrorSpec cc h3cc ms)+ >>= H.evaluateSummary++getLogger :: Maybe FilePath -> (String -> IO ())+getLogger Nothing = \_ -> return ()+getLogger (Just file) = \msg -> appendFile file (msg ++ "\n")