diff --git a/core/Network/TLS/Handshake/Client.hs b/core/Network/TLS/Handshake/Client.hs index 01fb2dc0a..c46d46bde 100644 --- a/core/Network/TLS/Handshake/Client.hs +++ b/core/Network/TLS/Handshake/Client.hs @@ -49,6 +49,8 @@ import Network.TLS.Util (bytesEq, catchException, mapChunks_) import Network.TLS.Wire import Network.TLS.X509 +---------------------------------------------------------------- + handshakeClientWith :: ClientParams -> Context -> Handshake -> IO () handshakeClientWith cparams ctx HelloRequest = handshakeClient cparams ctx handshakeClientWith _ _ _ = @@ -61,13 +63,13 @@ handshakeClientWith _ _ _ = -- values intertwined with response from the server. handshakeClient :: ClientParams -> Context -> IO () handshakeClient cparams ctx = do - let groups = case clientWantSessionResume cparams of + let groupsSupported = supportedGroups (ctxSupported ctx) + groups = case clientWantSessionResume cparams of Nothing -> groupsSupported Just (_, sdata) -> case sessionGroup sdata of Nothing -> [] -- TLS 1.2 or earlier Just grp -> grp : filter (/= grp) groupsSupported - groupsSupported = supportedGroups (ctxSupported ctx) - handshakeClient' cparams ctx groups Nothing + firstFlight cparams ctx groups Nothing -- https://tools.ietf.org/html/rfc8446#section-4.1.2 says: -- "The client will also send a @@ -76,17 +78,17 @@ handshakeClient cparams ctx = do -- ClientHello without modification, except as follows:" -- -- So, the ClientRandom in the first client hello is necessary. -handshakeClient' +firstFlight :: ClientParams -> Context -> [Group] -> Maybe (ClientRandom, Session, Version) -> IO () -handshakeClient' cparams ctx groups mparams = do +firstFlight cparams ctx groups mparams = do updateMeasure ctx incrementNbHandshakes - (crand, clientSession) <- generateClientHelloParams - (rtt0, sentExtensions) <- sendClientHello clientSession crand - recvServerHello clientSession sentExtensions + (crand, clientSession) <- generateClientHelloParams mparams + (rtt0, sentExtensions) <- sendClientHello cparams ctx groups clientSession crand + recvServerHello ctx cparams clientSession sentExtensions ver <- usingState_ ctx getVersion unless (maybe True (\(_, _, v) -> v == ver) mparams) $ throwCore $ @@ -98,47 +100,98 @@ handshakeClient' cparams ctx groups mparams = do if ver == TLS13 then if hrr - then case drop 1 groups of - [] -> - throwCore $ - Error_Protocol "group is exhausted in the client side" IllegalParameter - groups' -> do - when (isJust mparams) $ - throwCore $ - Error_Protocol "server sent too many hello retries" UnexpectedMessage - mks <- usingState_ ctx getTLS13KeyShare - case mks of - Just (KeyShareHRR selectedGroup) - | selectedGroup `elem` groups' -> do - usingHState ctx $ setTLS13HandshakeMode HelloRetryRequest - clearTxState ctx - let cparams' = cparams{clientEarlyData = Nothing} - runPacketFlight ctx $ sendChangeCipherSpec13 ctx - handshakeClient' cparams' ctx [selectedGroup] (Just (crand, clientSession, ver)) - | otherwise -> - throwCore $ - Error_Protocol "server-selected group is not supported" IllegalParameter - Just _ -> error "handshakeClient': invalid KeyShare value" - Nothing -> - throwCore $ - Error_Protocol - "key exchange not implemented in HRR, expected key_share extension" - HandshakeFailure - else handshakeClient13 cparams ctx groupToSend + then helloRetry ver crand clientSession $ drop 1 groups + else secondFlight13 cparams ctx groupToSend else do when rtt0 $ throwCore $ Error_Protocol "server denied TLS 1.3 when connecting with early data" HandshakeFailure - sessionResuming <- usingState_ ctx isSessionResuming - if sessionResuming - then sendChangeCipherAndFinish ctx ClientRole - else do - sendClientData cparams ctx - sendChangeCipherAndFinish ctx ClientRole - recvChangeCipherAndFinish ctx - handshakeTerminate ctx + secondFlight12 cparams ctx + where + highestVer = maximum $ supportedVersions $ ctxSupported ctx + tls13 = highestVer >= TLS13 + ems = supportedExtendedMasterSec $ ctxSupported ctx + groupToSend = listToMaybe groups + + -- Client random and session in the second client hello for + -- retry must be the same as the first one. + generateClientHelloParams (Just (crand, clientSession, _)) = + return (crand, clientSession) + generateClientHelloParams Nothing = do + crand <- clientRandom ctx + let paramSession = case clientWantSessionResume cparams of + Nothing -> Session Nothing + Just (sid, sdata) + | sessionVersion sdata >= TLS13 -> Session Nothing + | ems == RequireEMS && noSessionEMS -> Session Nothing + | otherwise -> Session (Just sid) + where + noSessionEMS = SessionEMS `notElem` sessionFlags sdata + -- In compatibility mode a client not offering a pre-TLS 1.3 + -- session MUST generate a new 32-byte value + if tls13 && paramSession == Session Nothing && not (ctxQUICMode ctx) + then do + randomSession <- newSession ctx + return (crand, randomSession) + else return (crand, paramSession) + + helloRetry _ _ _ [] = + throwCore $ + Error_Protocol "group is exhausted in the client side" IllegalParameter + helloRetry ver crand clientSession groups' = do + when (isJust mparams) $ + throwCore $ + Error_Protocol "server sent too many hello retries" UnexpectedMessage + mks <- usingState_ ctx getTLS13KeyShare + case mks of + Just (KeyShareHRR selectedGroup) + | selectedGroup `elem` groups' -> do + usingHState ctx $ setTLS13HandshakeMode HelloRetryRequest + clearTxState ctx + let cparams' = cparams{clientEarlyData = Nothing} + runPacketFlight ctx $ sendChangeCipherSpec13 ctx + firstFlight cparams' ctx [selectedGroup] (Just (crand, clientSession, ver)) + | otherwise -> + throwCore $ + Error_Protocol "server-selected group is not supported" IllegalParameter + Just _ -> error "firstFlight: invalid KeyShare value" + Nothing -> + throwCore $ + Error_Protocol + "key exchange not implemented in HRR, expected key_share extension" + HandshakeFailure + +---------------------------------------------------------------- + +sendClientHello + :: ClientParams + -> Context + -> [Group] + -> Session + -> ClientRandom + -> IO (Bool, [ExtensionID]) +sendClientHello cparams ctx groups clientSession crand = do + let ver = if tls13 then TLS12 else highestVer + hrr <- usingState_ ctx getTLS13HRR + unless hrr $ startHandshake ctx ver crand + usingState_ ctx $ setVersionIfUnset highestVer + let cipherIds = map cipherID ciphers + compIds = map compressionID compressions + mkClientHello exts = ClientHello ver crand clientSession cipherIds compIds exts Nothing + pskInfo <- getPskInfo + let rtt0info = pskInfo >>= get0RTTinfo + rtt0 = isJust rtt0info + extensions0 <- catMaybes <$> getExtensions pskInfo rtt0 + let extensions1 = sharedHelloExtensions (clientShared cparams) ++ extensions0 + extensions <- adjustExtentions pskInfo extensions1 $ mkClientHello extensions1 + sendPacket ctx $ Handshake [mkClientHello extensions] + mEarlySecInfo <- case rtt0info of + Nothing -> return Nothing + Just info -> Just <$> send0RTT info + unless hrr $ contextSync ctx $ SendClientHello mEarlySecInfo + return (rtt0, map (\(ExtensionRaw i _) -> i) extensions) where ciphers = supportedCiphers $ ctxSupported ctx compressions = supportedCompressions $ ctxSupported ctx @@ -304,50 +357,6 @@ handshakeClient' cparams ctx groups mparams = do withBinders = replacePSKBinder withoutBinders binder return exts' - generateClientHelloParams = - case mparams of - -- Client random and session in the second client hello for - -- retry must be the same as the first one. - Just (crand, clientSession, _) -> return (crand, clientSession) - Nothing -> do - crand <- clientRandom ctx - let paramSession = case clientWantSessionResume cparams of - Nothing -> Session Nothing - Just (sid, sdata) - | sessionVersion sdata >= TLS13 -> Session Nothing - | ems == RequireEMS && noSessionEMS -> Session Nothing - | otherwise -> Session (Just sid) - where - noSessionEMS = SessionEMS `notElem` sessionFlags sdata - -- In compatibility mode a client not offering a pre-TLS 1.3 - -- session MUST generate a new 32-byte value - if tls13 && paramSession == Session Nothing && not (ctxQUICMode ctx) - then do - randomSession <- newSession ctx - return (crand, randomSession) - else return (crand, paramSession) - - sendClientHello clientSession crand = do - let ver = if tls13 then TLS12 else highestVer - hrr <- usingState_ ctx getTLS13HRR - unless hrr $ startHandshake ctx ver crand - usingState_ ctx $ setVersionIfUnset highestVer - let cipherIds = map cipherID ciphers - compIds = map compressionID compressions - mkClientHello exts = ClientHello ver crand clientSession cipherIds compIds exts Nothing - pskInfo <- getPskInfo - let rtt0info = pskInfo >>= get0RTTinfo - rtt0 = isJust rtt0info - extensions0 <- catMaybes <$> getExtensions pskInfo rtt0 - let extensions1 = sharedHelloExtensions (clientShared cparams) ++ extensions0 - extensions <- adjustExtentions pskInfo extensions1 $ mkClientHello extensions1 - sendPacket ctx $ Handshake [mkClientHello extensions] - mEarlySecInfo <- case rtt0info of - Nothing -> return Nothing - Just info -> Just <$> send0RTT info - unless hrr $ contextSync ctx $ SendClientHello mEarlySecInfo - return (rtt0, map (\(ExtensionRaw i _) -> i) extensions) - get0RTTinfo (_, sdata, choice, _) = do earlyData <- clientEarlyData cparams guard (B.length earlyData <= sessionMaxEarlyDataSize sdata) @@ -370,28 +379,41 @@ handshakeClient' cparams ctx groups mparams = do usingHState ctx $ setTLS13RTT0Status RTT0Sent return $ EarlySecretInfo usedCipher clientEarlySecret - recvServerHello clientSession sentExts = runRecvState ctx recvState - where - recvState = RecvStateNext $ \p -> - case p of - Handshake hs -> - onRecvStateHandshake - ctx - (RecvStateHandshake $ onServerHello ctx cparams clientSession sentExts) - hs -- this adds SH to hstHandshakeMessages - Alert a -> - case a of - [(AlertLevel_Warning, UnrecognizedName)] -> - if clientUseServerNameIndication cparams - then return recvState - else throwAlert a - _ -> throwAlert a - _ -> unexpected (show p) (Just "handshake") - throwAlert a = - throwCore $ - Error_Protocol - ("expecting server hello, got alert : " ++ show a) - HandshakeFailure +---------------------------------------------------------------- + +recvServerHello :: Context -> ClientParams -> Session -> [ExtensionID] -> IO () +recvServerHello ctx cparams clientSession sentExts = runRecvState ctx recvState + where + recvState = RecvStateNext next + next (Handshake hs) = + onRecvStateHandshake + ctx + (RecvStateHandshake $ onServerHello ctx cparams clientSession sentExts) + hs -- this adds SH to hstHandshakeMessages + next (Alert [(AlertLevel_Warning, UnrecognizedName)]) + | clientUseServerNameIndication cparams = return recvState + next (Alert a) = throwAlert a + next p = unexpected (show p) (Just "handshake") + throwAlert a = + throwCore $ + Error_Protocol + ("expecting server hello, got alert : " ++ show a) + HandshakeFailure + +---------------------------------------------------------------- + +secondFlight12 :: ClientParams -> Context -> IO () +secondFlight12 cparams ctx = do + sessionResuming <- usingState_ ctx isSessionResuming + if sessionResuming + then sendChangeCipherAndFinish ctx ClientRole + else do + sendClientData cparams ctx + sendChangeCipherAndFinish ctx ClientRole + recvChangeCipherAndFinish ctx + handshakeDone ctx + +---------------------------------------------------------------- -- | Store the keypair and check that it is compatible with the current protocol -- version and a list of 'CertificateType' values. @@ -793,7 +815,7 @@ onServerHello ctx cparams clientSession sentExts (ServerHello rver serverRan ser ("server version " ++ show ver ++ " is not supported") ProtocolVersion Just _ -> return () - if ver > TLS12 + if ver == TLS13 then do when (serverSession /= clientSession) $ throwCore $ @@ -975,14 +997,16 @@ requiredCertKeyUsage cipher = , KeyUsage_keyAgreement ] -handshakeClient13 :: ClientParams -> Context -> Maybe Group -> IO () -handshakeClient13 cparams ctx groupSent = do +---------------------------------------------------------------- + +secondFlight13 :: ClientParams -> Context -> Maybe Group -> IO () +secondFlight13 cparams ctx groupSent = do choice <- makeCipherChoice TLS13 <$> usingHState ctx getPendingCipher - handshakeClient13' cparams ctx groupSent choice + secondFlight13' cparams ctx groupSent choice -handshakeClient13' +secondFlight13' :: ClientParams -> Context -> Maybe Group -> CipherChoice -> IO () -handshakeClient13' cparams ctx groupSent choice = do +secondFlight13' cparams ctx groupSent choice = do (_, hkey, resuming) <- switchToHandshakeSecret let handshakeSecret = triBase hkey clientHandshakeSecret = triClient hkey @@ -1007,7 +1031,7 @@ handshakeClient13' cparams ctx groupSent choice = do setResumptionSecret applicationSecret let appSecInfo = ApplicationSecretInfo (triClient appKey, triServer appKey) contextSync ctx $ SendClientFinished eexts appSecInfo - handshakeTerminate13 ctx + handshakeDone13 ctx where usedCipher = cCipher choice usedHash = cHash choice @@ -1122,6 +1146,8 @@ handshakeClient13' cparams ctx groupSent choice = do resumptionSecret <- calculateResumptionSecret ctx choice applicationSecret usingHState ctx $ setTLS13ResumptionSecret resumptionSecret +---------------------------------------------------------------- + processCertRequest13 :: MonadIO m => Context -> CertReqContext -> [ExtensionRaw] -> m () processCertRequest13 ctx token exts = do diff --git a/core/Network/TLS/Handshake/Common.hs b/core/Network/TLS/Handshake/Common.hs index d262fa9ca..9885d4fd5 100644 --- a/core/Network/TLS/Handshake/Common.hs +++ b/core/Network/TLS/Handshake/Common.hs @@ -6,7 +6,7 @@ module Network.TLS.Handshake.Common ( handleException, unexpected, newSession, - handshakeTerminate, + handshakeDone, -- * sending packets sendChangeCipherAndFinish, @@ -107,8 +107,8 @@ newSession ctx | otherwise = return $ Session Nothing -- | when a new handshake is done, wrap up & clean up. -handshakeTerminate :: Context -> IO () -handshakeTerminate ctx = do +handshakeDone :: Context -> IO () +handshakeDone ctx = do session <- usingState_ ctx getSession -- only callback the session established if we have a session case session of diff --git a/core/Network/TLS/Handshake/Common13.hs b/core/Network/TLS/Handshake/Common13.hs index a47d9c307..167f9235e 100644 --- a/core/Network/TLS/Handshake/Common13.hs +++ b/core/Network/TLS/Handshake/Common13.hs @@ -19,7 +19,7 @@ module Network.TLS.Handshake.Common13 ( makePSKBinder, replacePSKBinder, sendChangeCipherSpec13, - handshakeTerminate13, + handshakeDone13, makeCertRequest, createTLS13TicketInfo, ageToObfuscatedAge, @@ -243,13 +243,13 @@ sendChangeCipherSpec13 ctx = do ---------------------------------------------------------------- --- | TLS13 handshake wrap up & clean up. Contrary to @handshakeTerminate@, this +-- | TLS13 handshake wrap up & clean up. Contrary to @handshakeDone@, this -- does not handle session, which is managed separately for TLS 1.3. This does -- not reset byte counters because renegotiation is not allowed. And a few more -- state attributes are preserved, necessary for TLS13 handshake modes, session -- tickets and post-handshake authentication. -handshakeTerminate13 :: Context -> IO () -handshakeTerminate13 ctx = do +handshakeDone13 :: Context -> IO () +handshakeDone13 ctx = do -- forget most handshake data liftIO $ modifyMVar_ (ctxHandshake ctx) $ \mhshake -> case mhshake of diff --git a/core/Network/TLS/Handshake/Server.hs b/core/Network/TLS/Handshake/Server.hs index 96555dd31..7222108dd 100644 --- a/core/Network/TLS/Handshake/Server.hs +++ b/core/Network/TLS/Handshake/Server.hs @@ -394,7 +394,7 @@ doHandshake sparams mcred ctx chosenVersion usedCipher usedCompression clientSes logKey ctx (MasterSecret masterSecret) sendChangeCipherAndFinish ctx ServerRole recvChangeCipherAndFinish ctx - handshakeTerminate ctx + handshakeDone ctx where --- -- When the client sends a certificate, check whether @@ -933,7 +933,7 @@ doHandshake13 sparams ctx chosenVersion usedCipher exts usedHash clientKeyShare let expectFinished hChBeforeCf (Finished13 verifyData) = liftIO $ do let ClientTrafficSecret chs = clientHandshakeSecret checkFinished ctx usedHash chs hChBeforeCf verifyData - handshakeTerminate13 ctx + handshakeDone13 ctx setRxState ctx usedHash usedCipher clientApplicationSecret0 sendNewSessionTicket applicationSecret sfSentTime expectFinished _ hs = unexpected (show hs) (Just "finished 13") diff --git a/core/Network/TLS/Types.hs b/core/Network/TLS/Types.hs index 1a9dde1f7..52e95592a 100644 --- a/core/Network/TLS/Types.hs +++ b/core/Network/TLS/Types.hs @@ -85,7 +85,7 @@ data SessionData = SessionData , sessionALPN :: Maybe ByteString , sessionMaxEarlyDataSize :: Int , sessionFlags :: [SessionFlag] - } + } -- sessionFromTicket :: Bool deriving (Show, Eq) -- | Some session flags