quic 0.2.8 → 0.2.9

raw patch · 13 files changed

+113/−80 lines, 13 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Network/QUIC/Client/Run.hs +1/−1
• Network/QUIC/Connection/Misc.hs +5/−2
• Network/QUIC/Connection/Role.hs +8/−7
• Network/QUIC/Connection/State.hs +14/−4
• Network/QUIC/Connector.hs +1/−0
• Network/QUIC/Handshake.hs +12/−9
• Network/QUIC/IO.hs +2/−1
• Network/QUIC/Receiver.hs +46/−35
• Network/QUIC/TLS.hs +1/−1
• Network/QUIC/Types/Resumption.hs +7/−12
• quic.cabal +8/−8
• test/TransportError.hs +3/−0

@@ -1,5 +1,10 @@ # ChangeLog +## 0.2.9++* Don't send Fin if connection is already closed.+* Using clientWantSessionResumeList for multiple tickets.+ ## 0.2.8  * Proper handling for stateless reset. Servers generate SRTs based on

@@ -40,7 +40,7 @@ run conf client = do     let resInfo = ccResumption conf         verInfo = case resumptionSession resInfo of-            Nothing+            []                 | resumptionToken resInfo == emptyToken ->                     let ver = ccVersion conf                         vers = ccVersions conf

@@ -40,6 +40,7 @@ import System.Mem.Weak  import Network.QUIC.Connection.Queue+import Network.QUIC.Connection.State import Network.QUIC.Connection.Timeout import Network.QUIC.Connection.Types import Network.QUIC.Connector@@ -210,8 +211,10 @@  -- | Closing a connection with/without a transport error. --   Internal threads should use this.-closeConnection :: TransportError -> ReasonPhrase -> IO ()-closeConnection err desc = E.throwIO quicexc+closeConnection :: Connection -> TransportError -> ReasonPhrase -> IO ()+closeConnection conn err desc = do+    setConnectionClosed conn+    E.throwIO quicexc   where     quicexc = TransportErrorIsSent err desc 

@@ -84,13 +84,14 @@ setResumptionSession conn@Connection{..} si sd = do     ver <- getVersion conn     atomicModifyIORef'' roleInfo $ \ci ->-        ci-            { resumptionInfo =-                (resumptionInfo ci)-                    { resumptionVersion = ver-                    , resumptionSession = Just (si, sd)-                    }-            }+        let resumInfo = resumptionInfo ci+         in ci+                { resumptionInfo =+                    resumInfo+                        { resumptionVersion = ver+                        , resumptionSession = (si, sd) : resumptionSession resumInfo+                        }+                }     return Nothing  setNewToken :: Connection -> Token -> IO ()

@@ -6,6 +6,8 @@     setConnection1RTTReady,     isConnectionEstablished,     setConnectionEstablished,+    isConnectionClosed,+    setConnectionClosed,     wait0RTTReady,     wait1RTTReady,     waitEstablished,@@ -49,33 +51,41 @@ setConnectionEstablished :: Connection -> IO () setConnectionEstablished conn = setConnectionState conn Established +setConnectionClosed :: Connection -> IO ()+setConnectionClosed conn = setConnectionState conn Closed+ ----------------------------------------------------------------  isConnection1RTTReady :: Connection -> IO Bool isConnection1RTTReady Connection{..} = atomically $ do     st <- readTVar $ connectionState connState-    return (st >= ReadyFor1RTT)+    return (st >= ReadyFor1RTT && st /= Closed) +isConnectionClosed :: Connection -> IO Bool+isConnectionClosed Connection{..} = atomically $ do+    st <- readTVar $ connectionState connState+    return (st == Closed)+ ----------------------------------------------------------------  -- | Waiting until 0-RTT data can be sent. wait0RTTReady :: Connection -> IO () wait0RTTReady Connection{..} = atomically $ do     cs <- readTVar $ connectionState connState-    check (cs >= ReadyFor0RTT)+    check (cs >= ReadyFor0RTT && cs /= Closed)  -- | Waiting until 1-RTT data can be sent. wait1RTTReady :: Connection -> IO () wait1RTTReady Connection{..} = atomically $ do     cs <- readTVar $ connectionState connState-    check (cs >= ReadyFor1RTT)+    check (cs >= ReadyFor1RTT && cs /= Closed)  -- | For clients, waiting until HANDSHAKE_DONE is received. --   For servers, waiting until a TLS stack reports that the handshake is complete. waitEstablished :: Connection -> IO () waitEstablished Connection{..} = atomically $ do     cs <- readTVar $ connectionState connState-    check (cs >= Established)+    check (cs >= Established && cs /= Closed)  ---------------------------------------------------------------- 

@@ -52,6 +52,7 @@     | ReadyFor0RTT     | ReadyFor1RTT     | Established+    | Closed     deriving (Eq, Ord, Show)  isConnectionEstablished :: Connector a => a -> IO Bool

@@ -112,7 +112,8 @@ handshakeClient' conf conn myAuthCIDs ver hsr = handshaker   where     handshaker =-        clientHandshaker qc conf ver myAuthCIDs setter use0RTT `E.catch` sendCCTLSError+        clientHandshaker qc conf ver myAuthCIDs setter use0RTT+            `E.catch` sendCCTLSError conn     qc =         QUICCallbacks             { quicSend = sendTLS conn hsr@@ -178,7 +179,9 @@     -> IO () handshakeServer' conf conn ver hsRef paramRef = handshaker   where-    handshaker = serverHandshaker qc conf ver getParams `E.catch` sendCCTLSError+    handshaker =+        serverHandshaker qc conf ver getParams+            `E.catch` sendCCTLSError conn     qc =         QUICCallbacks             { quicSend = sendTLS conn hsRef@@ -235,7 +238,7 @@     tpId <- extensionIDForTtransportParameter <$> getVersion conn     case getTP tpId peerExts of         Nothing ->-            sendCCTLSAlert TLS.MissingExtension "QUIC transport parameters are mssing"+            sendCCTLSAlert conn TLS.MissingExtension "QUIC transport parameters are mssing"         Just (ExtensionRaw _ bs) -> setPP bs   where     getTP n = find (\(ExtensionRaw extid _) -> extid == n)@@ -325,17 +328,17 @@ sendCCVNError :: IO () sendCCVNError = E.throwIO WrongVersionInformation -sendCCTLSError :: TLS.TLSException -> IO ()-sendCCTLSError (TLS.HandshakeFailed (TLS.Error_Misc "WrongTransportParameter")) = closeConnection TransportParameterError "Transport parameter error"-sendCCTLSError (TLS.HandshakeFailed (TLS.Error_Misc "WrongVersionInformation")) = closeConnection VersionNegotiationError "Version negotiation error"-sendCCTLSError e = closeConnection err msg+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 e = closeConnection conn err msg   where     tlserr = getErrorCause e     err = cryptoError $ errorToAlertDescription tlserr     msg = shortpack $ errorToAlertMessage tlserr -sendCCTLSAlert :: TLS.AlertDescription -> ReasonPhrase -> IO ()-sendCCTLSAlert a msg = closeConnection (cryptoError a) msg+sendCCTLSAlert :: Connection -> TLS.AlertDescription -> ReasonPhrase -> IO ()+sendCCTLSAlert conn a msg = closeConnection conn (cryptoError a) msg  getErrorCause :: TLS.TLSException -> TLS.TLSError getErrorCause (TLS.Terminated _ _ e) = e

@@ -140,8 +140,9 @@ closeStream s = do     let conn = streamConnection s     let sid = streamId s+    closed <- isConnectionClosed conn     sclosed <- isTxStreamClosed s-    unless sclosed $ do+    unless (closed || sclosed) $ do         setTxStreamClosed s         setRxStreamClosed s         putSendStreamQ conn $ TxStreamData s [] 0 True

@@ -148,14 +148,14 @@         Just plain@Plain{..} -> do             addRxBytes conn $ rpReceivedBytes rpkt             when (isIllegalReservedBits plainMarks || isNoFrames plainMarks) $-                closeConnection ProtocolViolation "Non 0 RR bits or no frames"+                closeConnection conn ProtocolViolation "Non 0 RR bits or no frames"             when (isUnknownFrame plainMarks) $-                closeConnection FrameEncodingError "Unknown frame"+                closeConnection conn FrameEncodingError "Unknown frame"             let controlled = checkRate plainFrames             when (controlled /= 0) $ do                 rate <- addRate (controlRate conn) controlled                 when (rate > rateLimit) $ do-                    closeConnection QUIC.InternalError "Rate control"+                    closeConnection conn QUIC.InternalError "Rate control"             -- For Ping, record PPN first, then send an ACK.             onPacketReceived (connLDCC conn) lvl plainPacketNumber             when (lvl == RTT1Level) $ setPeerPacketNumber conn plainPacketNumber@@ -214,7 +214,7 @@     | isInitiated conn sid = do         curSid <- getMyStreamId conn         when (sid > curSid) $-            closeConnection StreamStateError emsg+            closeConnection conn StreamStateError emsg streamNotCreatedYet _ _ _ = return ()  processFrame :: Connection -> EncryptionLevel -> Frame -> IO ()@@ -223,13 +223,13 @@     -- see ackEli above     when (lvl /= InitialLevel && lvl /= RTT1Level) $ sendFrames conn lvl [] processFrame conn lvl (Ack ackInfo ackDelay) = do-    when (lvl == RTT0Level) $ closeConnection ProtocolViolation "ACK"+    when (lvl == RTT0Level) $ closeConnection conn ProtocolViolation "ACK"     onAckReceived (connLDCC conn) lvl ackInfo $ milliToMicro ackDelay processFrame conn lvl (ResetStream sid aerr _finlen) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $-        closeConnection ProtocolViolation "RESET_STREAM"+        closeConnection conn ProtocolViolation "RESET_STREAM"     when (isSendOnly conn sid) $-        closeConnection StreamStateError "Received in a send-only stream"+        closeConnection conn StreamStateError "Received in a send-only stream"     mstrm <- findStream conn sid     case mstrm of         Nothing -> return ()@@ -240,9 +240,9 @@             delStream conn strm processFrame conn lvl (StopSending sid err) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $-        closeConnection ProtocolViolation "STOP_SENDING"+        closeConnection conn ProtocolViolation "STOP_SENDING"     when (isReceiveOnly conn sid) $-        closeConnection StreamStateError "Receive-only stream"+        closeConnection conn StreamStateError "Receive-only stream"     mstrm <- findStream conn sid     case mstrm of         Nothing -> streamNotCreatedYet conn sid "No such stream for STOP_SENDING"@@ -250,7 +250,7 @@ processFrame _ _ (CryptoF _ "") = return () processFrame conn lvl (CryptoF off cdat) = do     when (lvl == RTT0Level) $-        closeConnection ProtocolViolation "CRYPTO in 0-RTT"+        closeConnection conn ProtocolViolation "CRYPTO in 0-RTT"     let len = BS.length cdat         rx = RxStreamData cdat off len False     case lvl of@@ -266,18 +266,18 @@             | isClient conn ->                 void $ putRxCrypto conn lvl rx             | otherwise ->-                closeConnection (cryptoError UnexpectedMessage) "CRYPTO in 1-RTT"+                closeConnection conn (cryptoError UnexpectedMessage) "CRYPTO in 1-RTT" processFrame conn lvl (NewToken token) = do     when (isServer conn || lvl /= RTT1Level) $-        closeConnection ProtocolViolation "NEW_TOKEN for server or in 1-RTT"+        closeConnection conn ProtocolViolation "NEW_TOKEN for server or in 1-RTT"     when (isClient conn) $ setNewToken conn token processFrame conn RTT0Level (StreamF sid off (dat : _) fin) = do     when (off == 0) $ updatePeerStreamId conn sid     -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit     ok <- checkRxMaxStreams conn sid-    unless ok $ closeConnection StreamLimitError "stream id is too large"+    unless ok $ closeConnection conn StreamLimitError "stream id is too large"     when (isSendOnly conn sid) $-        closeConnection StreamStateError "send-only stream"+        closeConnection conn StreamStateError "send-only stream"     mstrm <- findStream conn sid     guardStream conn sid mstrm     strm <- maybe (createStream conn sid) return mstrm@@ -286,28 +286,32 @@     fc <- putRxStreamData strm rx     case fc of         -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit-        OverLimit -> closeConnection FlowControlError "Flow control error for stream in 0-RTT"+        OverLimit ->+            closeConnection conn FlowControlError "Flow control error for stream in 0-RTT"         Duplicated -> return ()         Reassembled -> do             ok' <- checkRxMaxData conn len             -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit             unless ok' $-                closeConnection FlowControlError "Flow control error for connection in 0-RTT"+                closeConnection+                    conn+                    FlowControlError+                    "Flow control error for connection in 0-RTT" processFrame conn RTT1Level (StreamF sid _ [""] False) = do     -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit     ok <- checkRxMaxStreams conn sid-    unless ok $ closeConnection StreamLimitError "stream id is too large"+    unless ok $ closeConnection conn StreamLimitError "stream id is too large"     when (isSendOnly conn sid) $-        closeConnection StreamStateError "send-only stream"+        closeConnection conn StreamStateError "send-only stream"     mstrm <- findStream conn sid     guardStream conn sid mstrm processFrame conn RTT1Level (StreamF sid off (dat : _) fin) = do     when (off == 0) $ updatePeerStreamId conn sid     -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit     ok <- checkRxMaxStreams conn sid-    unless ok $ closeConnection StreamLimitError "stream id is too large"+    unless ok $ closeConnection conn StreamLimitError "stream id is too large"     when (isSendOnly conn sid) $-        closeConnection StreamStateError "send-only stream"+        closeConnection conn StreamStateError "send-only stream"     mstrm <- findStream conn sid     guardStream conn sid mstrm     strm <- maybe (createStream conn sid) return mstrm@@ -316,50 +320,57 @@     fc <- putRxStreamData strm rx     case fc of         -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit-        OverLimit -> closeConnection FlowControlError "Flow control error for stream in 1-RTT"+        OverLimit ->+            closeConnection conn FlowControlError "Flow control error for stream in 1-RTT"         Duplicated -> return ()         Reassembled -> do             ok' <- checkRxMaxData conn len             -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit             unless ok' $-                closeConnection FlowControlError "Flow control error for connection in 1-RTT"+                closeConnection+                    conn+                    FlowControlError+                    "Flow control error for connection in 1-RTT" processFrame conn lvl (MaxData n) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $-        closeConnection ProtocolViolation "MAX_DATA in Initial or Handshake"+        closeConnection conn ProtocolViolation "MAX_DATA in Initial or Handshake"     setTxMaxData conn n processFrame conn lvl (MaxStreamData sid n) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $-        closeConnection ProtocolViolation "MAX_STREAM_DATA in Initial or Handshake"+        closeConnection conn ProtocolViolation "MAX_STREAM_DATA in Initial or Handshake"     when (isReceiveOnly conn sid) $-        closeConnection StreamStateError "Receive-only stream"+        closeConnection conn StreamStateError "Receive-only stream"     mstrm <- findStream conn sid     case mstrm of         Nothing -> streamNotCreatedYet conn sid "No such stream for MAX_STREAM_DATA"         Just strm -> setTxMaxStreamData strm n processFrame conn lvl (MaxStreams dir n) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $-        closeConnection ProtocolViolation "MAX_STREAMS in Initial or Handshake"+        closeConnection conn ProtocolViolation "MAX_STREAMS in Initial or Handshake"     when (n > 2 ^ (60 :: Int)) $-        closeConnection FrameEncodingError "Too large MAX_STREAMS"+        closeConnection conn FrameEncodingError "Too large MAX_STREAMS"     if dir == Bidirectional         then setTxMaxStreams conn n         else setTxUniMaxStreams conn n processFrame _conn _lvl DataBlocked{} = return () processFrame _conn _lvl (StreamDataBlocked _sid _) = return ()-processFrame _conn lvl (StreamsBlocked _dir n) = do+processFrame conn lvl (StreamsBlocked _dir n) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $-        closeConnection ProtocolViolation "STREAMS_BLOCKED in Initial or Handshake"+        closeConnection conn ProtocolViolation "STREAMS_BLOCKED in Initial or Handshake"     when (n > 2 ^ (60 :: Int)) $-        closeConnection FrameEncodingError "Too large STREAMS_BLOCKED"+        closeConnection conn FrameEncodingError "Too large STREAMS_BLOCKED" processFrame conn lvl (NewConnectionID cidInfo rpt) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $-        closeConnection ProtocolViolation "NEW_CONNECTION_ID in Initial or Handshake"+        closeConnection+            conn+            ProtocolViolation+            "NEW_CONNECTION_ID in Initial or Handshake"     ok <- addPeerCID conn cidInfo     unless ok $-        closeConnection ConnectionIdLimitError "NEW_CONNECTION_ID limit error"+        closeConnection conn ConnectionIdLimitError "NEW_CONNECTION_ID limit error"     let (_, cidlen) = unpackCID $ cidInfoCID cidInfo     when (cidlen < 1 || 20 < cidlen || rpt > cidInfoSeq cidInfo) $-        closeConnection FrameEncodingError "NEW_CONNECTION_ID parameter error"+        closeConnection conn FrameEncodingError "NEW_CONNECTION_ID parameter error"     when (rpt >= 1) $ do         seqNums <- setPeerCIDAndRetireCIDs conn rpt         sendFramesLim conn RTT1Level $ map RetireConnectionID seqNums@@ -386,7 +397,7 @@     E.throwIO quicexc processFrame conn lvl HandshakeDone = do     when (isServer conn || lvl /= RTT1Level) $-        closeConnection ProtocolViolation "HANDSHAKE_DONE for server"+        closeConnection conn ProtocolViolation "HANDSHAKE_DONE for server"     fire conn (Microseconds 100000) $ do         let ldcc = connLDCC conn         discarded0 <- getAndSetPacketNumberSpaceDiscarded ldcc RTT0Level@@ -401,7 +412,7 @@     getConnectionInfo conn >>= onConnectionEstablished (connHooks conn)     -- to receive NewSessionTicket     fire conn (Microseconds 1000000) $ killHandshaker conn lvl-processFrame _ _ _ = closeConnection ProtocolViolation "Frame is not allowed"+processFrame conn _ _ = closeConnection conn ProtocolViolation "Frame is not allowed"  -- Return value indicates duplication. putRxCrypto :: Connection -> EncryptionLevel -> RxStreamData -> IO Bool

@@ -37,7 +37,7 @@             , clientHooks = hook             , clientSupported = supported             , clientDebug = debug-            , clientWantSessionResume = resumptionSession ccResumption+            , clientWantSessionResumeList = resumptionSession ccResumption             , clientUseEarlyData = use0RTT             }     convTP = onTransportParametersCreated ccHooks

@@ -8,7 +8,6 @@ import Network.TLS hiding (Version) import Network.TLS.QUIC -import Network.QUIC.Imports import Network.QUIC.Types.Frame import Network.QUIC.Types.Packet @@ -17,7 +16,7 @@ -- | Information about resumption data ResumptionInfo = ResumptionInfo     { resumptionVersion :: Version-    , resumptionSession :: Maybe (SessionID, SessionData)+    , resumptionSession :: [(SessionID, SessionData)]     , resumptionToken :: Token     , resumptionRetry :: Bool     }@@ -29,7 +28,7 @@ defaultResumptionInfo =     ResumptionInfo         { resumptionVersion = Version1-        , resumptionSession = Nothing+        , resumptionSession = []         , resumptionToken = emptyToken         , resumptionRetry = False         }@@ -39,15 +38,11 @@ is0RTTPossible ResumptionInfo{..} =     rtt0OK && (not resumptionRetry || resumptionToken /= emptyToken)   where-    rtt0OK = case resumptionSession of-        Nothing -> False-        Just (_, sd) -> sessionMaxEarlyDataSize sd == quicMaxEarlyDataSize+    rtt0OK =+        any+            (\(_, sd) -> sessionMaxEarlyDataSize sd == quicMaxEarlyDataSize)+            resumptionSession  -- | Is resumption possible? isResumptionPossible :: ResumptionInfo -> Bool-isResumptionPossible ResumptionInfo{..} = isJust resumptionSession--get0RTTCipher :: ResumptionInfo -> Maybe CipherID-get0RTTCipher ri = case resumptionSession ri of-    Nothing -> Nothing-    Just (_, sd) -> Just $ sessionCipher sd+isResumptionPossible ResumptionInfo{..} = not $ null resumptionSession

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               quic-version:            0.2.8+version:            0.2.9 license:            BSD3 license-file:       LICENSE maintainer:         kazu@iij.ad.jp@@ -128,28 +128,28 @@     ghc-options:        -Wall -Wcompat     build-depends:         base >=4.9 && <5,-        async,         array >= 0.5 && < 0.6,+        async,         base16-bytestring >= 1.0 && < 1.1,         bytestring >= 0.10,         containers,         crypto-token >= 0.1.2 && < 0.2,         crypton >= 0.34,-        memory >= 0.18.0 && < 0.19,         crypton-x509 >= 1.7.6 && < 1.8,         crypton-x509-system >= 1.6.7 && < 1.7,-        filepath,-        stm >= 2.5 && < 2.6,         data-default,         fast-logger >= 3.2.2 && < 3.3,-        unix-time >= 0.4.12 && < 0.5,+        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,-        random >= 1.2.1 && < 1.4,+        random >= 1.3 && < 1.4,         serialise,-        tls >= 2.1.6 && < 2.2+        stm >= 2.5 && < 2.6,+        tls >= 2.1.6 && < 2.2,+        unix-time >= 0.4.12 && < 0.5      if os(windows)         cc-options: -D_WINDOWS

@@ -294,6 +294,9 @@  ---------------------------------------------------------------- +-- Stream 0 is not created internally.  It is assumed that a server+-- send CC without sending back Stream 0.  If the server send back any+-- data for Stream 0, `streamNotCreatedYet` throws an exception, sigh. largeOffset :: EncryptionLevel -> Plain -> Plain largeOffset lvl plain     | lvl == RTT1Level = plain{plainFrames = fake : plainFrames plain}