quic 0.2.23 → 0.3.2
raw patch · 34 files changed
Files
- ChangeLog.md +14/−0
- Network/QUIC.hs +4/−0
- Network/QUIC/Client.hs +1/−0
- Network/QUIC/Client/Run.hs +3/−0
- Network/QUIC/Config.hs +8/−1
- Network/QUIC/Connection/Misc.hs +1/−0
- Network/QUIC/Connection/Role.hs +1/−0
- Network/QUIC/Connection/State.hs +6/−0
- Network/QUIC/Connection/Types.hs +18/−4
- Network/QUIC/Crypto/Fusion.hs +4/−3
- Network/QUIC/Crypto/Keys.hs +4/−3
- Network/QUIC/Crypto/Nite.hs +7/−7
- Network/QUIC/Crypto/Types.hs +5/−4
- Network/QUIC/Handshake.hs +18/−1
- Network/QUIC/IO.hs +41/−0
- Network/QUIC/Info.hs +3/−0
- Network/QUIC/Packet/Frame.hs +24/−1
- Network/QUIC/Parameters.hs +9/−1
- Network/QUIC/Qlog.hs +2/−0
- Network/QUIC/Receiver.hs +12/−1
- Network/QUIC/Sender.hs +1/−0
- Network/QUIC/Server.hs +1/−0
- Network/QUIC/Server/Run.hs +2/−0
- Network/QUIC/TLS.hs +1/−0
- Network/QUIC/Types/Exception.hs +1/−0
- Network/QUIC/Types/Frame.hs +1/−0
- Network/QUIC/Types/Info.hs +4/−0
- Network/QUIC/Types/Resumption.hs +2/−0
- quic.cabal +12/−9
- test/Config.hs +1/−1
- test/DatagramSpec.hs +314/−0
- test/HandshakeSpec.hs +2/−2
- test/PacketSpec.hs +8/−4
- test/TLSSpec.hs +24/−20
ChangeLog.md view
@@ -1,5 +1,19 @@ # ChangeLog +## 0.3.2++* Support Unreliable Datagrams extension (RFC9221)+ [#92](https://github.com/kazu-yamamoto/quic/pull/92)++## 0.3.1++* Using tls v2.4.0.+* rateLimit is now 32.++## 0.3.0++* Using "ram" instead of "memory".+ ## 0.2.23 * Supporting ChaCha20Poly1305 for crypton (not for Fusion)
Network/QUIC.hs view
@@ -34,6 +34,10 @@ recvStream, sendStream, sendStreamMany,+ sendDatagram,+ recvDatagram,+ recvDatagramMany,+ recvDatagramSTM, -- * Information ConnectionInfo,
Network/QUIC/Client.hs view
@@ -12,6 +12,7 @@ ccPortName, ccALPN, ccUse0RTT,+ ccMaxDatagramFrameSize, ccResumption, ccCiphers, ccGroups,
Network/QUIC/Client/Run.hs view
@@ -10,6 +10,7 @@ ) where import Control.Concurrent+import Control.Concurrent.STM import Control.Concurrent.Async import qualified Control.Exception as E import Foreign.C.Types@@ -139,6 +140,7 @@ let myAuthCIDs = defaultAuthCIDs{initSrcCID = Just myCID} peerAuthCIDs = defaultAuthCIDs{initSrcCID = Just peerCID, origDstCID = Just peerCID} genSRT <- makeGenStatelessReset+ connRecvDatagramQ <- newTQueueIO conn <- clientConnection conf@@ -151,6 +153,7 @@ sref piref q+ connRecvDatagramQ send recv genSRT
Network/QUIC/Config.hs view
@@ -90,6 +90,7 @@ , ccTlsHooks :: ClientHooks , ccUse0RTT :: Bool -- ^ Use 0-RTT on the 2nd connection if possible.+ , ccMaxDatagramFrameSize :: Int -- client original -- -- Default: 'False'@@ -149,6 +150,7 @@ , ccHooks = defaultHooks , ccTlsHooks = defaultClientHooks , ccUse0RTT = False+ , ccMaxDatagramFrameSize = 0 , -- client original ccServerName = "127.0.0.1" , ccPortName = "4433"@@ -174,7 +176,9 @@ , scCiphers :: [Cipher] -- ^ Cipher candidates defined in TLS 1.3. , scGroups :: [Group]- -- ^ Key exchange group candidates defined in TLS 1.3.+ -- ^ Key exchange group candidates defined in TLS 1.3 (tls <2.4).+ , scGroupsTLS13 :: [[Group]]+ -- ^ Key exchange group candidates defined in TLS 1.3 (tls >= 2.4). , scParameters :: Parameters , scKeyLog :: String -> IO () , scQLog :: Maybe FilePath@@ -183,6 +187,7 @@ , scHooks :: Hooks , scTlsHooks :: ServerHooks , scUse0RTT :: Bool+ , scMaxDatagramFrameSize :: Int -- ^ Use 0-RTT on the 2nd connection if possible. -- server original , scAddresses :: [(IP, PortNumber)]@@ -205,6 +210,7 @@ { scVersions = [Version2, Version1] , scCiphers = defaultCiphers , scGroups = supportedGroups defaultSupported+ , scGroupsTLS13 = supportedGroupsTLS13 defaultSupported , scParameters = defaultParameters #if MIN_VERSION_tls(2,1,10) , scKeyLog = defaultKeyLogger@@ -216,6 +222,7 @@ , scHooks = defaultHooks , scTlsHooks = defaultServerHooks , scUse0RTT = False+ , scMaxDatagramFrameSize = 0 , -- server original scAddresses = [("0.0.0.0", 4433), ("::", 4433)] , scALPN = Nothing
Network/QUIC/Connection/Misc.hs view
@@ -147,6 +147,7 @@ , initialMaxStreamDataUni = resumptionInitialMaxStreamDataUni , initialMaxStreamsBidi = resumptionInitialMaxStreamsBidi , initialMaxStreamsUni = resumptionInitialMaxStreamsUni+ , maxDatagramFrameSize = resumptionMaxDatagramFrameSize } ----------------------------------------------------------------
Network/QUIC/Connection/Role.hs view
@@ -127,6 +127,7 @@ , resumptionInitialMaxStreamDataUni = initialMaxStreamDataUni , resumptionInitialMaxStreamsBidi = initialMaxStreamsBidi , resumptionInitialMaxStreamsUni = initialMaxStreamsUni+ , resumptionMaxDatagramFrameSize = maxDatagramFrameSize } ----------------------------------------------------------------
Network/QUIC/Connection/State.hs view
@@ -2,6 +2,7 @@ module Network.QUIC.Connection.State ( setConnection0RTTReady,+ isConnection0RTTReady, isConnection1RTTReady, setConnection1RTTReady, isConnectionEstablished,@@ -57,6 +58,11 @@ setConnectionClosed conn = setConnectionState conn Closed ----------------------------------------------------------------++isConnection0RTTReady :: Connection -> IO Bool+isConnection0RTTReady Connection{..} = atomically $ do+ st <- readTVar $ connectionState connState+ return (st >= ReadyFor0RTT && st /= Closed) isConnection1RTTReady :: Connection -> IO Bool isConnection1RTTReady Connection{..} = atomically $ do
Network/QUIC/Connection/Types.hs view
@@ -242,6 +242,7 @@ , connRecv :: ~Recv -- ~ for testing -- Manage , connRecvQ :: RecvQ+ , connRecvDatagramQ :: DatagramQ , connSocket :: IORef Socket , genStatelessResetToken :: CID -> StatelessResetToken , readers :: IORef (Map Word64 (Weak ThreadId))@@ -337,11 +338,12 @@ -> IORef Socket -> IORef PeerInfo -> RecvQ+ -> DatagramQ -> Send -> Recv -> (CID -> StatelessResetToken) -> IO Connection-newConnection rl myParameters origVersionInfo myAuthCIDs peerAuthCIDs connDebugLog connQLog connHooks connSocket peerInfo connRecvQ ~connSend ~connRecv genStatelessResetToken = do+newConnection rl myParameters origVersionInfo myAuthCIDs peerAuthCIDs connDebugLog connQLog connHooks connSocket peerInfo connRecvQ connRecvDatagramQ ~connSend ~connRecv genStatelessResetToken = do connState <- newConnState rl -- Manage readers <- newIORef Map.empty@@ -355,7 +357,7 @@ -- Peer peerParameters <- newIORef baseParameters peerCIDDB <- newTVarIO (newCIDDB peerCID)- -- Queus+ -- Queues inputQ <- newTQueueIO cryptoQ <- newTQueueIO outputQ <- newTQueueIO@@ -429,12 +431,17 @@ -> IORef Socket -> IORef PeerInfo -> RecvQ+ -> DatagramQ -> Send -> Recv -> (CID -> StatelessResetToken) -> IO Connection clientConnection ClientConfig{..} verInfo myAuthCIDs peerAuthCIDs =- newConnection Client ccParameters verInfo myAuthCIDs peerAuthCIDs+ newConnection Client ccParameters' verInfo myAuthCIDs peerAuthCIDs+ where+ ccParameters' = ccParameters+ { maxDatagramFrameSize = ccMaxDatagramFrameSize+ } serverConnection :: ServerConfig@@ -447,12 +454,17 @@ -> IORef Socket -> IORef PeerInfo -> RecvQ+ -> DatagramQ -> Send -> Recv -> (CID -> StatelessResetToken) -> IO Connection serverConnection ServerConfig{..} verInfo myAuthCIDs peerAuthCIDs =- newConnection Server scParameters verInfo myAuthCIDs peerAuthCIDs+ newConnection Server scParameters' verInfo myAuthCIDs peerAuthCIDs+ where+ scParameters' = scParameters+ { maxDatagramFrameSize = scMaxDatagramFrameSize+ } ---------------------------------------------------------------- @@ -471,6 +483,8 @@ ---------------------------------------------------------------- type SendStreamQ = TQueue TxStreamData++type DatagramQ = TQueue ByteString data Shared = Shared { sharedCloseSent :: IORef Bool
Network/QUIC/Crypto/Fusion.hs view
@@ -15,6 +15,7 @@ #ifdef USE_FUSION import qualified Data.ByteString as BS+import Data.ByteArray (convert) import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Ptr@@ -42,12 +43,12 @@ fusionSetupAES128 :: FusionContext -> Key -> IV -> IO () fusionSetupAES128 (FC fctx) (Key key) (IV iv) = withForeignPtr fctx $ \pctx ->- withByteString key $ \keyp ->+ withByteString (convert key) $ \keyp -> withByteString iv $ \ivp -> void $ c_aes128gcm_setup pctx 0 keyp ivp fusionSetupAES256 :: FusionContext -> Key -> IV -> IO () fusionSetupAES256 (FC fctx) (Key key) (IV iv) = withForeignPtr fctx $ \pctx ->- withByteString key $ \keyp ->+ withByteString (convert key) $ \keyp -> withByteString iv $ \ivp -> void $ c_aes256gcm_setup pctx 0 keyp ivp ----------------------------------------------------------------@@ -84,7 +85,7 @@ newtype Supplement = SP (ForeignPtr SupplementOpaque) fusionSetupSupplement :: Cipher -> Key -> IO Supplement-fusionSetupSupplement cipher (Key hpkey) = withByteString hpkey $ \hpkeyp ->+fusionSetupSupplement cipher (Key hpkey) = withByteString (convert hpkey) $ \hpkeyp -> SP <$> (c_supplement_new hpkeyp keylen >>= newForeignPtr p_supplement_free) where keylen
Network/QUIC/Crypto/Keys.hs view
@@ -13,6 +13,7 @@ ) where import qualified Control.Exception as E+import Data.ByteArray (ScrubbedBytes, convert) import Network.TLS hiding (Version) import Network.TLS.Extra.Cipher import Network.TLS.QUIC@@ -46,18 +47,18 @@ serverInitialSecret :: Version -> CID -> ServerTrafficSecret InitialSecret serverInitialSecret v c = ServerTrafficSecret $ initialSecret v c $ Label "server in" -initialSecret :: Version -> CID -> Label -> ByteString+initialSecret :: Version -> CID -> Label -> ScrubbedBytes initialSecret Draft29 = initialSecret' $ initialSalt Draft29 initialSecret Version1 = initialSecret' $ initialSalt Version1 initialSecret Version2 = initialSecret' $ initialSalt Version2 initialSecret _ = \_ _ -> "not supported" -initialSecret' :: ByteString -> CID -> Label -> ByteString+initialSecret' :: ByteString -> CID -> Label -> ScrubbedBytes initialSecret' salt cid (Label label) = secret where cipher = defaultCipher hash = cipherHash cipher- iniSecret = hkdfExtract hash salt $ fromCID cid+ iniSecret = hkdfExtract hash (convert salt) (convert $ fromCID cid) hashSize = hashDigestSize hash secret = hkdfExpandLabel hash iniSecret label "" hashSize
Network/QUIC/Crypto/Nite.hs view
@@ -41,26 +41,26 @@ -- it's impossible. cipherEncrypt :: Cipher -> Key -> Nonce -> PlainText -> AssDat -> Maybe (CipherText, CipherText)-cipherEncrypt cipher (Key key) (Nonce nonce)+cipherEncrypt cipher key@(Key key') (Nonce nonce) | cipher == cipher13_AES_128_GCM_SHA256 = quicAeadEncrypt (aesGCMInit key nonce :: Maybe (AEAD AES128)) 16 | cipher == cipher13_AES_128_CCM_SHA256 = error "cipher13_AES_128_CCM_SHA256" | cipher == cipher13_AES_256_GCM_SHA384 = quicAeadEncrypt (aesGCMInit key nonce :: Maybe (AEAD AES256)) 16 | cipher == cipher13_CHACHA20_POLY1305_SHA256 =- quicAeadEncrypt (maybeCryptoError $ aeadChacha20poly1305Init key nonce) 16+ quicAeadEncrypt (maybeCryptoError $ aeadChacha20poly1305Init key' nonce) 16 | otherwise = error "cipherEncrypt" cipherDecrypt :: Cipher -> Key -> Nonce -> CipherText -> AssDat -> Maybe PlainText-cipherDecrypt cipher (Key key) (Nonce nonce)+cipherDecrypt cipher key@(Key key') (Nonce nonce) | cipher == cipher13_AES_128_GCM_SHA256 = quicAeadDecrypt (aesGCMInit key nonce :: Maybe (AEAD AES128)) 16 | cipher == cipher13_AES_128_CCM_SHA256 = error "cipher13_AES_128_CCM_SHA256" | cipher == cipher13_AES_256_GCM_SHA384 = quicAeadDecrypt (aesGCMInit key nonce :: Maybe (AEAD AES256)) 16 | cipher == cipher13_CHACHA20_POLY1305_SHA256 =- quicAeadDecrypt (maybeCryptoError $ aeadChacha20poly1305Init key nonce) 16+ quicAeadDecrypt (maybeCryptoError $ aeadChacha20poly1305Init key' nonce) 16 | otherwise = error "cipherDecrypt" -- IMPORTANT: Using 'let' so that parameters can be memorized.@@ -85,15 +85,15 @@ in aeadSimpleDecrypt aead ad ciphertext authtag aesGCMInit- :: BlockCipher cipher => ByteString -> ByteString -> Maybe (AEAD cipher)-aesGCMInit key nonce =+ :: BlockCipher cipher => Key -> ByteString -> Maybe (AEAD cipher)+aesGCMInit (Key key) nonce = case maybeCryptoError $ cipherInit key of Nothing -> Nothing Just aes -> maybeCryptoError $ aeadInit AEAD_GCM aes nonce aes128gcmEncrypt :: Key -> Nonce -> PlainText -> AssDat -> Maybe (CipherText, CipherText)-aes128gcmEncrypt (Key key) (Nonce nonce) =+aes128gcmEncrypt key (Nonce nonce) = quicAeadEncrypt (aesGCMInit key nonce :: Maybe (AEAD AES128)) 16 ----------------------------------------------------------------
Network/QUIC/Crypto/Types.hs view
@@ -19,6 +19,7 @@ ServerTrafficSecret (..), ) where +import Data.ByteArray (ScrubbedBytes, convert) import qualified Data.ByteString.Char8 as C8 import Network.TLS hiding (Version) import Network.TLS.QUIC@@ -32,9 +33,9 @@ type CipherText = ByteString type Salt = ByteString -newtype Key = Key ByteString deriving (Eq)+newtype Key = Key ScrubbedBytes deriving (Eq) newtype IV = IV ByteString deriving (Eq)-newtype Secret = Secret ByteString deriving (Eq)+newtype Secret = Secret ScrubbedBytes deriving (Eq) newtype AssDat = AssDat ByteString deriving (Eq) newtype Sample = Sample ByteString deriving (Eq) newtype Mask = Mask ByteString deriving (Eq)@@ -42,11 +43,11 @@ newtype Nonce = Nonce ByteString deriving (Eq) instance Show Key where- show (Key x) = "Key=" ++ C8.unpack (enc16 x)+ show (Key x) = "Key=" ++ C8.unpack (enc16 $ convert x) instance Show IV where show (IV x) = "IV=" ++ C8.unpack (enc16 x) instance Show Secret where- show (Secret x) = "Secret=" ++ C8.unpack (enc16 x)+ show (Secret x) = "Secret=" ++ C8.unpack (enc16 $ convert x) instance Show AssDat where show (AssDat x) = "AssDat=" ++ C8.unpack (enc16 x) instance Show Sample where
Network/QUIC/Handshake.hs view
@@ -104,7 +104,13 @@ handshakeClient :: ClientConfig -> Connection -> AuthCIDs -> IO (IO ()) handshakeClient conf conn myAuthCIDs = do qlogParamsSet conn (ccParameters conf, "local") -- fixme- handshakeClient' conf conn myAuthCIDs <$> getVersion conn <*> newHndStateRef+ handshakeClient' conf' conn myAuthCIDs <$> getVersion conn <*> newHndStateRef+ where+ conf' = conf+ { ccParameters = (ccParameters conf)+ { maxDatagramFrameSize = ccMaxDatagramFrameSize conf+ }+ } handshakeClient' :: ClientConfig -> Connection -> AuthCIDs -> Version -> IORef HndState -> IO ()@@ -167,6 +173,7 @@ params = (setCIDsToParameters myAuthCIDs $ scParameters conf) { statelessResetToken = Just srt+ , maxDatagramFrameSize = scMaxDatagramFrameSize conf } handshakeServer'@@ -292,6 +299,15 @@ _ -> sendCCVNError setParams params = do+ when (isClient conn) $ do+ is0RTT <- isConnection0RTTReady conn+ when is0RTT $ do+ storedParams <- getPeerParameters conn+ let storedMaxDatagram = maxDatagramFrameSize storedParams+ newMaxDatagram = maxDatagramFrameSize params+ when (storedMaxDatagram > 0 && newMaxDatagram < storedMaxDatagram) $+ E.throwIO WrongDatagramSizeParameter+ setPeerParameters conn params mapM_ (setPeerStatelessResetToken conn) $ statelessResetToken params setTxMaxData conn $ initialMaxData params@@ -336,6 +352,7 @@ sendCCTLSError :: Connection -> TLS.TLSException -> IO () sendCCTLSError conn (TLS.HandshakeFailed (TLS.Error_Misc "WrongTransportParameter")) = closeConnection conn TransportParameterError "Transport parameter error" sendCCTLSError conn (TLS.HandshakeFailed (TLS.Error_Misc "WrongVersionInformation")) = closeConnection conn VersionNegotiationError "Version negotiation error"+sendCCTLSError conn (TLS.HandshakeFailed (TLS.Error_Misc "WrongDatagramSizeParameter")) = closeConnection conn ProtocolViolation "0-RTT datagram size violation" sendCCTLSError conn e = closeConnection conn err msg where tlserr = getErrorCause e
Network/QUIC/IO.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ module Network.QUIC.IO where import Control.Concurrent.STM@@ -8,6 +10,7 @@ import Network.QUIC.Connection import Network.QUIC.Connector import Network.QUIC.Imports+import Network.QUIC.Parameters import Network.QUIC.Stream import Network.QUIC.Types @@ -235,3 +238,41 @@ lvl <- getEncryptionLevel conn let frame = StopSending sid aerr putOutput conn $ OutControl lvl [frame]++-- | Sending a DATAGRAM frame to the peer.+-- If the datagram is larger than the peer's `max_datagram_frame_size`+-- an exception is thrown.+sendDatagram :: Connection -> ByteString -> IO ()+sendDatagram conn dat = do+ -- Determine the send level from connection readiness state rather than+ -- the encryptionLevel TVar, which is not set to RTT0Level during 0-RTT.+ ready1rtt <- isConnection1RTTReady conn+ lvl <- if ready1rtt+ then return RTT1Level+ else do+ ready0rtt <- isConnection0RTTReady conn+ if ready0rtt+ then return RTT0Level+ else E.throwIO $ ConnectionIsClosed "Cannot send DATAGRAM"+ limitBytes <- maxDatagramFrameSize <$> getPeerParameters conn+ when (limitBytes == 0) $+ E.throwIO $ ConnectionIsClosed "DATAGRAM not supported by peer"+ let frameOverhead = 1 + BS.length (encodeInt (fromIntegral $ BS.length dat))+ when (BS.length dat + frameOverhead > limitBytes) $+ E.throwIO $ ConnectionIsClosed "DATAGRAM size violation"+ let frame = Datagram False dat+ putOutput conn $ OutControl lvl [frame]++-- | Receiving a DATAGRAM frame.+-- This blocks until a DATAGRAM frame is received.+recvDatagram :: Connection -> IO ByteString+recvDatagram = atomically . recvDatagramSTM++-- | Receive all available DATAGRAM frames.+-- This function is non-blocking.+recvDatagramMany :: Connection -> IO [ByteString]+recvDatagramMany = atomically . flushTQueue . connRecvDatagramQ++-- | Receiving a DATAGRAM frame in STM.+recvDatagramSTM :: Connection -> STM ByteString+recvDatagramSTM = readTQueue . connRecvDatagramQ
Network/QUIC/Info.hs view
@@ -4,6 +4,7 @@ import Network.QUIC.Connection import Network.QUIC.Types import Network.QUIC.Types.Info+import qualified Network.QUIC.Parameters as P import qualified Network.Socket as NS ----------------------------------------------------------------@@ -17,6 +18,7 @@ peersa <- peerSockAddr <$> getPathInfo conn mycid <- getMyCID conn peercid <- getPeerCID conn+ peerdgsize <- P.maxDatagramFrameSize <$> getPeerParameters conn c <- getCipher conn RTT1Level mproto <- getApplicationProtocol conn mode <- getTLSMode conn@@ -33,6 +35,7 @@ , remoteSockAddr = peersa , localCID = mycid , remoteCID = peercid+ , remoteDatagramFrameSize = peerdgsize } ----------------------------------------------------------------
Network/QUIC/Packet/Frame.hs view
@@ -19,7 +19,11 @@ encodeFrames :: [Frame] -> IO ByteString encodeFrames frames = withWriteBuffer 2048 $ \wbuf ->- mapM_ (encodeFrame wbuf) frames+ let loop [] = return ()+ loop [Datagram _ dat] = encodeDatagramFinal wbuf dat+ loop [f] = encodeFrame wbuf f+ loop (f:fs) = encodeFrame wbuf f >> loop fs+ in loop frames encodeFramesWithPadding :: Buffer@@ -134,9 +138,19 @@ copyShortByteString wbuf reason encodeFrame wbuf HandshakeDone = write8 wbuf 0x1e+encodeFrame wbuf (Datagram _ dat) = do+ write8 wbuf 0x31+ encodeInt' wbuf $ fromIntegral $ BS.length dat+ copyByteString wbuf dat encodeFrame wbuf (UnknownFrame typ) = write8 wbuf $ fromIntegral typ +-- only valid when the datagram is the last frame and there's no padding+encodeDatagramFinal :: WriteBuffer -> ByteString -> IO ()+encodeDatagramFinal wbuf dat = do+ write8 wbuf 0x30+ copyByteString wbuf dat+ ---------------------------------------------------------------- decodeFramesBS :: ByteString -> IO (Maybe [Frame])@@ -190,6 +204,8 @@ 0x1c -> decodeConnectionClose rbuf 0x1d -> decodeConnectionCloseApp rbuf 0x1e -> return HandshakeDone+ 0x30 -> decodeDatagram rbuf False+ 0x31 -> decodeDatagram rbuf True x -> return $ UnknownFrame x decodePadding :: ReadBuffer -> IO Frame@@ -360,3 +376,10 @@ decodePathResponse :: ReadBuffer -> IO Frame decodePathResponse rbuf = PathResponse . PathData <$> extractShortByteString rbuf 8++decodeDatagram :: ReadBuffer -> Bool -> IO Frame+decodeDatagram rbuf hasLen = do+ len <- if hasLen+ then fromIntegral <$> decodeInt' rbuf+ else remainingSize rbuf+ Datagram hasLen <$> extractByteString rbuf len
Network/QUIC/Parameters.hs view
@@ -70,6 +70,8 @@ pattern RetrySourceConnectionId = Key 0x10 pattern VersionInformation :: Key pattern VersionInformation = Key 0x11+pattern MaxDatagramFrameSize :: Key+pattern MaxDatagramFrameSize = Key 0x20 pattern Grease :: Key pattern Grease = Key 0xff pattern GreaseQuicBit :: Key@@ -98,6 +100,7 @@ , grease :: Maybe ByteString , greaseQuicBit :: Bool , versionInformation :: Maybe VersionInfo+ , maxDatagramFrameSize :: Int } deriving (Eq, Show) @@ -125,6 +128,7 @@ , grease = Nothing , greaseQuicBit = False , versionInformation = Nothing+ , maxDatagramFrameSize = 0 } decInt :: ByteString -> Int@@ -205,6 +209,8 @@ x{greaseQuicBit = True} update x (VersionInformation, v) = x{versionInformation = toVersionInfo v}+ update x (MaxDatagramFrameSize, v) =+ x{maxDatagramFrameSize = decInt v} update x _ = x diff@@ -256,6 +262,7 @@ , diff p greaseQuicBit GreaseQuicBit (const "") , diff p grease Grease fromJust , diff p versionInformation VersionInformation fromVersionInfo+ , diff p maxDatagramFrameSize MaxDatagramFrameSize encInt ] encSRT :: Maybe StatelessResetToken -> ByteString@@ -289,7 +296,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}+-- 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} defaultParameters :: Parameters defaultParameters = baseParameters@@ -303,6 +310,7 @@ , initialMaxStreamsUni = 3 , activeConnectionIdLimit = 5 , greaseQuicBit = True+ , maxDatagramFrameSize = 0 } data AuthCIDs = AuthCIDs
Network/QUIC/Qlog.hs view
@@ -115,6 +115,7 @@ frameType ConnectionClose{} = "connection_close" frameType ConnectionCloseApp{} = "connection_close" frameType HandshakeDone{} = "handshake_done"+frameType Datagram{} = "datagram" frameType UnknownFrame{} = "unknown" {-# INLINE frameExtra #-}@@ -169,6 +170,7 @@ <> toLogStr (Short.fromShort reason) <> "\"" -- fixme frameExtra HandshakeDone{} = ""+frameExtra (Datagram _ dat) = ",\"length\":" <> sw (BS.length dat) frameExtra (UnknownFrame _Int) = "" transportError :: TransportError -> LogStr
Network/QUIC/Receiver.hs view
@@ -23,6 +23,7 @@ import Network.QUIC.Parameters import Network.QUIC.Qlog import Network.QUIC.Recovery+import Control.Concurrent.STM import Network.QUIC.Stream import Network.QUIC.Types as QUIC @@ -140,7 +141,7 @@ processReceivedPacket conn rpkt rateLimit :: Int-rateLimit = 10+rateLimit = 32 checkRate :: [Frame] -> Int checkRate fs0 = go fs0 0@@ -474,6 +475,16 @@ getConnectionInfo conn >>= onConnectionEstablished (connHooks conn) -- to receive NewSessionTicket fire conn (Microseconds 1000000) $ killHandshaker conn lvl+processFrame conn lvl (Datagram hasLen dat) = do+ when (lvl /= RTT0Level && lvl /= RTT1Level) $+ closeConnection conn ProtocolViolation "DATAGRAM in Initial or Handshake"+ let limitBytes = maxDatagramFrameSize (getMyParameters conn)+ let lenSize = if hasLen then BS.length (encodeInt . fromIntegral $ BS.length dat) else 0+ when (limitBytes == 0) $+ closeConnection conn ProtocolViolation "DATAGRAM not supported"+ when (1 + lenSize + BS.length dat > limitBytes) $+ closeConnection conn ProtocolViolation "DATAGRAM size violation"+ atomically $ writeTQueue (connRecvDatagramQ conn) dat processFrame conn _ _ = closeConnection conn ProtocolViolation "Frame is not allowed" -- Return value indicates duplication.
Network/QUIC/Sender.hs view
@@ -340,6 +340,7 @@ let r = MaxData newMax rs <- adjustForRetransmit conn xs return (r : rs)+adjustForRetransmit conn (Datagram{} : xs) = adjustForRetransmit conn xs adjustForRetransmit conn (x : xs) = do rs <- adjustForRetransmit conn xs return (x : rs)
Network/QUIC/Server.hs view
@@ -12,6 +12,7 @@ scALPN, scRequireRetry, scUse0RTT,+ scMaxDatagramFrameSize, scCiphers, scGroups, scVersions,
Network/QUIC/Server/Run.hs view
@@ -160,6 +160,7 @@ (qLog, qclean) <- dirQLogger scQLog accTime ocid "server" (debugLog, dclean) <- dirDebugLogger scDebugLog ocid debugLog $ "Original CID: " <> bhow ocid+ connRecvDatagramQ <- newTQueueIO conn <- serverConnection conf@@ -172,6 +173,7 @@ sref piref accRecvQ+ connRecvDatagramQ send recv (genStatelessReset dispatch)
Network/QUIC/TLS.hs view
@@ -122,6 +122,7 @@ { supportedVersions = [TLS13] , supportedCiphers = scCiphers , supportedGroups = scGroups+ , supportedGroupsTLS13 = scGroupsTLS13 } debug = defaultDebugParams
Network/QUIC/Types/Exception.hs view
@@ -31,6 +31,7 @@ = MustNotReached | ExitConnection | WrongTransportParameter+ | WrongDatagramSizeParameter | WrongVersionInformation | BreakForever deriving (Eq, Show)
Network/QUIC/Types/Frame.hs view
@@ -40,6 +40,7 @@ | ConnectionClose TransportError FrameType ReasonPhrase | ConnectionCloseApp ApplicationProtocolError ReasonPhrase | HandshakeDone+ | Datagram Bool ByteString | UnknownFrame Int deriving (Eq, Show)
Network/QUIC/Types/Info.hs view
@@ -24,6 +24,7 @@ , remoteSockAddr :: NS.SockAddr , localCID :: CID , remoteCID :: CID+ , remoteDatagramFrameSize :: Int } instance Show ConnectionInfo where@@ -51,4 +52,7 @@ ++ "\n" ++ "Remote SockAddr: " ++ show remoteSockAddr+ ++ "\n"+ ++ "Remote DatagramFrameSize: "+ ++ show remoteDatagramFrameSize ++ if retry then "\nQUIC retry" else ""
Network/QUIC/Types/Resumption.hs view
@@ -26,6 +26,7 @@ , resumptionInitialMaxStreamDataUni :: Int , resumptionInitialMaxStreamsBidi :: Int , resumptionInitialMaxStreamsUni :: Int+ , resumptionMaxDatagramFrameSize :: Int } deriving (Eq, Show, Generic) @@ -45,6 +46,7 @@ , resumptionInitialMaxStreamDataUni = 0 , resumptionInitialMaxStreamsBidi = 0 , resumptionInitialMaxStreamsUni = 0+ , resumptionMaxDatagramFrameSize = 0 } -- | Is 0RTT possible?
quic.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: quic-version: 0.2.23+version: 0.3.2 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp@@ -134,23 +134,23 @@ base16-bytestring >=1.0 && <1.1, bytestring >=0.10, containers,- crypto-token >=0.1.2 && <0.2,- crypton >=1.0.5,- crypton-x509 >=1.8.0 && <1.9,- crypton-x509-store >=1.8.0 && <1.9,- crypton-x509-system >=1.8.0 && <1.9,- crypton-x509-validation >=1.8.0 && <1.9,+ crypto-token >=0.2.0 && <0.3,+ crypton >=1.1.0 && < 1.2,+ crypton-x509 >=1.9.0 && <1.10,+ crypton-x509-store >=1.9.0 && <1.10,+ crypton-x509-system >=1.9.0 && <1.10,+ crypton-x509-validation >=1.9.0 && <1.10, fast-logger >=3.2.2 && <3.3, filepath, iproute >=1.7.12 && <1.8,- memory >=0.18.0 && <0.19, network >=3.2.3, network-byte-order >=0.1.7 && <0.2, network-control >=0.1.5 && <0.2,+ ram, random >=1.2 && <1.4, serialise, stm >=2.5 && <2.6,- tls >=2.1.8 && <2.3,+ tls >=2.4.0 && <2.5, unix-time >=0.4.12 && <0.5 if os(linux)@@ -237,6 +237,7 @@ hs-source-dirs: test other-modules: Config+ DatagramSpec ErrorSpec FrameSpec HandshakeSpec@@ -261,6 +262,8 @@ hspec, network >=3.2.2, quic,+ ram,+ stm, tls, unix-time
test/Config.hs view
@@ -150,7 +150,7 @@ where hints = defaultHints- { addrSocketType = Datagram+ { addrSocketType = Network.Socket.Datagram , addrFlags = [AI_NUMERICHOST] , addrFamily = AF_INET }
+ test/DatagramSpec.hs view
@@ -0,0 +1,314 @@+{-# LANGUAGE OverloadedStrings #-}++module DatagramSpec where++import Control.Concurrent+import qualified Control.Exception as E+import Control.Monad+import Data.ByteString ()+import qualified Data.ByteString as BS+import Test.Hspec++import Network.QUIC+import Network.QUIC.Client as C+import Network.QUIC.Internal hiding (RTT0)+import Network.QUIC.Server as S+import Network.TLS (HandshakeMode13 (..))++import Config++spec :: Spec+spec = do+ sc0' <- runIO makeTestServerConfig+ let sc0 = sc0'+ describe "Datagram MUST requirements" $ do+ -- "An endpoint that receives a DATAGRAM frame when it has not indicated support via the transport parameter MUST terminate the connection with an error of type PROTOCOL_VIOLATION."+ it "Server MUST send PROTOCOL_VIOLATION if DATAGRAM received without negotiation" $ do+ let cc = testClientConfig { ccHooks = (ccHooks testClientConfig) { onPlainCreated = injectDatagram1RTT } }+ testServerExpectError cc sc0 isProtocolViolationReceived++ -- "An endpoint that receives a DATAGRAM frame when it has not indicated support via the transport parameter MUST terminate the connection with an error of type PROTOCOL_VIOLATION."+ it "Client MUST send PROTOCOL_VIOLATION if DATAGRAM received without negotiation" $ do+ let sc = sc0 { scHooks = (scHooks sc0) { onPlainCreated = injectDatagram1RTT } }+ testClientExpectError testClientConfig sc isProtocolViolationSent++ -- "Similarly, an endpoint that receives a DATAGRAM frame that is larger than the value it sent in its max_datagram_frame_size transport parameter MUST terminate the connection with an error of type PROTOCOL_VIOLATION."+ it "Rejects DATAGRAM larger than max_datagram_frame_size" $ do+ let scDtgm = sc0 { scMaxDatagramFrameSize = 10 }+ ccDtgm = testClientConfig { ccMaxDatagramFrameSize = 10+ , ccHooks = (ccHooks testClientConfig) { onPlainCreated = injectLargeDatagram } }+ testServerExpectError ccDtgm scDtgm isProtocolViolationReceived++ -- "Like STREAM frames, DATAGRAM frames contain application data and MUST be protected with either 0-RTT or 1-RTT keys."+ it "MUST send PROTOCOL_VIOLATION if DATAGRAM in Initial or Handshake" $ do+ let scDtgm = sc0 { scMaxDatagramFrameSize = 1024 }+ ccDtgm = testClientConfig { ccMaxDatagramFrameSize = 1024+ , ccHooks = (ccHooks testClientConfig) { onPlainCreated = injectDatagramInitial } }+ testServerExpectError ccDtgm scDtgm isProtocolViolationReceived++ -- "If a client stores the value of the max_datagram_frame_size transport parameter with their 0-RTT state, they MUST validate that the new value of the max_datagram_frame_size transport parameter sent by the server in the handshake is greater than or equal to the stored value; if not, the client MUST terminate the connection with error PROTOCOL_VIOLATION."+ it "Client MUST reject 0-RTT downgrade server parameters" $ do+ let scInit = sc0 { scMaxDatagramFrameSize = 1024 }+ scDowngrade = sc0 { scMaxDatagramFrameSize = 500 }+ cc0RTT = testClientConfig { ccMaxDatagramFrameSize = 1024 }+ testDatagram0RTTDowngrade cc0RTT scInit scDowngrade++ -- "An endpoint MUST NOT send DATAGRAM frames until it has received the max_datagram_frame_size transport parameter with a non-zero value"+ it "Endpoint MUST NOT send DATAGRAM if not negotiated" $ do+ let scDtgm = sc0 { scMaxDatagramFrameSize = 0 }+ ccDtgm = testClientConfig { ccMaxDatagramFrameSize = 0 }+ mvar <- newEmptyMVar+ smgr <- newSessionManager+ let sc' = scDtgm { scSessionManager = smgr+ , scHooks = (scHooks scDtgm) { onServerReady = putMVar mvar () } }+ E.bracket (forkIO $ E.handle (\(E.SomeException _) -> return ()) $ S.run sc' (\conn -> waitEstablished conn >> threadDelay 2000000)) killThread $ \_ -> do+ takeMVar mvar+ let isNoSupport (ConnectionIsClosed err) = err == "DATAGRAM not supported by peer"+ isNoSupport _ = False+ C.run ccDtgm (\conn -> do+ waitEstablished conn+ sendDatagram conn "data") `shouldThrow` isNoSupport++ -- "An endpoint MUST NOT send DATAGRAM frames that are larger than the max_datagram_frame_size value it has received from its peer."+ it "Endpoint MUST NOT send DATAGRAM larger than peer's max_datagram_frame_size" $ do+ let scDtgm = sc0 { scMaxDatagramFrameSize = 10 }+ ccDtgm = testClientConfig { ccMaxDatagramFrameSize = 10 }+ mvar <- newEmptyMVar+ smgr <- newSessionManager+ let sc' = scDtgm { scSessionManager = smgr+ , scHooks = (scHooks scDtgm) { onServerReady = putMVar mvar () } }+ E.bracket (forkIO $ E.handle (\(E.SomeException _) -> return ()) $ S.run sc' (\conn -> waitEstablished conn >> threadDelay 2000000)) killThread $ \_ -> do+ takeMVar mvar+ let isSizeViolation (ConnectionIsClosed err) = err == "DATAGRAM size violation"+ isSizeViolation _ = False+ C.run ccDtgm (\conn -> do+ waitEstablished conn+ sendDatagram conn (BS.replicate 20 0x41)) `shouldThrow` isSizeViolation++ -- "When servers decide to accept 0-RTT data, they MUST send a max_datagram_frame_size transport parameter greater than or equal to the value they sent to the client..."+ it "Server MUST NOT downgrade max_datagram_frame_size on 0-RTT" $ do+ let scInit = sc0 { scMaxDatagramFrameSize = 1024 }+ scDowngrade = sc0 { scMaxDatagramFrameSize = 500 }+ cc0RTT = testClientConfig { ccMaxDatagramFrameSize = 1024 }++ mvar <- newEmptyMVar+ smgr <- newSessionManager++ -- Phase 1+ let scInit' = scInit { scSessionManager = smgr, scUse0RTT = True, scHooks = (scHooks scInit) { onServerReady = putMVar mvar () } }+ res <- E.bracket (forkIO $ S.run scInit' (\c -> waitEstablished c >> threadDelay 100000)) killThread $ \_ -> do+ takeMVar mvar+ C.run cc0RTT $ \conn -> do+ waitEstablished conn+ threadDelay 50000+ getResumptionInfo conn++ -- Phase 2+ let cc2 = cc0RTT { ccResumption = res, ccUse0RTT = True }+ mvar2 <- newEmptyMVar+ let scDowngrade' = scDowngrade { scSessionManager = smgr, scUse0RTT = True, scHooks = (scHooks scDowngrade) { onServerReady = putMVar mvar2 () } }++ E.bracket (forkIO $ E.handle (\(E.SomeException _) -> return ()) $ S.run scDowngrade' (\conn -> do+ waitEstablished conn+ threadDelay 2000000)) killThread $ \_ -> do+ takeMVar mvar2+ C.run cc2 (\_ -> threadDelay 2000000) `shouldThrow` isWrongDatagramSize++ -- "The sender MUST either delay sending the frame until the controller allows it or drop the frame without sending it"+ it "Sender MUST apply congestion control to DATAGRAM frames" $ do+ let scDtgm = sc0 { scMaxDatagramFrameSize = 1024 }+ ccDtgm = testClientConfig { ccMaxDatagramFrameSize = 1024 }+ mvar <- newEmptyMVar+ smgr <- newSessionManager+ let sc' = scDtgm { scSessionManager = smgr+ , scHooks = (scHooks scDtgm) { onServerReady = putMVar mvar () } }+ E.bracket (forkIO $ E.handle (\(E.SomeException _) -> return ()) $ S.run sc' (\conn -> waitEstablished conn >> threadDelay 2000000)) killThread $ \_ -> do+ takeMVar mvar+ C.run ccDtgm $ \conn -> do+ waitEstablished conn+ replicateM_ 100 $ do+ sendDatagram conn (BS.replicate 50 0x41)+ threadDelay 500++ describe "Datagram SHOULD requirements" $ do+ -- "This frame SHOULD be sent as soon as possible... and MAY be coalesced with other frames."+ it "Can send and receive DATAGRAM in 1-RTT" $ do+ let scDtgm = sc0 { scMaxDatagramFrameSize = 1024 }+ ccDtgm = testClientConfig { ccMaxDatagramFrameSize = 1024 }+ testDatagram1RTT ccDtgm scDtgm True++ -- Zero-length datagrams are explicitly permitted by the spec (Section 4)+ it "Can handle zero-length DATAGRAM" $ do+ let scDtgm = sc0 { scMaxDatagramFrameSize = 1024 }+ ccDtgm = testClientConfig { ccMaxDatagramFrameSize = 1024+ , ccHooks = (ccHooks testClientConfig) { onPlainCreated = injectZeroLengthDatagram } }+ testDatagram1RTT ccDtgm scDtgm False++ -- "When clients use 0-RTT, they MAY store the value of the server's max_datagram_frame_size transport parameter. Doing so allows the client to send DATAGRAM frames in 0-RTT packets."+ it "Can utilize 0-RTT DATAGRAM successfully" $ do+ let scDtgm = sc0 { scMaxDatagramFrameSize = 1024 }+ ccDtgm = testClientConfig { ccMaxDatagramFrameSize = 1024 }+ testDatagram0RTT ccDtgm scDtgm++injectDatagram1RTT :: EncryptionLevel -> Plain -> Plain+injectDatagram1RTT lvl plain+ | lvl == RTT1Level = plain { plainFrames = Datagram False "hello" : plainFrames plain }+ | otherwise = plain++injectLargeDatagram :: EncryptionLevel -> Plain -> Plain+injectLargeDatagram lvl plain+ | lvl == RTT1Level = plain { plainFrames = Datagram False (BS.replicate 20 0x41) : plainFrames plain }+ | otherwise = plain++injectDatagramInitial :: EncryptionLevel -> Plain -> Plain+injectDatagramInitial lvl plain+ | lvl == InitialLevel = plain { plainFrames = Datagram False "hello" : plainFrames plain }+ | otherwise = plain++injectZeroLengthDatagram :: EncryptionLevel -> Plain -> Plain+injectZeroLengthDatagram lvl plain+ | lvl == RTT1Level = plain { plainFrames = Datagram False "" : plainFrames plain }+ | otherwise = plain++isProtocolViolationSent :: QUICException -> Bool+isProtocolViolationSent (TransportErrorIsSent ProtocolViolation _) = True+isProtocolViolationSent _ = False++isProtocolViolationReceived :: QUICException -> Bool+isProtocolViolationReceived (TransportErrorIsReceived ProtocolViolation _) = True+isProtocolViolationReceived _ = False++isWrongDatagramSize :: QUICException -> Bool+isWrongDatagramSize (TransportErrorIsSent ProtocolViolation _) = True+isWrongDatagramSize (TransportErrorIsReceived ProtocolViolation _) = True+isWrongDatagramSize _ = False++-- | Server detects the error and sends ConnectionClose; client receives it.+testServerExpectError :: ClientConfig -> ServerConfig -> (QUICException -> Bool) -> IO ()+testServerExpectError cc sc selector = do+ mvar <- newEmptyMVar+ smgr <- newSessionManager+ let sc' = sc { scSessionManager = smgr+ , scHooks = (scHooks sc) { onServerReady = putMVar mvar () } }+ E.bracket (forkIO $ server sc') killThread $ \_ -> client mvar+ where+ client mvar = do+ () <- takeMVar mvar+ C.run cc (\conn -> do+ wait1RTTReady conn+ threadDelay 2000000) `shouldThrow` selector+ server sc' =+ E.handle (\(E.SomeException _) -> return ()) $ S.run sc' $ \conn -> do+ wait1RTTReady conn+ threadDelay 2000000++-- | Client detects the error and sends ConnectionClose itself.+testClientExpectError :: ClientConfig -> ServerConfig -> (QUICException -> Bool) -> IO ()+testClientExpectError cc sc selector = do+ mvar <- newEmptyMVar+ smgr <- newSessionManager+ let sc' = sc { scSessionManager = smgr+ , scHooks = (scHooks sc) { onServerReady = putMVar mvar () } }+ E.bracket (forkIO $ server sc') killThread $ \_ -> client mvar+ where+ client mvar = do+ () <- takeMVar mvar+ C.run cc (\conn -> do+ wait1RTTReady conn+ threadDelay 2000000) `shouldThrow` selector+ server sc' =+ E.handle (\(E.SomeException _) -> return ()) $ S.run sc' $ \conn -> do+ wait1RTTReady conn+ threadDelay 2000000++testDatagram1RTT :: ClientConfig -> ServerConfig -> Bool -> IO ()+testDatagram1RTT cc sc expectServerData = do+ mvar <- newEmptyMVar+ smgr <- newSessionManager+ let sc' = sc { scSessionManager = smgr+ , scHooks = (scHooks sc) { onServerReady = putMVar mvar () } }+ E.bracket (forkIO $ server sc') killThread $ \_ -> client mvar+ where+ client mvar = do+ () <- takeMVar mvar+ C.run cc $ \conn -> do+ waitEstablished conn+ sendDatagram conn "client_data"+ when expectServerData $ do+ recv <- recvDatagram conn+ recv `shouldBe` "server_data"+ server sc' = do+ S.run sc' $ \conn -> do+ waitEstablished conn+ recv <- recvDatagram conn+ when (BS.length recv == 0 || recv == "hello") $ void (recvDatagram conn)+ when expectServerData $ sendDatagram conn "server_data"+++testDatagram0RTT :: ClientConfig -> ServerConfig -> IO ()+testDatagram0RTT cc1 sc1 = do+ mvar <- newEmptyMVar+ smgr <- newSessionManager++ -- Phase 1: initial connection to get resumption info+ let scInit = sc1 { scSessionManager = smgr, scUse0RTT = True, scHooks = (scHooks sc1) { onServerReady = putMVar mvar () } }++ res <- E.bracket (forkIO $ S.run scInit (\c -> waitEstablished c >> threadDelay 100000)) killThread $ \_ -> do+ takeMVar mvar+ C.run cc1 $ \conn -> do+ waitEstablished conn+ threadDelay 50000+ getResumptionInfo conn++ -- Phase 2: 0-RTT connection with datagram+ let cc2 = cc1 { ccResumption = res, ccUse0RTT = True }++ mvar2 <- newEmptyMVar+ let sc0RTT = scInit { scHooks = (scHooks sc1) { onServerReady = putMVar mvar2 () } }++ E.bracket (forkIO $ server0RTT sc0RTT) killThread $ \_ -> client0RTT cc2 mvar2+ where+ client0RTT cc2 mvar2 = do+ () <- takeMVar mvar2+ C.run cc2 $ \conn -> do+ sendDatagram conn "0rtt_client_data"+ waitEstablished conn+ threadDelay 50000+ server0RTT sc = S.run sc $ \conn -> do+ waitEstablished conn+ info <- getConnectionInfo conn+ when (handshakeMode info == RTT0) $ do+ recv <- recvDatagram conn+ recv `shouldBe` "0rtt_client_data"++testDatagram0RTTDowngrade :: ClientConfig -> ServerConfig -> ServerConfig -> IO ()+testDatagram0RTTDowngrade cc1 scInit scDowngrade = do+ mvar <- newEmptyMVar+ smgr <- newSessionManager++ -- Phase 1: initial connection to get resumption info+ let scInit' = scInit { scSessionManager = smgr, scUse0RTT = True, scHooks = (scHooks scInit) { onServerReady = putMVar mvar () } }++ res <- E.bracket (forkIO $ S.run scInit' (\c -> waitEstablished c >> threadDelay 100000)) killThread $ \_ -> do+ takeMVar mvar+ C.run cc1 $ \conn -> do+ waitEstablished conn+ threadDelay 50000+ getResumptionInfo conn++ -- Phase 2: reconnect with downgraded server params; client should detect and reject+ let cc2 = cc1 { ccResumption = res, ccUse0RTT = True }++ mvar2 <- newEmptyMVar+ let scDowngrade' = scDowngrade { scSessionManager = smgr, scUse0RTT = True, scHooks = (scHooks scDowngrade) { onServerReady = putMVar mvar2 () } }++ E.bracket (forkIO $ server scDowngrade') killThread $ \_ ->+ client mvar2 cc2+ where+ server sc =+ E.handle (\(E.SomeException _) -> return ()) $ S.run sc $ \conn -> do+ waitEstablished conn+ threadDelay 2000000+ client mvar2 cc2 = do+ () <- takeMVar mvar2+ C.run cc2 (\_ -> threadDelay 2000000) `shouldThrow` isWrongDatagramSize
test/HandshakeSpec.hs view
@@ -38,7 +38,7 @@ testHandshake cc sc waitS FullHandshake it "can handshake in the case of TLS hello retry" $ do let cc = testClientConfig- sc = sc0{scGroups = [P256]}+ sc = sc0{scGroups = [P256], scGroupsTLS13 = [[P256]]} testHandshake cc sc waitS HelloRetryRequest it "can handshake in the case of QUIC retry" $ do let cc = testClientConfig@@ -67,7 +67,7 @@ it "fails with no group in common" $ do let cc1 = testClientConfig{ccGroups = [X25519]} cc2 = testClientConfig{ccGroups = [P256]}- sc = sc0{scGroups = [P256]}+ sc = sc0{scGroups = [P256], scGroupsTLS13 = [[P256]]} handshakeFailure e | TransportErrorIsReceived te@(TransportError _) _ <- e = te == cryptoError TLS.HandshakeFailure
test/PacketSpec.hs view
@@ -10,6 +10,7 @@ import Test.Hspec import Network.QUIC.Internal+import Control.Concurrent.STM import Config @@ -54,6 +55,7 @@ let ver = v verInfo = VersionInfo ver [ver] genSRT <- makeGenStatelessReset+ dq <- newTQueueIO ---- clientConn <- clientConnection@@ -67,8 +69,9 @@ sref piref q- undefined- undefined+ dq+ (\_ _ -> return ())+ (return undefined) genSRT initializeCoder clientConn InitialLevel $ initialSecrets ver serverCID serverConn <-@@ -83,8 +86,9 @@ sref piref -- dummy q- undefined- undefined+ dq+ (\_ _ -> return ())+ (return undefined) genSRT initializeCoder serverConn InitialLevel $ initialSecrets ver serverCID ----
test/TLSSpec.hs view
@@ -5,6 +5,7 @@ module TLSSpec where import Data.Bits+import Data.ByteArray (ScrubbedBytes, convert) import qualified Data.ByteString as BS import Data.Maybe import Network.TLS.Extra.Cipher@@ -36,23 +37,23 @@ let client_initial_secret@(ClientTrafficSecret cis) = clientInitialSecret ver dcID client_initial_secret `shouldBe` ClientTrafficSecret- (dec16 "c00cf151ca5be075ed0ebfb5c80323c42d6b7db67881289af4008f1f6c357aea")+ (dec16' "c00cf151ca5be075ed0ebfb5c80323c42d6b7db67881289af4008f1f6c357aea") let ckey = aeadKey ver defaultCipher (Secret cis)- ckey `shouldBe` Key (dec16 "1f369613dd76d5467730efcbe3b1a22d")+ ckey `shouldBe` Key (dec16' "1f369613dd76d5467730efcbe3b1a22d") let civ = initialVector ver defaultCipher (Secret cis) civ `shouldBe` IV (dec16 "fa044b2f42a3fd3b46fb255c") let chp = headerProtectionKey ver defaultCipher (Secret cis)- chp `shouldBe` Key (dec16 "9f50449e04a0e810283a1e9933adedd2")+ chp `shouldBe` Key (dec16' "9f50449e04a0e810283a1e9933adedd2") let server_initial_secret@(ServerTrafficSecret sis) = serverInitialSecret ver dcID server_initial_secret `shouldBe` ServerTrafficSecret- (dec16 "3c199828fd139efd216c155ad844cc81fb82fa8d7446fa7d78be803acdda951b")+ (dec16' "3c199828fd139efd216c155ad844cc81fb82fa8d7446fa7d78be803acdda951b") let skey = aeadKey ver defaultCipher (Secret sis)- skey `shouldBe` Key (dec16 "cf3a5331653c364c88f0f379b6067e37")+ skey `shouldBe` Key (dec16' "cf3a5331653c364c88f0f379b6067e37") let siv = initialVector ver defaultCipher (Secret sis) siv `shouldBe` IV (dec16 "0ac1493ca1905853b0bba03e") let shp = headerProtectionKey ver defaultCipher (Secret sis)- shp `shouldBe` Key (dec16 "c206b8d9b9f0f37644430b490eeaa314")+ shp `shouldBe` Key (dec16' "c206b8d9b9f0f37644430b490eeaa314") it "describes the examples of Client Initial (RFC 9001: A.2)" $ do let dcID = makeCID (dec16s "8394c8f03e515708")@@ -159,7 +160,7 @@ let cipher = cipher13_CHACHA20_POLY1305_SHA256 secret = Secret $- dec16 "9ac312a7f877468ebe69422748ad00a15443f18203a07d6060f688f30f21632b"+ dec16' "9ac312a7f877468ebe69422748ad00a15443f18203a07d6060f688f30f21632b" key = aeadKey ver cipher secret iv = initialVector ver cipher secret hp = headerProtectionKey ver cipher secret@@ -168,14 +169,14 @@ sample = Sample $ dec16 "5e5cd55c41f69080575d7999c25a5bfb" mask = protectionMask cipher hp sample key- `shouldBe` Key (dec16 "c6d98ff3441c3fe1b2182094f69caa2ed4b716b65488960a7a984979fb23e1c8")+ `shouldBe` Key (dec16' "c6d98ff3441c3fe1b2182094f69caa2ed4b716b65488960a7a984979fb23e1c8") iv `shouldBe` IV (dec16 "e0459b3474bdd0e44a41c144") hp- `shouldBe` Key (dec16 "25a282b9e82f06f21f488917a4fc8f1b73573685608597d0efcb076b0ab7a7a4")+ `shouldBe` Key (dec16' "25a282b9e82f06f21f488917a4fc8f1b73573685608597d0efcb076b0ab7a7a4") ku `shouldBe` Secret- (dec16 "1223504755036d556342ee9361d253421a826c9ecdf3c7148684b36b714881f9")+ (dec16' "1223504755036d556342ee9361d253421a826c9ecdf3c7148684b36b714881f9") payloadCipherText `shouldBe` Just (dec16 "65", dec16 "5e5cd55c41f69080575d7999c25a5bfb") mask `shouldBe` Mask (dec16 "aefefe7d03")@@ -194,23 +195,23 @@ let client_initial_secret@(ClientTrafficSecret cis) = clientInitialSecret ver dcID client_initial_secret `shouldBe` ClientTrafficSecret- (dec16 "14ec9d6eb9fd7af83bf5a668bc17a7e283766aade7ecd0891f70f9ff7f4bf47b")+ (dec16' "14ec9d6eb9fd7af83bf5a668bc17a7e283766aade7ecd0891f70f9ff7f4bf47b") let ckey = aeadKey ver defaultCipher (Secret cis)- ckey `shouldBe` Key (dec16 "8b1a0bc121284290a29e0971b5cd045d")+ ckey `shouldBe` Key (dec16' "8b1a0bc121284290a29e0971b5cd045d") let civ = initialVector ver defaultCipher (Secret cis) civ `shouldBe` IV (dec16 "91f73e2351d8fa91660e909f") let chp = headerProtectionKey ver defaultCipher (Secret cis)- chp `shouldBe` Key (dec16 "45b95e15235d6f45a6b19cbcb0294ba9")+ chp `shouldBe` Key (dec16' "45b95e15235d6f45a6b19cbcb0294ba9") let server_initial_secret@(ServerTrafficSecret sis) = serverInitialSecret ver dcID server_initial_secret `shouldBe` ServerTrafficSecret- (dec16 "0263db1782731bf4588e7e4d93b7463907cb8cd8200b5da55a8bd488eafc37c1")+ (dec16' "0263db1782731bf4588e7e4d93b7463907cb8cd8200b5da55a8bd488eafc37c1") let skey = aeadKey ver defaultCipher (Secret sis)- skey `shouldBe` Key (dec16 "82db637861d55e1d011f19ea71d5d2a7")+ skey `shouldBe` Key (dec16' "82db637861d55e1d011f19ea71d5d2a7") let siv = initialVector ver defaultCipher (Secret sis) siv `shouldBe` IV (dec16 "dd13c276499c0249d3310652") let shp = headerProtectionKey ver defaultCipher (Secret sis)- shp `shouldBe` Key (dec16 "edf6d05c83121201b436e16877593c3a")+ shp `shouldBe` Key (dec16' "edf6d05c83121201b436e16877593c3a") it "describes the examples of Client Initial (RFC 9369: A2)" $ do let dcID = makeCID (dec16s "8394c8f03e515708")@@ -317,7 +318,7 @@ let cipher = cipher13_CHACHA20_POLY1305_SHA256 secret = Secret $- dec16 "9ac312a7f877468ebe69422748ad00a15443f18203a07d6060f688f30f21632b"+ dec16' "9ac312a7f877468ebe69422748ad00a15443f18203a07d6060f688f30f21632b" key = aeadKey ver cipher secret iv = initialVector ver cipher secret hp = headerProtectionKey ver cipher secret@@ -326,14 +327,14 @@ sample = Sample $ dec16 "e7b6b932bc27d786f4bc2bb20f2162ba" mask = protectionMask cipher hp sample key- `shouldBe` Key (dec16 "3bfcddd72bcf02541d7fa0dd1f5f9eeea817e09a6963a0e6c7df0f9a1bab90f2")+ `shouldBe` Key (dec16' "3bfcddd72bcf02541d7fa0dd1f5f9eeea817e09a6963a0e6c7df0f9a1bab90f2") iv `shouldBe` IV (dec16 "a6b5bc6ab7dafce30ffff5dd") hp- `shouldBe` Key (dec16 "d659760d2ba434a226fd37b35c69e2da8211d10c4f12538787d65645d5d1b8e2")+ `shouldBe` Key (dec16' "d659760d2ba434a226fd37b35c69e2da8211d10c4f12538787d65645d5d1b8e2") ku `shouldBe` Secret- (dec16 "c69374c49e3d2a9466fa689e49d476db5d0dfbc87d32ceeaa6343fd0ae4c7d88")+ (dec16' "c69374c49e3d2a9466fa689e49d476db5d0dfbc87d32ceeaa6343fd0ae4c7d88") payloadCipherText `shouldBe` Just (dec16 "0a", dec16 "e7b6b932bc27d786f4bc2bb20f2162ba") mask `shouldBe` Mask (dec16 "97580e32bf")@@ -363,3 +364,6 @@ , "3900320408ffffffffffffffff05048000ffff07048000ffff08011001048000" , "75300901100f088394c8f03e51570806048000ffff" ]++dec16' :: BS.ByteString -> ScrubbedBytes+dec16' = convert . dec16