diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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) diff --git a/Network/QUIC.hs b/Network/QUIC.hs --- a/Network/QUIC.hs +++ b/Network/QUIC.hs @@ -34,6 +34,10 @@ recvStream, sendStream, sendStreamMany, + sendDatagram, + recvDatagram, + recvDatagramMany, + recvDatagramSTM, -- * Information ConnectionInfo, diff --git a/Network/QUIC/Client.hs b/Network/QUIC/Client.hs --- a/Network/QUIC/Client.hs +++ b/Network/QUIC/Client.hs @@ -12,6 +12,7 @@ ccPortName, ccALPN, ccUse0RTT, + ccMaxDatagramFrameSize, ccResumption, ccCiphers, ccGroups, diff --git a/Network/QUIC/Client/Run.hs b/Network/QUIC/Client/Run.hs --- a/Network/QUIC/Client/Run.hs +++ b/Network/QUIC/Client/Run.hs @@ -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 diff --git a/Network/QUIC/Config.hs b/Network/QUIC/Config.hs --- a/Network/QUIC/Config.hs +++ b/Network/QUIC/Config.hs @@ -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 diff --git a/Network/QUIC/Connection/Misc.hs b/Network/QUIC/Connection/Misc.hs --- a/Network/QUIC/Connection/Misc.hs +++ b/Network/QUIC/Connection/Misc.hs @@ -147,6 +147,7 @@ , initialMaxStreamDataUni = resumptionInitialMaxStreamDataUni , initialMaxStreamsBidi = resumptionInitialMaxStreamsBidi , initialMaxStreamsUni = resumptionInitialMaxStreamsUni + , maxDatagramFrameSize = resumptionMaxDatagramFrameSize } ---------------------------------------------------------------- diff --git a/Network/QUIC/Connection/Role.hs b/Network/QUIC/Connection/Role.hs --- a/Network/QUIC/Connection/Role.hs +++ b/Network/QUIC/Connection/Role.hs @@ -127,6 +127,7 @@ , resumptionInitialMaxStreamDataUni = initialMaxStreamDataUni , resumptionInitialMaxStreamsBidi = initialMaxStreamsBidi , resumptionInitialMaxStreamsUni = initialMaxStreamsUni + , resumptionMaxDatagramFrameSize = maxDatagramFrameSize } ---------------------------------------------------------------- diff --git a/Network/QUIC/Connection/State.hs b/Network/QUIC/Connection/State.hs --- a/Network/QUIC/Connection/State.hs +++ b/Network/QUIC/Connection/State.hs @@ -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 diff --git a/Network/QUIC/Connection/Types.hs b/Network/QUIC/Connection/Types.hs --- a/Network/QUIC/Connection/Types.hs +++ b/Network/QUIC/Connection/Types.hs @@ -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 diff --git a/Network/QUIC/Crypto/Fusion.hs b/Network/QUIC/Crypto/Fusion.hs --- a/Network/QUIC/Crypto/Fusion.hs +++ b/Network/QUIC/Crypto/Fusion.hs @@ -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 diff --git a/Network/QUIC/Crypto/Keys.hs b/Network/QUIC/Crypto/Keys.hs --- a/Network/QUIC/Crypto/Keys.hs +++ b/Network/QUIC/Crypto/Keys.hs @@ -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 diff --git a/Network/QUIC/Crypto/Nite.hs b/Network/QUIC/Crypto/Nite.hs --- a/Network/QUIC/Crypto/Nite.hs +++ b/Network/QUIC/Crypto/Nite.hs @@ -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 ---------------------------------------------------------------- diff --git a/Network/QUIC/Crypto/Types.hs b/Network/QUIC/Crypto/Types.hs --- a/Network/QUIC/Crypto/Types.hs +++ b/Network/QUIC/Crypto/Types.hs @@ -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 diff --git a/Network/QUIC/Handshake.hs b/Network/QUIC/Handshake.hs --- a/Network/QUIC/Handshake.hs +++ b/Network/QUIC/Handshake.hs @@ -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 diff --git a/Network/QUIC/IO.hs b/Network/QUIC/IO.hs --- a/Network/QUIC/IO.hs +++ b/Network/QUIC/IO.hs @@ -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 diff --git a/Network/QUIC/Info.hs b/Network/QUIC/Info.hs --- a/Network/QUIC/Info.hs +++ b/Network/QUIC/Info.hs @@ -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 } ---------------------------------------------------------------- diff --git a/Network/QUIC/Packet/Frame.hs b/Network/QUIC/Packet/Frame.hs --- a/Network/QUIC/Packet/Frame.hs +++ b/Network/QUIC/Packet/Frame.hs @@ -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 diff --git a/Network/QUIC/Parameters.hs b/Network/QUIC/Parameters.hs --- a/Network/QUIC/Parameters.hs +++ b/Network/QUIC/Parameters.hs @@ -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 diff --git a/Network/QUIC/Qlog.hs b/Network/QUIC/Qlog.hs --- a/Network/QUIC/Qlog.hs +++ b/Network/QUIC/Qlog.hs @@ -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 diff --git a/Network/QUIC/Receiver.hs b/Network/QUIC/Receiver.hs --- a/Network/QUIC/Receiver.hs +++ b/Network/QUIC/Receiver.hs @@ -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. diff --git a/Network/QUIC/Sender.hs b/Network/QUIC/Sender.hs --- a/Network/QUIC/Sender.hs +++ b/Network/QUIC/Sender.hs @@ -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) diff --git a/Network/QUIC/Server.hs b/Network/QUIC/Server.hs --- a/Network/QUIC/Server.hs +++ b/Network/QUIC/Server.hs @@ -12,6 +12,7 @@ scALPN, scRequireRetry, scUse0RTT, + scMaxDatagramFrameSize, scCiphers, scGroups, scVersions, diff --git a/Network/QUIC/Server/Run.hs b/Network/QUIC/Server/Run.hs --- a/Network/QUIC/Server/Run.hs +++ b/Network/QUIC/Server/Run.hs @@ -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) diff --git a/Network/QUIC/TLS.hs b/Network/QUIC/TLS.hs --- a/Network/QUIC/TLS.hs +++ b/Network/QUIC/TLS.hs @@ -122,6 +122,7 @@ { supportedVersions = [TLS13] , supportedCiphers = scCiphers , supportedGroups = scGroups + , supportedGroupsTLS13 = scGroupsTLS13 } debug = defaultDebugParams diff --git a/Network/QUIC/Types/Exception.hs b/Network/QUIC/Types/Exception.hs --- a/Network/QUIC/Types/Exception.hs +++ b/Network/QUIC/Types/Exception.hs @@ -31,6 +31,7 @@ = MustNotReached | ExitConnection | WrongTransportParameter + | WrongDatagramSizeParameter | WrongVersionInformation | BreakForever deriving (Eq, Show) diff --git a/Network/QUIC/Types/Frame.hs b/Network/QUIC/Types/Frame.hs --- a/Network/QUIC/Types/Frame.hs +++ b/Network/QUIC/Types/Frame.hs @@ -40,6 +40,7 @@ | ConnectionClose TransportError FrameType ReasonPhrase | ConnectionCloseApp ApplicationProtocolError ReasonPhrase | HandshakeDone + | Datagram Bool ByteString | UnknownFrame Int deriving (Eq, Show) diff --git a/Network/QUIC/Types/Info.hs b/Network/QUIC/Types/Info.hs --- a/Network/QUIC/Types/Info.hs +++ b/Network/QUIC/Types/Info.hs @@ -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 "" diff --git a/Network/QUIC/Types/Resumption.hs b/Network/QUIC/Types/Resumption.hs --- a/Network/QUIC/Types/Resumption.hs +++ b/Network/QUIC/Types/Resumption.hs @@ -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? diff --git a/quic.cabal b/quic.cabal --- a/quic.cabal +++ b/quic.cabal @@ -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 diff --git a/test/Config.hs b/test/Config.hs --- a/test/Config.hs +++ b/test/Config.hs @@ -150,7 +150,7 @@ where hints = defaultHints - { addrSocketType = Datagram + { addrSocketType = Network.Socket.Datagram , addrFlags = [AI_NUMERICHOST] , addrFamily = AF_INET } diff --git a/test/DatagramSpec.hs b/test/DatagramSpec.hs new file mode 100644 --- /dev/null +++ b/test/DatagramSpec.hs @@ -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 diff --git a/test/HandshakeSpec.hs b/test/HandshakeSpec.hs --- a/test/HandshakeSpec.hs +++ b/test/HandshakeSpec.hs @@ -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 diff --git a/test/PacketSpec.hs b/test/PacketSpec.hs --- a/test/PacketSpec.hs +++ b/test/PacketSpec.hs @@ -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 ---- diff --git a/test/TLSSpec.hs b/test/TLSSpec.hs --- a/test/TLSSpec.hs +++ b/test/TLSSpec.hs @@ -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