diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Change log for "tls" +## Version 2.5.1 + +Sessions saved by 2.5.0 cannot be resumed: `SessionData` has a new field. + +* Keep application data in SessionData and let the server decide 0-RTT. + [#640](https://github.com/haskell-tls/hs-tls/pull/640) + ## Version 2.5.0 **The `tls-exporter` and `tls-server-end-point` channel bindings were diff --git a/Network/TLS.hs b/Network/TLS.hs --- a/Network/TLS.hs +++ b/Network/TLS.hs @@ -105,6 +105,7 @@ onALPNClientSuggest, onEncryptedExtensionsCreating, onSelectKeyShare, + onAccept0RTT, Measurement, nbHandshakes, bytesReceived, @@ -187,6 +188,7 @@ sessionMaxEarlyDataSize, sessionFlags, sessionClientCertificate, + sessionAppData, SessionFlag (..), TLS13TicketInfo, is0RTTPossible, diff --git a/Network/TLS/Context/Internal.hs b/Network/TLS/Context/Internal.hs --- a/Network/TLS/Context/Internal.hs +++ b/Network/TLS/Context/Internal.hs @@ -355,6 +355,12 @@ contextFlush = backendFlush . ctxBackend -- | A shortcut for 'backendClose . ctxBackend'. +-- +-- For a 'Network.Socket.Socket', this is 'Network.Socket.close', which +-- also wakes up threads blocked on the socket. If no thread is left on +-- it, call 'Network.TLS.bye' and then @unsafeClose@ (network 3.2.11 or +-- later) on the socket instead, or give 'Network.TLS.contextNew' a +-- 'Backend' whose 'backendClose' does so. contextClose :: Context -> IO () contextClose = backendClose . ctxBackend diff --git a/Network/TLS/Handshake/Common.hs b/Network/TLS/Handshake/Common.hs --- a/Network/TLS/Handshake/Common.hs +++ b/Network/TLS/Handshake/Common.hs @@ -304,6 +304,7 @@ , sessionMaxEarlyDataSize = 0 , sessionFlags = flags , sessionClientCertificate = clientCert + , sessionAppData = Nothing } -- | Store the specified keypair. Whether the public key and private key diff --git a/Network/TLS/Handshake/Common13.hs b/Network/TLS/Handshake/Common13.hs --- a/Network/TLS/Handshake/Common13.hs +++ b/Network/TLS/Handshake/Common13.hs @@ -381,6 +381,7 @@ , sessionMaxEarlyDataSize = maxSize , sessionFlags = [] , sessionClientCertificate = clientCert + , sessionAppData = Nothing } ---------------------------------------------------------------- diff --git a/Network/TLS/Handshake/Server/ClientHello13.hs b/Network/TLS/Handshake/Server/ClientHello13.hs --- a/Network/TLS/Handshake/Server/ClientHello13.hs +++ b/Network/TLS/Handshake/Server/ClientHello13.hs @@ -212,10 +212,16 @@ if isPSKvalid && isFresh then do restoreClientCertificate ctx sdata + -- The application is asked only when 0-RTT is + -- otherwise possible. + accepted <- + if rtt0 && is0RTTvalid && n == 0 + then onAccept0RTT (serverHooks sparams) sdata + else return False return ( psk , Just (bnd, n :: Int, len) - , is0RTTvalid && n == 0 + , accepted , sessionALPN sdata ) else tryPSK len rest diff --git a/Network/TLS/Parameters.hs b/Network/TLS/Parameters.hs --- a/Network/TLS/Parameters.hs +++ b/Network/TLS/Parameters.hs @@ -853,6 +853,16 @@ -- the next @[Group]@. -- -- @since 2.2.3 + , onAccept0RTT :: SessionData -> IO Bool + -- ^ Whether to accept 0-RTT with the session being resumed, once + -- everything else allows it. 'False' refuses the early data but not + -- the resumption. QUIC refuses 0-RTT when the transport parameters + -- it remembered do not hold any more (RFC 9000 Sec 7.4.1), and can + -- keep them in 'sessionAppData'. + -- + -- Default: @\_ -> return True@ + -- + -- @since 2.5.1 } -- | Default value for 'ServerHooks' @@ -872,6 +882,7 @@ , onALPNClientSuggest = Nothing , onEncryptedExtensionsCreating = return , onSelectKeyShare = defaultOnSelectKeyShare + , onAccept0RTT = \_ -> return True } instance Show ServerHooks where diff --git a/Network/TLS/Types/Session.hs b/Network/TLS/Types/Session.hs --- a/Network/TLS/Types/Session.hs +++ b/Network/TLS/Types/Session.hs @@ -49,6 +49,12 @@ , sessionClientCertificate :: Maybe ByteString -- ^ On a server, the DER of the leaf certificate the client was -- authenticated with, so that a resumed connection can tell the client. + , sessionAppData :: Maybe ByteString + -- ^ Data of the application's own, kept with the session and given + -- back on resumption; never set by this library. A server can put + -- what 0-RTT depends on here and check it in 'onAccept0RTT'. + -- + -- @since 2.5.1 } -- sessionFromTicket :: Bool deriving (Eq, Generic) @@ -88,6 +94,8 @@ . shows (sessionFlags sd) . showString ", sessionClientCertificate = " . showString (maybe "Nothing" derLength (sessionClientCertificate sd)) + . showString ", sessionAppData = " + . shows (sessionAppData sd) . showChar '}' where derLength der = "Just <" ++ show (B.length der) ++ " bytes>" @@ -108,6 +116,7 @@ , sessionMaxEarlyDataSize = 0 , sessionFlags = [] , sessionClientCertificate = Nothing + , sessionAppData = Nothing } is0RTTPossible :: SessionData -> Bool diff --git a/test/HandshakeSpec.hs b/test/HandshakeSpec.hs --- a/test/HandshakeSpec.hs +++ b/test/HandshakeSpec.hs @@ -247,6 +247,10 @@ it "rejects TLS 1.3 early data when ALPN changes" $ handshake13_0rtt_alpn prop "can handshake with TLS 1.3 0RTT -> PSK" handshake13_0rtt_fallback + it "keeps the application's data and asks it about 0RTT" $ + handshake13_0rtt_app_data True + it "refuses 0RTT, not the resumption, when the application says so" $ + handshake13_0rtt_app_data False it "authenticates a server rejecting the PSK of 0RTT" $ handshake13_0rtt_psk_rejected False it "authenticates a server rejecting the PSK of 0RTT, asking a cert" $ @@ -2939,6 +2943,48 @@ } } runTLS0RTT (pc', ps') PreSharedKey "GET /admin HTTP/1.1\r\n\r\n" + +-- | 'sessionAppData' set when the server saves the session is what +-- 'onAccept0RTT' is given on resumption, and its answer decides 0RTT alone. +handshake13_0rtt_app_data :: Bool -> IO () +handshake13_0rtt_app_data accept = do + (cli, srv) <- generate arbitraryPairParams13 + let supported = + defaultSupported + { supportedCiphers = [cipher13_AES_128_GCM_SHA256] + , supportedGroups = [X25519] + , supportedGroupsTLS13 = [[X25519]] + } + params0 = + ( cli{clientSupported = supported} + , srv{serverSupported = supported, serverEarlyDataSize = 2048} + ) + sessionRefs <- twoSessionRefs + let (cmgr, smgr) = twoSessionManagers sessionRefs + smgr' = + smgr + { sessionEstablish = \sid sdata -> + sessionEstablish smgr sid sdata{sessionAppData = Just "limits"} + } + params = setPairParamsSessionManagers (cmgr, smgr') params0 + runTLSSimple13 params FullHandshake + + sessionParams <- readClientSessionRef sessionRefs + expectJust "session param should be Just" sessionParams + seen <- newIORef Nothing + let (pc, ps) = setPairParamsSessionResuming (fromJust sessionParams) params + ps' = + ps + { serverHooks = + (serverHooks ps) + { onAccept0RTT = \sdata -> do + writeIORef seen $ sessionAppData sdata + return accept + } + } + mode = if accept then RTT0 else PreSharedKey + runTLS0RTT (pc{clientUseEarlyData = True}, ps') mode "early data" + readIORef seen `shouldReturn` Just "limits" handshake13_0rtt_fallback :: CSP13 -> IO () handshake13_0rtt_fallback (CSP13 (cli, srv)) = do diff --git a/test/SecretSpec.hs b/test/SecretSpec.hs --- a/test/SecretSpec.hs +++ b/test/SecretSpec.hs @@ -49,6 +49,7 @@ , sessionMaxEarlyDataSize = 0 , sessionFlags = [] , sessionClientCertificate = Nothing + , sessionAppData = Nothing } cipher = case ciphersuite_default of c : _ -> c diff --git a/tls.cabal b/tls.cabal --- a/tls.cabal +++ b/tls.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: tls -version: 2.5.0 +version: 2.5.1 license: BSD3 license-file: LICENSE copyright: Vincent Hanquez @@ -139,7 +139,7 @@ random >=1.2 && <1.4, serialise >=0.2 && <0.3, transformers >=0.5 && <0.7, - unix-time >=0.4.11 && <0.6, + unix-time >=0.4.11 && <0.7, zlib >=0.7 && <0.8 executable tls-server