implementing getTLSExporter

ctxFinished and stServerVerifyData are integrated.

core/Network/TLS.hs

@@ -135,9 +135,10 @@ module Network.TLS (
     updateKey,
     KeyUpdateRequest (..),
     requestCertificate,
+    getTLSUnique,
+    getTLSExporter,
     getFinished,
     getPeerFinished,
-    getTLSExporter,
 
     -- ** Modifying hooks in context
     Hooks (..),

core/Network/TLS/Context.hs

@@ -50,9 +50,10 @@ module Network.TLS.Context (
     getHState,
     getStateRNG,
     tls13orLater,
+    getTLSUnique,
+    getTLSExporter,
     getFinished,
     getPeerFinished,
-    getTLSExporter,
 ) where
 
 import Control.Concurrent.MVar
@@ -159,8 +160,6 @@ contextNew backend params = liftIO $ do
     lockWrite <- newMVar ()
     lockRead <- newMVar ()
     lockState <- newMVar ()
-    finished <- newIORef Nothing
-    peerFinished <- newIORef Nothing
 
     let ctx =
             Context
@@ -190,8 +189,6 @@ contextNew backend params = liftIO $ do
                 , ctxRecordLayer = recordLayer
                 , ctxHandshakeSync = HandshakeSync syncNoOp syncNoOp
                 , ctxQUICMode = False
-                , ctxFinished = finished
-                , ctxPeerFinished = peerFinished
                 }
 
         syncNoOp _ _ = return ()
@@ -224,17 +221,52 @@ contextHookSetLogging :: Context -> Logging -> IO ()
 contextHookSetLogging context loggingCallbacks =
     contextModifyHooks context (\hooks -> hooks{hookLogging = loggingCallbacks})
 
+{-# DEPRECATED getFinished "Use getTLSUnique instead" #-}
+
 -- | Getting TLS Finished sent to peer.
---   This can be used as the "tls-unique" channel binding for TLS 1.2.
---   But it is susceptible to the "triple handshake vulnerability".
---   So, it is highly recommended to upgrade to TLS 1.3
---   and use the "tls-exporter" channel binding via 'getTLSExporter'.
 getFinished :: Context -> IO (Maybe VerifyData)
-getFinished = readIORef . ctxFinished
+getFinished ctx = do
+    role <- usingState_ ctx getRole
+    verifyData <-
+        if role == ClientRole
+            then usingState_ ctx $ gets stClientVerifyData
+            else usingState_ ctx $ gets stServerVerifyData
+    if verifyData == ""
+        then return Nothing
+        else return $ Just verifyData
+
+{-# DEPRECATED getPeerFinished "Use getTLSUnique instead" #-}
 
 -- | Getting TLS Finished received from peer.
 getPeerFinished :: Context -> IO (Maybe VerifyData)
-getPeerFinished = readIORef . ctxPeerFinished
+getPeerFinished ctx = do
+    role <- usingState_ ctx getRole
+    verifyData <-
+        if role == ClientRole
+            then usingState_ ctx $ gets stServerVerifyData
+            else usingState_ ctx $ gets stClientVerifyData
+    if verifyData == ""
+        then return Nothing
+        else return $ Just verifyData
+
+--   Getting the "tls-unique" channel binding for TLS 1.2.
+--   But it is susceptible to the "triple handshake vulnerability".
+--   So, it is highly recommended to upgrade to TLS 1.3
+--   and use the "tls-exporter" channel binding via 'getTLSExporter'.
+getTLSUnique :: Context -> IO (Maybe ByteString)
+getTLSUnique ctx = do
+    ver <- liftIO $ usingState_ ctx getVersion
+    if ver == TLS12
+        then do
+            resuming <- usingState_ ctx isSessionResuming
+            verifyData <-
+                if resuming
+                    then usingState_ ctx $ gets stServerVerifyData
+                    else usingState_ ctx $ gets stClientVerifyData
+            if verifyData == ""
+                then return Nothing
+                else return $ Just verifyData
+        else return Nothing
 
 -- | Getting the "tls-exporter" channel binding for TLS 1.3.
 getTLSExporter :: Context -> IO (Maybe ByteString)

core/Network/TLS/Context/Internal.hs

@@ -153,9 +153,6 @@ data Context = forall a.
     , ctxRecordLayer :: RecordLayer a
     , ctxHandshakeSync :: HandshakeSync
     , ctxQUICMode :: Bool
-    , -- For Channel Bindings for TLS, RFC5929
-      ctxFinished :: IORef (Maybe VerifyData)
-    , ctxPeerFinished :: IORef (Maybe VerifyData)
     }
 
 data HandshakeSync

core/Network/TLS/Handshake/Common.hs

@@ -33,7 +33,6 @@ module Network.TLS.Handshake.Common (
 import Control.Concurrent.MVar
 import Control.Exception (IOException, fromException, handle, throwIO)
 import Control.Monad.State.Strict
-import Data.IORef (writeIORef)
 
 import Network.TLS.Cipher
 import Network.TLS.Compression
@@ -136,8 +135,7 @@ sendCCSandFinished ctx role = do
     verifyData <-
         usingState_ ctx getVersion >>= \ver -> usingHState ctx $ getHandshakeDigest ver role
     sendPacket ctx (Handshake [Finished verifyData])
-    usingState_ ctx $ setRenegoVerifyDataForSend verifyData
-    writeIORef (ctxFinished ctx) $ Just verifyData
+    usingState_ ctx $ setVerifyDataForSend verifyData
     contextFlush ctx
 
 data RecvState m
@@ -292,8 +290,7 @@ processFinished ctx verifyData = do
     (cc, ver) <- usingState_ ctx $ (,) <$> getRole <*> getVersion
     expected <- usingHState ctx $ getHandshakeDigest ver $ invertRole cc
     when (expected /= verifyData) $ decryptError "cannot verify finished"
-    usingState_ ctx $ setRenegoVerifyDataForRecv verifyData
-    writeIORef (ctxPeerFinished ctx) $ Just verifyData
+    usingState_ ctx $ setVerifyDataForRecv verifyData
 
 processCertificates :: Context -> Role -> CertificateChain -> IO ()
 processCertificates _ ServerRole (CertificateChain []) = return ()

core/Network/TLS/Handshake/Common13.hs

@@ -68,15 +68,14 @@ import Network.TLS.Wire
 
 import Control.Concurrent.MVar
 import Control.Monad.State.Strict
-import Data.IORef (writeIORef)
 
 ----------------------------------------------------------------
 
 makeFinished :: MonadIO m => Context -> Hash -> ByteString -> m Handshake13
 makeFinished ctx usedHash baseKey = do
-    finished <- makeVerifyData usedHash baseKey <$> transcriptHash ctx
-    liftIO $ writeIORef (ctxFinished ctx) (Just finished)
-    pure $ Finished13 finished
+    verifyData <- makeVerifyData usedHash baseKey <$> transcriptHash ctx
+    liftIO $ usingState_ ctx $ setVerifyDataForSend verifyData
+    pure $ Finished13 verifyData
 
 checkFinished
     :: MonadIO m => Context -> Hash -> ByteString -> ByteString -> ByteString -> m ()
@@ -86,7 +85,7 @@ checkFinished ctx usedHash baseKey hashValue verifyData = do
         throwCore $
             Error_Protocol "broken Finished" DecodeError
     unless (verifyData' == verifyData) $ decryptError "cannot verify finished"
-    liftIO $ writeIORef (ctxPeerFinished ctx) (Just verifyData)
+    liftIO $ usingState_ ctx $ setVerifyDataForRecv verifyData
 
 makeVerifyData :: Hash -> ByteString -> ByteString -> ByteString
 makeVerifyData usedHash baseKey = hmac usedHash finishedKey

core/Network/TLS/State.hs

@@ -17,8 +17,8 @@ module Network.TLS.State (
     runTLSState,
     newTLSState,
     withTLSRNG,
-    setRenegoVerifyDataForSend,
-    setRenegoVerifyDataForRecv,
+    setVerifyDataForSend,
+    setVerifyDataForRecv,
     finishedHandshakeTypeMaterial,
     finishedHandshakeMaterial,
     certVerifyHandshakeTypeMaterial,
@@ -82,9 +82,10 @@ data TLSState = TLSState
     { stSession :: Session
     , stSessionResuming :: Bool
     , -- RFC 5746, Renegotiation Indication Extension
-      stSecureRenegotiation :: Bool -- RFC 5746
-    , stClientVerifyData :: VerifyData -- RFC 5746
-    , stServerVerifyData :: VerifyData -- RFC 5746
+      -- RFC 5929, Channel Bindings for TLS
+      stSecureRenegotiation :: Bool
+    , stClientVerifyData :: VerifyData
+    , stServerVerifyData :: VerifyData
     , stExtensionALPN :: Bool -- RFC 7301
     , stHandshakeRecordCont :: Maybe (GetContinuation (HandshakeType, ByteString))
     , stNegotiatedProtocol :: Maybe B.ByteString -- ALPN protocol
@@ -146,15 +147,15 @@ newTLSState rng clientContext =
         , stTLS12SessionTicket = Nothing
         }
 
-setRenegoVerifyDataForSend :: VerifyData -> TLSSt ()
-setRenegoVerifyDataForSend bs = do
+setVerifyDataForSend :: VerifyData -> TLSSt ()
+setVerifyDataForSend bs = do
     role <- getRole
     case role of
         ClientRole -> modify (\st -> st{stClientVerifyData = bs})
         ServerRole -> modify (\st -> st{stServerVerifyData = bs})
 
-setRenegoVerifyDataForRecv :: VerifyData -> TLSSt ()
-setRenegoVerifyDataForRecv bs = do
+setVerifyDataForRecv :: VerifyData -> TLSSt ()
+setVerifyDataForRecv bs = do
     role <- getRole
     case role of
         ClientRole -> modify (\st -> st{stServerVerifyData = bs})