Supporting TLS 1.3 draft 19.

See: haskell-tls#167

core/Network/TLS/Context/Internal.hs

@@ -216,7 +216,7 @@ runTxState :: Context -> RecordM a -> IO (Either TLSError a)
 runTxState ctx f = do
     ver <- usingState_ ctx (getVersionWithDefault $ maximum $ supportedVersions $ ctxSupported ctx)
     let ver'
-         | ver >= TLS13ID18 = TLS10
+         | ver >= TLS13ID19 = TLS10
          | otherwise        = ver
     modifyMVar (ctxTxState ctx) $ \st ->
         case runRecordM f ver' st of
@@ -251,4 +251,4 @@ tls13orLater ctx = do
     ev <- liftIO $ usingState ctx $ getVersionWithDefault TLS10 -- fixme
     return $ case ev of
                Left  _ -> False
-               Right v -> v >= TLS13ID18
+               Right v -> v >= TLS13ID19

core/Network/TLS/Core.hs

@@ -126,17 +126,17 @@ recvData13 ctx = liftIO $ do
     checkValid ctx
     pkt <- withReadLock ctx $ recvPacket13 ctx
     either (onError terminate) process pkt
-  where process (Alert13 [(_,EndOfEarlyData)]) = do
-            alertAction <- popPendingAction ctx
-            alertAction "dummy"
-            recvData13 ctx
-        process (Alert13 [(AlertLevel_Warning, CloseNotify)]) = tryBye ctx >> setEOF ctx >> return B.empty
+  where process (Alert13 [(AlertLevel_Warning, CloseNotify)]) = tryBye ctx >> setEOF ctx >> return B.empty
         process (Alert13 [(AlertLevel_Fatal, desc)]) = do
             setEOF ctx
             E.throwIO (Terminated True ("received fatal error: " ++ show desc) (Error_Protocol ("remote side fatal error", True, desc)))
         process (Handshake13 [ClientHello13 _ _ _ _]) = do
             let reason = "Client hello is not allowed"
             terminate (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+        process (Handshake13 [EndOfEarlyData13]) = do
+            alertAction <- popPendingAction ctx
+            alertAction "dummy"
+            recvData13 ctx
         process (Handshake13 [Finished13 verifyData']) = do
             finishedAction <- popPendingAction ctx
             finishedAction verifyData'
@@ -152,6 +152,9 @@ recvData13 ctx = liftIO $ do
         process (AppData13 "") = recvData13 ctx
         process (AppData13 x) = do
             established <- ctxEstablished ctx
+            when (established == EarlyDataAllowed) $ do
+                putStrLn "---- EARLY DATA ----"
+                B.putStrLn x
             if established == EarlyDataNotAllowed then
                 recvData13 ctx
               else

core/Network/TLS/Extension.hs

@@ -27,7 +27,6 @@ module Network.TLS.Extension
     , extensionID_SupportedVersions
     , extensionID_Cookie
     , extensionID_PskKeyExchangeModes
-    , extensionID_TicketEarlyDataInfo
     -- all implemented extensions
     , ServerNameType(..)
     , ServerName(..)
@@ -52,7 +51,6 @@ module Network.TLS.Extension
     , PskIdentity(..)
     , PreSharedKey(..)
     , EarlyDataIndication(..)
-    , TicketEarlyDataInfo(..)
     ) where
 
 import Data.Word
@@ -103,7 +101,6 @@ extensionID_ServerName
   , extensionID_SupportedVersions
   , extensionID_Cookie
   , extensionID_PskKeyExchangeModes
-  , extensionID_TicketEarlyDataInfo
   , extensionID_SecureRenegotiation :: ExtensionID
 extensionID_ServerName                          = 0x0 -- RFC6066
 extensionID_MaxFragmentLength                   = 0x1 -- RFC6066
@@ -136,7 +133,6 @@ extensionID_EarlyData                           = 0x2a -- TLS 1.3
 extensionID_SupportedVersions                   = 0x2b -- TLS 1.3
 extensionID_Cookie                              = 0x2c -- TLS 1.3
 extensionID_PskKeyExchangeModes                 = 0x2d -- TLS 1.3
-extensionID_TicketEarlyDataInfo                 = 0x2e -- TLS 1.3
 extensionID_SecureRenegotiation                 = 0xff01 -- RFC5746
 
 definedExtensions :: [ExtensionID]
@@ -184,12 +180,13 @@ supportedExtensions = [ extensionID_ServerName
                       , extensionID_SupportedVersions
                       , extensionID_Cookie
                       , extensionID_PskKeyExchangeModes
-                      , extensionID_TicketEarlyDataInfo
                       ]
 
 data MessageType = MsgTClientHello
                  | MsgTServerHello
                  | MsgTHelloRetryRequest
+                 | MsgTEncryptedExtensions
+                 | MsgTNewSessionTicket
                  deriving (Eq,Show)
 
 -- | Extension class to transform bytes to and from a high level Extension type.
@@ -419,6 +416,7 @@ instance Extension KeyShare where
         case mgrp of
           Nothing  -> fail "decoding KeyShare for HRR"
           Just grp -> return $ KeyShareHRR grp
+    extensionDecode _ = error "extensionDecode: KeyShare"
 
 data PskKexMode = PSK_KE | PSK_DHE_KE deriving (Eq, Show)
 
@@ -481,16 +479,14 @@ instance Extension PreSharedKey where
             return (len, binder)
     extensionDecode _ = error "decoding PreShareKey"
 
-data EarlyDataIndication = EarlyDataIndication deriving (Eq, Show)
-
+data EarlyDataIndication = EarlyDataIndication (Maybe Word32) deriving (Eq, Show)
 instance Extension EarlyDataIndication where
     extensionID _ = extensionID_EarlyData
-    extensionEncode EarlyDataIndication = runPut $ putBytes B.empty
-    extensionDecode _ = return $ Just EarlyDataIndication
-
-data TicketEarlyDataInfo = TicketEarlyDataInfo Word32 deriving (Eq, Show)
-
-instance Extension TicketEarlyDataInfo where
-    extensionID _ = extensionID_TicketEarlyDataInfo
-    extensionEncode (TicketEarlyDataInfo w) = runPut $ putWord32 w
-    extensionDecode _ = runGetMaybe $ TicketEarlyDataInfo <$> getWord32
+    extensionEncode (EarlyDataIndication Nothing)   = runPut $ putBytes B.empty
+    extensionEncode (EarlyDataIndication (Just w32)) = runPut $ putWord32 w32
+    extensionDecode MsgTClientHello         = return $ Just (EarlyDataIndication Nothing)
+    extensionDecode MsgTEncryptedExtensions = return $ Just (EarlyDataIndication Nothing)
+    extensionDecode MsgTNewSessionTicket    = runGetMaybe $ do
+        w32 <- getWord32
+        return (EarlyDataIndication (Just w32))
+    extensionDecode _                       = error "extensionDecode: EarlyDataIndication"

core/Network/TLS/Extra/Cipher.hs

@@ -539,7 +539,7 @@ cipher_TLS13_AES128GCM_SHA256 = Cipher
     , cipherHash         = SHA256
     , cipherPRFHash      = Nothing
     , cipherKeyExchange  = CipherKeyExchange_TLS13
-    , cipherMinVer       = Just TLS13ID18
+    , cipherMinVer       = Just TLS13ID19
     }
 
 cipher_TLS13_AES256GCM_SHA384 :: Cipher
@@ -550,7 +550,7 @@ cipher_TLS13_AES256GCM_SHA384 = Cipher
     , cipherHash         = SHA384
     , cipherPRFHash      = Nothing
     , cipherKeyExchange  = CipherKeyExchange_TLS13
-    , cipherMinVer       = Just TLS13ID18
+    , cipherMinVer       = Just TLS13ID19
     }
 
 cipher_ECDHE_ECDSA_AES128CBC_SHA :: Cipher

core/Network/TLS/Handshake/Client.hs

@@ -61,7 +61,7 @@ handshakeClientWith cparams ctx HelloRequest = handshakeClient cparams ctx
 handshakeClientWith _       _   _            = throwCore $ Error_Protocol ("unexpected handshake message received in handshakeClientWith", True, HandshakeFailure)
 
 data HelloSwitch = SwitchTLS13 !CipherID [ExtensionRaw]
-                 | HelloRetry !Version [ExtensionRaw]
+                 | HelloRetry !Version !CipherID [ExtensionRaw]
                  deriving (Show, Typeable)
 
 instance Exception HelloSwitch
@@ -89,7 +89,7 @@ handshakeClient' cparams ctx groups mcrand = do
     ech <- E.try $ recvServerHello sentExtensions
     case ech of
         Left (SwitchTLS13 cipher exts) -> handshakeClient13 cparams ctx cipher exts
-        Left (HelloRetry _ver exts) -> case drop 1 groups of
+        Left (HelloRetry _ver _usedCipher exts) -> case drop 1 groups of
             []      -> error "HRR: no common group" -- fixme
             groups' -> case extensionLookup extensionID_KeyShare exts >>= extensionDecode MsgTHelloRetryRequest of
               Just (KeyShareHRR selectedGroup)
@@ -111,7 +111,7 @@ handshakeClient' cparams ctx groups mcrand = do
   where ciphers      = ctxCiphers ctx
         compressions = supportedCompressions $ ctxSupported ctx
         highestVer = maximum $ supportedVersions $ ctxSupported ctx
-        tls13 = highestVer >= TLS13ID18
+        tls13 = highestVer >= TLS13ID19
         getExtensions = sequence [sniExtension
                                  ,secureReneg
                                  ,alpnExtension
@@ -180,7 +180,7 @@ handshakeClient' cparams ctx groups mcrand = do
           | otherwise = case clientWantSessionResume cparams of
               Nothing -> return Nothing
               Just (sid, sdata)
-                | sessionVersion sdata >= TLS13ID18 -> do
+                | sessionVersion sdata >= TLS13ID19 -> do
                       let usedHash = sessionHash sdata
                           siz = hashDigestSize usedHash
                           zero = B.replicate siz 0
@@ -197,20 +197,20 @@ handshakeClient' cparams ctx groups mcrand = do
 
         earlyDataExtension = case checkZeroRTT of
             Nothing -> return $ Nothing
-            _       -> return $ Just $ toExtensionRaw EarlyDataIndication
+            _       -> return $ Just $ toExtensionRaw (EarlyDataIndication Nothing)
 
         clientSession = case clientWantSessionResume cparams of
             Nothing -> Session Nothing
             Just (sid, sdata)
-              | sessionVersion sdata >= TLS13ID18 -> Session Nothing
+              | sessionVersion sdata >= TLS13ID19 -> Session Nothing
               | otherwise                         -> Session (Just sid)
 
         adjustExtentions exts ch
           | not tls13 = return exts
           | otherwise = case clientWantSessionResume cparams of
               Nothing -> return exts
               Just (_, sdata)
-                | sessionVersion sdata >= TLS13ID18 -> do
+                | sessionVersion sdata >= TLS13ID19 -> do
                       let usedHash = sessionHash sdata
                           siz = hashDigestSize usedHash
                           zero = B.replicate siz 0
@@ -245,7 +245,7 @@ handshakeClient' cparams ctx groups mcrand = do
 
         checkZeroRTT = case clientWantSessionResume cparams of
             Just (_, sdata)
-              | sessionVersion sdata >= TLS13ID18 -> case clientTLS13ZeroRttData cparams of
+              | sessionVersion sdata >= TLS13ID19 -> case clientTLS13ZeroRttData cparams of
                 Just earlyData -> Just (sessionCipher sdata, earlyData)
                 Nothing        -> Nothing
             _ -> Nothing
@@ -258,32 +258,38 @@ handshakeClient' cparams ctx groups mcrand = do
                         _           -> error "0RTT" -- fixme
                     usedHash = cipherHash usedCipher
                 -- fixme: not initialized yet
-                -- hCh <- getHandshakeContextHash ctx
+                -- hCh <- transcriptHash ctx
                 hmsgs <- usingHState ctx getHandshakeMessages
-                let hCh = hash usedHash $ B.concat hmsgs
+                let hCh = hash usedHash $ B.concat hmsgs -- XXX
                 Just earlySecret <- usingHState ctx getTLS13MasterSecret -- fixme
                 let clientEarlyTrafficSecret = deriveSecret usedHash earlySecret "client early traffic secret" hCh
+{-
+                putStrLn $ "hCh: " ++ showBytesHex hCh
+                putStrLn $ "clientEarlyTrafficSecret: " ++ showBytesHex clientEarlyTrafficSecret
+                putStrLn "---- setTxState ctx usedHash usedCipher clientEarlyTrafficSecret"
+-}
                 setTxState ctx usedHash usedCipher clientEarlyTrafficSecret
                 -- fixme
                 Right eEarlyData <- writePacket13 ctx $ AppData13 earlyData
-                Right endOfEarlyData <- writePacket13 ctx $ Alert13 [(AlertLevel_Warning,EndOfEarlyData)]
-                sendBytes13 ctx (eEarlyData `B.append` endOfEarlyData)
+                sendBytes13 ctx eEarlyData
                 usingHState ctx $ setTLS13RTT0 True
                 putStrLn "Sending 0RTT request..."
 
         recvServerHello sentExts = runRecvState ctx recvState
           where recvState = RecvStateNext $ \p ->
                     case p of
-                        Handshake [hrr@(HelloRetryRequest ver exts)] -> do
+                        Handshake [hrr@(HelloRetryRequest ver cid exts)] -> do
                             let encoded = encodeHandshake hrr
+                                Just cipher = cipherIDtoCipher13 cid
+                            usingHState ctx $ setHelloParameters13 cipher True
                             usingHState ctx $ addHandshakeMessage encoded
                             usingHState ctx $ updateHandshakeDigest encoded
-                            E.throwIO $ HelloRetry ver exts
-                        Handshake [sh@(ServerHello' _ _ c es)] -> do
+                            E.throwIO $ HelloRetry ver cid exts
+                        Handshake [sh@(ServerHello' _ _ cid es)] -> do
                             let encoded = encodeHandshake sh
                             usingHState ctx $ addHandshakeMessage encoded
                             usingHState ctx $ updateHandshakeDigest encoded
-                            E.throwIO $ SwitchTLS13 c es
+                            E.throwIO $ SwitchTLS13 cid es
                         Handshake hs -> onRecvStateHandshake ctx (RecvStateHandshake $ onServerHello ctx cparams sentExts) hs
                         Alert a      ->
                             case a of
@@ -565,7 +571,7 @@ handshakeClient13 _cparams ctx cipher exts = do
                      Just alg -> return alg
     let usedHash = cipherHash usedCipher
     putStrLn $ "TLS 1.3: " ++ show usedCipher ++ " " ++ show usedHash
-    usingHState ctx $ setHelloParameters13 usedCipher
+    usingHState ctx $ setHelloParameters13 usedCipher False
     handshakeClient13' _cparams ctx usedCipher usedHash exts
 
 handshakeClient13' :: ClientParams -> Context -> Cipher -> Hash
@@ -575,8 +581,17 @@ handshakeClient13' _cparams ctx usedCipher usedHash exts = do
     recvEncryptedExtensions
     unless resuming recvCertAndVerify
     recvFinished serverHandshakeTrafficSecret
-    hChSf <- getHandshakeContextHash ctx
-    sendFinished clientHandshakeTrafficSecret
+    hChSf <- transcriptHash ctx
+    rtt0 <- usingHState ctx getTLS13RTT0
+    when rtt0 $ do
+        eoed <- writeHandshakePacket13 ctx EndOfEarlyData13
+        sendBytes13 ctx eoed
+{-
+    putStrLn "---- setTxState ctx usedHash usedCipher clientHandshakeTrafficSecret"
+-}
+    rawFinished <- makeFinished ctx usedHash clientHandshakeTrafficSecret
+    setTxState ctx usedHash usedCipher clientHandshakeTrafficSecret
+    writeHandshakePacket13 ctx rawFinished >>= sendBytes13 ctx
     masterSecret <- switchToTrafficSecret handshakeSecret hChSf
     setResumptionSecret masterSecret
     setEstablished ctx Established
@@ -588,8 +603,8 @@ handshakeClient13' _cparams ctx usedCipher usedHash exts = do
     switchToHandshakeSecret = do
         ecdhe <- calcSharedKey
         (earlySecret, resuming) <- makeEarlySecret
-        let handshakeSecret = hkdfExtract usedHash earlySecret ecdhe
-        hChSh <- getHandshakeContextHash ctx
+        let handshakeSecret = hkdfExtract usedHash (deriveSecret usedHash earlySecret "derived secret" (hash usedHash "")) ecdhe
+        hChSh <- transcriptHash ctx
         let clientHandshakeTrafficSecret = deriveSecret usedHash handshakeSecret "client handshake traffic secret" hChSh
             serverHandshakeTrafficSecret = deriveSecret usedHash handshakeSecret "server handshake traffic secret" hChSh
 {-
@@ -601,18 +616,18 @@ handshakeClient13' _cparams ctx usedCipher usedHash exts = do
         putStrLn $ "clientHandshakeTrafficSecret: " ++ showBytesHex clientHandshakeTrafficSecret
 -}
         setRxState ctx usedHash usedCipher serverHandshakeTrafficSecret
-        setTxState ctx usedHash usedCipher clientHandshakeTrafficSecret
         return (resuming, handshakeSecret, clientHandshakeTrafficSecret, serverHandshakeTrafficSecret)
 
     switchToTrafficSecret handshakeSecret hChSf = do
-        let masterSecret = hkdfExtract usedHash handshakeSecret zero
+        let masterSecret = hkdfExtract usedHash (deriveSecret usedHash handshakeSecret "derived secret" (hash usedHash "")) zero
         let clientTrafficSecret0 = deriveSecret usedHash masterSecret "client application traffic secret" hChSf
             serverTrafficSecret0 = deriveSecret usedHash masterSecret "server application traffic secret" hChSf
 {-
         putStrLn $ "hChSf: " ++ showBytesHex hChSf
         putStrLn $ "masterSecret: " ++ showBytesHex masterSecret
         putStrLn $ "serverTrafficSecret0: " ++ showBytesHex serverTrafficSecret0
         putStrLn $ "clientTrafficSecret0: " ++ showBytesHex clientTrafficSecret0
+        putStrLn "---- setTxState ctx usedHash usedCipher clientTrafficSecret0"
 -}
         setTxState ctx usedHash usedCipher clientTrafficSecret0
         setRxState ctx usedHash usedCipher serverTrafficSecret0
@@ -656,25 +671,21 @@ handshakeClient13' _cparams ctx usedCipher usedHash exts = do
             pubkey = X.certPubKey $ X.signedObject $ X.getSigned $ getCertificateChainLeaf certChain -- fixme
         certVerify <- recvHandshake13 ctx
         let CertVerify13 ss sig = certVerify
-        hChSc <- getHandshakeContextHash ctx
+        hChSc <- transcriptHash ctx
         checkServerCertVerify ss sig pubkey hChSc
         update certVerify
 
     recvFinished serverHandshakeTrafficSecret = do
         finished <- recvHandshake13 ctx
-        hChSv <- getHandshakeContextHash ctx
+        hChSv <- transcriptHash ctx
         let verifyData' = makeVerifyData usedHash serverHandshakeTrafficSecret hChSv
         let Finished13 verifyData = finished
         when (verifyData' /= verifyData) $
             throwCore $ Error_Protocol ("cannot verify finished", True, HandshakeFailure)
         update finished
 
-    sendFinished clientHandshakeTrafficSecret = do
-        fish <- makeFinished ctx usedHash clientHandshakeTrafficSecret >>= writeHandshakePacket13 ctx
-        sendBytes13 ctx fish
-
     setResumptionSecret masterSecret = do
-        hChCf <- getHandshakeContextHash ctx
+        hChCf <- transcriptHash ctx
         let resumptionSecret = deriveSecret usedHash masterSecret "resumption master secret" hChCf
         usingHState ctx $ setTLS13MasterSecret $ Just resumptionSecret
 

core/Network/TLS/Handshake/Common13.hs

@@ -32,7 +32,7 @@ import Data.Time
 
 makeFinished :: Context -> Hash -> ByteString -> IO Handshake13
 makeFinished ctx usedHash baseKey = do
-    transcript <- getHandshakeContextHash ctx
+    transcript <- transcriptHash ctx
     return $ Finished13 $ makeVerifyData usedHash baseKey transcript
 
 makeVerifyData :: Hash -> ByteString -> ByteString -> ByteString
@@ -166,7 +166,7 @@ decodeSessionData = runGetMaybe $ do
 
 makePSKBinder :: Context -> ByteString -> Hash -> Int -> Maybe ByteString -> IO ByteString
 makePSKBinder ctx earlySecret usedHash truncLen mch = do
-    rmsgs0 <- usingHState ctx getHandshakeMessagesRev
+    rmsgs0 <- usingHState ctx getHandshakeMessagesRev -- XXX
     let rmsgs = case mch of
           Just ch -> trunc ch : rmsgs0
           Nothing -> trunc (head rmsgs0) : tail rmsgs0