diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # 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. 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" @@ -185,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)] @@ -219,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/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 @@ -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/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.3.1 +version: 0.3.2 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp @@ -237,6 +237,7 @@ hs-source-dirs: test other-modules: Config + DatagramSpec ErrorSpec FrameSpec HandshakeSpec @@ -262,6 +263,7 @@ 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/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 ----