diff --git a/tls/Network/TLS/Context.hs b/tls/Network/TLS/Context.hs index d496b3de5..135505d11 100644 --- a/tls/Network/TLS/Context.hs +++ b/tls/Network/TLS/Context.hs @@ -252,7 +252,11 @@ getTLSUnique :: Context -> IO (Maybe ByteString) getTLSUnique ctx = do ver <- liftIO $ usingState_ ctx getVersion if ver == TLS12 - then usingState_ ctx getFirstVerifyData + then do + mx <- usingState_ ctx getFirstVerifyData + case mx of + Nothing -> return Nothing + Just (VerifyData verifyData) -> return $ Just verifyData else return Nothing -- | Getting the "tls-exporter" channel binding for TLS 1.3 (RFC9266). diff --git a/tls/Network/TLS/Handshake/Client/ClientHello.hs b/tls/Network/TLS/Handshake/Client/ClientHello.hs index 74ce781de..1562ec33a 100644 --- a/tls/Network/TLS/Handshake/Client/ClientHello.hs +++ b/tls/Network/TLS/Handshake/Client/ClientHello.hs @@ -141,7 +141,7 @@ sendClientHello' cparams ctx groups crand (pskInfo, rtt0info, rtt0) = do secureReneg = if supportedSecureRenegotiation $ ctxSupported ctx then do - cvd <- usingState_ ctx $ getVerifyData ClientRole + VerifyData cvd <- usingState_ ctx $ getVerifyData ClientRole return $ Just $ toExtensionRaw $ SecureRenegotiation cvd "" else return Nothing alpnExtension = do diff --git a/tls/Network/TLS/Handshake/Client/ServerHello.hs b/tls/Network/TLS/Handshake/Client/ServerHello.hs index 5663ab8e7..377d01752 100644 --- a/tls/Network/TLS/Handshake/Client/ServerHello.hs +++ b/tls/Network/TLS/Handshake/Client/ServerHello.hs @@ -163,8 +163,8 @@ processServerHello _ _ p = unexpected (show p) (Just "server hello") processServerExtension :: ExtensionRaw -> TLSSt () processServerExtension (ExtensionRaw extID content) | extID == EID_SecureRenegotiation = do - cvd <- getVerifyData ClientRole - svd <- getVerifyData ServerRole + VerifyData cvd <- getVerifyData ClientRole + VerifyData svd <- getVerifyData ServerRole let bs = extensionEncode $ SecureRenegotiation cvd svd unless (bs == content) $ throwError $ diff --git a/tls/Network/TLS/Handshake/Common.hs b/tls/Network/TLS/Handshake/Common.hs index 6d4c0210c..d7f79f859 100644 --- a/tls/Network/TLS/Handshake/Common.hs +++ b/tls/Network/TLS/Handshake/Common.hs @@ -141,7 +141,9 @@ sendCCSandFinished ctx role = do sendPacket12 ctx ChangeCipherSpec contextFlush ctx verifyData <- - usingState_ ctx getVersion >>= \ver -> usingHState ctx $ getHandshakeDigest ver role + VerifyData + <$> ( usingState_ ctx getVersion >>= \ver -> usingHState ctx $ getHandshakeDigest ver role + ) sendPacket12 ctx (Handshake [Finished verifyData]) usingState_ ctx $ setVerifyDataForSend verifyData contextFlush ctx @@ -302,7 +304,8 @@ expectFinished _ p = unexpected (show p) (Just "Handshake Finished") processFinished :: Context -> VerifyData -> IO () processFinished ctx verifyData = do (cc, ver) <- usingState_ ctx $ (,) <$> getRole <*> getVersion - expected <- usingHState ctx $ getHandshakeDigest ver $ invertRole cc + expected <- + VerifyData <$> (usingHState ctx $ getHandshakeDigest ver $ invertRole cc) when (expected /= verifyData) $ decryptError "cannot verify finished" usingState_ ctx $ setVerifyDataForRecv verifyData diff --git a/tls/Network/TLS/Handshake/Common13.hs b/tls/Network/TLS/Handshake/Common13.hs index c2519384d..4d0946b90 100644 --- a/tls/Network/TLS/Handshake/Common13.hs +++ b/tls/Network/TLS/Handshake/Common13.hs @@ -76,19 +76,20 @@ import Control.Monad.State.Strict makeFinished :: MonadIO m => Context -> Hash -> ByteString -> m Handshake13 makeFinished ctx usedHash baseKey = do - verifyData <- makeVerifyData usedHash baseKey <$> transcriptHash ctx + verifyData <- + VerifyData . makeVerifyData usedHash baseKey <$> transcriptHash ctx liftIO $ usingState_ ctx $ setVerifyDataForSend verifyData pure $ Finished13 verifyData checkFinished - :: MonadIO m => Context -> Hash -> ByteString -> ByteString -> ByteString -> m () -checkFinished ctx usedHash baseKey hashValue verifyData = do + :: MonadIO m => Context -> Hash -> ByteString -> ByteString -> VerifyData -> m () +checkFinished ctx usedHash baseKey hashValue vd@(VerifyData verifyData) = do let verifyData' = makeVerifyData usedHash baseKey hashValue when (B.length verifyData /= B.length verifyData') $ throwCore $ Error_Protocol "broken Finished" DecodeError unless (verifyData' == verifyData) $ decryptError "cannot verify finished" - liftIO $ usingState_ ctx $ setVerifyDataForRecv verifyData + liftIO $ usingState_ ctx $ setVerifyDataForRecv vd makeVerifyData :: Hash -> ByteString -> ByteString -> ByteString makeVerifyData usedHash baseKey = hmac usedHash finishedKey diff --git a/tls/Network/TLS/Handshake/Server/ClientHello12.hs b/tls/Network/TLS/Handshake/Server/ClientHello12.hs index c3b3ece1b..95ec8dec0 100644 --- a/tls/Network/TLS/Handshake/Server/ClientHello12.hs +++ b/tls/Network/TLS/Handshake/Server/ClientHello12.hs @@ -54,7 +54,7 @@ checkSesecureRenegotiation ctx CH{..} = do setSecureRenegotiation True case extensionLookup EID_SecureRenegotiation chExtensions of Just content -> usingState_ ctx $ do - cvd <- getVerifyData ClientRole + VerifyData cvd <- getVerifyData ClientRole let bs = extensionEncode (SecureRenegotiation cvd "") unless (bs == content) $ throwError $ diff --git a/tls/Network/TLS/Handshake/Server/ServerHello12.hs b/tls/Network/TLS/Handshake/Server/ServerHello12.hs index 8b78ac8bc..9cce20b47 100644 --- a/tls/Network/TLS/Handshake/Server/ServerHello12.hs +++ b/tls/Network/TLS/Handshake/Server/ServerHello12.hs @@ -245,8 +245,8 @@ makeServerHello sparams ctx usedCipher mcred chExts session = do if secReneg then do vd <- usingState_ ctx $ do - cvd <- getVerifyData ClientRole - svd <- getVerifyData ServerRole + VerifyData cvd <- getVerifyData ClientRole + VerifyData svd <- getVerifyData ServerRole return $ extensionEncode $ SecureRenegotiation cvd svd return [ExtensionRaw EID_SecureRenegotiation vd] else return [] diff --git a/tls/Network/TLS/Packet.hs b/tls/Network/TLS/Packet.hs index 24a2b1f5b..9a9df9c30 100644 --- a/tls/Network/TLS/Packet.hs +++ b/tls/Network/TLS/Packet.hs @@ -207,7 +207,7 @@ decodeCertificate = do getCertRaw = getOpaque24 >>= \cert -> return (3 + B.length cert, cert) decodeFinished :: Get Handshake -decodeFinished = Finished <$> (remaining >>= getBytes) +decodeFinished = Finished . VerifyData <$> (remaining >>= getBytes) decodeNewSessionTicket :: Get Handshake decodeNewSessionTicket = NewSessionTicket <$> getWord32 <*> getOpaque16 @@ -358,7 +358,7 @@ encodeHandshake' (CertRequest certTypes sigAlgs certAuthorities) = runPut $ do sigAlgs putDNames certAuthorities encodeHandshake' (CertVerify digitallySigned) = runPut $ putDigitallySigned digitallySigned -encodeHandshake' (Finished opaque) = runPut $ putBytes opaque +encodeHandshake' (Finished (VerifyData opaque)) = runPut $ putBytes opaque encodeHandshake' (NewSessionTicket life ticket) = runPut $ do putWord32 life putOpaque16 ticket diff --git a/tls/Network/TLS/Packet13.hs b/tls/Network/TLS/Packet13.hs index 0951d3ee2..e8cbe1b84 100644 --- a/tls/Network/TLS/Packet13.hs +++ b/tls/Network/TLS/Packet13.hs @@ -53,7 +53,7 @@ encodeHandshake13' (Certificate13 reqctx cc ess) = encodeCertificate13 reqctx cc encodeHandshake13' (CertVerify13 hs signature) = runPut $ do putSignatureHashAlgorithm hs putOpaque16 signature -encodeHandshake13' (Finished13 dat) = runPut $ putBytes dat +encodeHandshake13' (Finished13 (VerifyData dat)) = runPut $ putBytes dat encodeHandshake13' (NewSessionTicket13 life ageadd nonce label exts) = runPut $ do putWord32 life putWord32 ageadd @@ -111,7 +111,7 @@ decodeServerHello13 = do return $ ServerHello13 random session cipherid exts decodeFinished13 :: Get Handshake13 -decodeFinished13 = Finished13 <$> (remaining >>= getBytes) +decodeFinished13 = Finished13 . VerifyData <$> (remaining >>= getBytes) decodeEncryptedExtensions13 :: Get Handshake13 decodeEncryptedExtensions13 = diff --git a/tls/Network/TLS/State.hs b/tls/Network/TLS/State.hs index 6aa687ae5..5d6a24929 100644 --- a/tls/Network/TLS/State.hs +++ b/tls/Network/TLS/State.hs @@ -280,27 +280,27 @@ setClientSNI hn = modify (\st -> st{stClientSNI = Just hn}) getClientSNI :: TLSSt (Maybe HostName) getClientSNI = gets stClientSNI -getVerifyData :: Role -> TLSSt ByteString +getVerifyData :: Role -> TLSSt VerifyData getVerifyData client = do mVerifyData <- gets (if client == ClientRole then stClientVerifyData else stServerVerifyData) - return $ fromMaybe "" mVerifyData + return $ fromMaybe (VerifyData "") mVerifyData -getMyVerifyData :: TLSSt (Maybe ByteString) +getMyVerifyData :: TLSSt (Maybe VerifyData) getMyVerifyData = do role <- getRole if role == ClientRole then gets stClientVerifyData else gets stServerVerifyData -getPeerVerifyData :: TLSSt (Maybe ByteString) +getPeerVerifyData :: TLSSt (Maybe VerifyData) getPeerVerifyData = do role <- getRole if role == ClientRole then gets stServerVerifyData else gets stClientVerifyData -getFirstVerifyData :: TLSSt (Maybe ByteString) +getFirstVerifyData :: TLSSt (Maybe VerifyData) getFirstVerifyData = do ver <- getVersion case ver of diff --git a/tls/Network/TLS/Struct.hs b/tls/Network/TLS/Struct.hs index b2eb0cdb1..ff0799e87 100644 --- a/tls/Network/TLS/Struct.hs +++ b/tls/Network/TLS/Struct.hs @@ -41,7 +41,7 @@ module Network.TLS.Struct ( ServerRandom (..), ClientRandom (..), FinishedData, - VerifyData, + VerifyData (..), SessionID, Session (..), SessionData (..), @@ -248,7 +248,10 @@ instance Show Session where {-# DEPRECATED FinishedData "use VerifyData" #-} type FinishedData = ByteString -type VerifyData = ByteString + +newtype VerifyData = VerifyData ByteString deriving (Eq) +instance Show VerifyData where + show (VerifyData bs) = showBytesHex bs ---------------------------------------------------------------- diff --git a/tls/test/Arbitrary.hs b/tls/test/Arbitrary.hs index 971c6a891..5ae45ed74 100644 --- a/tls/test/Arbitrary.hs +++ b/tls/test/Arbitrary.hs @@ -92,7 +92,7 @@ instance Arbitrary Handshake where , ClientKeyXchg . CKX_RSA <$> genByteString 48 , CertRequest <$> arbitrary <*> arbitrary <*> listOf arbitraryDN , CertVerify <$> arbitrary - , Finished <$> genByteString 12 + , Finished . VerifyData <$> genByteString 12 ] instance Arbitrary Handshake13 where @@ -121,7 +121,7 @@ instance Arbitrary Handshake13 where <*> return (CertificateChain certs) <*> replicateM (length certs) arbitrary , CertVerify13 <$> (unsafeHead <$> arbitrary) <*> genByteString 32 - , Finished13 <$> genByteString 12 + , Finished13 . VerifyData <$> genByteString 12 , KeyUpdate13 <$> elements [UpdateNotRequested, UpdateRequested] ]