tls 2.4.7 → 2.4.8
raw patch · 6 files changed
+160/−7 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- Network/TLS/Handshake/Control.hs +24/−0
- Network/TLS/Types/Secret.hs +29/−5
- Network/TLS/Types/Session.hs +37/−1
- test/SecretSpec.hs +63/−0
- tls.cabal +2/−1
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Change log for "tls" +## Version 2.4.8++* Stop printing traffic secrets and the session secret+ [#549](https://github.com/haskell-tls/hs-tls/pull/549)+ ## Version 2.4.7 * The AES-GCM and ChaCha20-Poly1305 bulk ciphers go through the one-call
Network/TLS/Handshake/Control.hs view
@@ -7,6 +7,7 @@ NegotiatedProtocol, ) where +import Crypto.Debug (DebugShow (..)) import Network.TLS.Cipher import Network.TLS.Imports import Network.TLS.Struct@@ -19,17 +20,40 @@ type NegotiatedProtocol = ByteString -- | Handshake information generated for traffic at 0-RTT level.+--+-- 'Show' renders the cipher and @\<secret\>@ for the key material; a trace+-- of what 'Network.TLS.QUIC.quicInstallKeys' is handed does not write the+-- traffic secrets to a log. 'Crypto.Debug.debugShow' renders them. data EarlySecretInfo = EarlySecretInfo Cipher (ClientTrafficSecret EarlySecret) deriving (Show) +instance DebugShow EarlySecretInfo where+ debugShow (EarlySecretInfo c s) =+ "EarlySecretInfo " ++ show c ++ " " ++ debugShow s+ -- | Handshake information generated for traffic at handshake level.+--+-- The secrets are not shown; see 'EarlySecretInfo'. data HandshakeSecretInfo = HandshakeSecretInfo Cipher (TrafficSecrets HandshakeSecret) deriving (Show) +instance DebugShow HandshakeSecretInfo where+ debugShow (HandshakeSecretInfo c ts) =+ "HandshakeSecretInfo " ++ show c ++ " " ++ debugShowPair ts+ -- | Handshake information generated for traffic at application level.+--+-- The secrets are not shown; see 'EarlySecretInfo'. newtype ApplicationSecretInfo = ApplicationSecretInfo (TrafficSecrets ApplicationSecret) deriving (Show)++instance DebugShow ApplicationSecretInfo where+ debugShow (ApplicationSecretInfo ts) =+ "ApplicationSecretInfo " ++ debugShowPair ts++debugShowPair :: TrafficSecrets a -> String+debugShowPair (c, s) = "(" ++ debugShow c ++ "," ++ debugShow s ++ ")" ----------------------------------------------------------------
Network/TLS/Types/Secret.hs view
@@ -1,5 +1,14 @@+-- | The secret types of the TLS key schedule.+--+-- None of these prints its key material: 'Show' renders @\<secret\>@, since+-- these values reach a QUIC implementation through+-- "Network.TLS.QUIC" and are the kind of thing a handshake trace prints+-- without meaning to. 'Crypto.Debug.debugShow' returns the hexadecimal that+-- 'Show' used to, for a debugging session that wants it. @SSLKEYLOGFILE@+-- does not go through either: it uses 'Network.TLS.Handshake.Key.LogLabel'. module Network.TLS.Types.Secret where +import Crypto.Debug (DebugShow (..)) import Data.ByteArray (convert) import Network.TLS.Imports import Network.TLS.Types.Cipher@@ -18,27 +27,39 @@ newtype BaseSecret a = BaseSecret Secret instance Show (BaseSecret a) where- show (BaseSecret bs) = showBytesHex $ convert bs+ show _ = "<secret>" +instance DebugShow (BaseSecret a) where+ debugShow (BaseSecret bs) = showBytesHex $ convert bs+ newtype AnyTrafficSecret a = AnyTrafficSecret Secret instance Show (AnyTrafficSecret a) where- show (AnyTrafficSecret bs) = showBytesHex $ convert bs+ show _ = "<secret>" +instance DebugShow (AnyTrafficSecret a) where+ debugShow (AnyTrafficSecret bs) = showBytesHex $ convert bs+ -- | A client traffic secret, typed with a parameter indicating a step in the -- TLS key schedule. newtype ClientTrafficSecret a = ClientTrafficSecret Secret instance Show (ClientTrafficSecret a) where- show (ClientTrafficSecret bs) = showBytesHex $ convert bs+ show _ = "<secret>" +instance DebugShow (ClientTrafficSecret a) where+ debugShow (ClientTrafficSecret bs) = showBytesHex $ convert bs+ -- | A server traffic secret, typed with a parameter indicating a step in the -- TLS key schedule. newtype ServerTrafficSecret a = ServerTrafficSecret Secret instance Show (ServerTrafficSecret a) where- show (ServerTrafficSecret bs) = showBytesHex $ convert bs+ show _ = "<secret>" +instance DebugShow (ServerTrafficSecret a) where+ debugShow (ServerTrafficSecret bs) = showBytesHex $ convert bs+ data SecretTriple a = SecretTriple { triBase :: BaseSecret a , triClient :: ClientTrafficSecret a@@ -59,4 +80,7 @@ newtype MainSecret = MainSecret Secret instance Show MainSecret where- show (MainSecret bs) = showBytesHex $ convert bs+ show _ = "<secret>"++instance DebugShow MainSecret where+ debugShow (MainSecret bs) = showBytesHex $ convert bs
Network/TLS/Types/Session.hs view
@@ -3,6 +3,7 @@ module Network.TLS.Types.Session where import Codec.Serialise+import Crypto.Debug (DebugShow (..)) import qualified Data.ByteString as B import GHC.Generics import Network.Socket (HostName)@@ -46,7 +47,42 @@ , sessionMaxEarlyDataSize :: Int , sessionFlags :: [SessionFlag] } -- sessionFromTicket :: Bool- deriving (Show, Eq, Generic)+ deriving (Eq, Generic)++-- | Everything but @sessionSecret@, which renders as @\<secret\>@: whoever+-- has it can resume the session. 'Crypto.Debug.debugShow' renders it.+instance Show SessionData where+ showsPrec = showsSessionData (showString "<secret>")++instance DebugShow SessionData where+ debugShow sd = showsSessionData (shows $ sessionSecret sd) 0 sd ""++-- | What the two instances above share, so that a field added to+-- 'SessionData' cannot reach one of them and not the other.+showsSessionData :: ShowS -> Int -> SessionData -> ShowS+showsSessionData secret d sd =+ showParen (d > 10) $+ showString "SessionData {sessionVersion = "+ . shows (sessionVersion sd)+ . showString ", sessionCipher = "+ . shows (sessionCipher sd)+ . showString ", sessionCompression = "+ . shows (sessionCompression sd)+ . showString ", sessionClientSNI = "+ . shows (sessionClientSNI sd)+ . showString ", sessionSecret = "+ . secret+ . showString ", sessionGroup = "+ . shows (sessionGroup sd)+ . showString ", sessionTicketInfo = "+ . shows (sessionTicketInfo sd)+ . showString ", sessionALPN = "+ . shows (sessionALPN sd)+ . showString ", sessionMaxEarlyDataSize = "+ . shows (sessionMaxEarlyDataSize sd)+ . showString ", sessionFlags = "+ . shows (sessionFlags sd)+ . showChar '}' is0RTTPossible :: SessionData -> Bool is0RTTPossible sd = sessionMaxEarlyDataSize sd > 0
+ test/SecretSpec.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}++module SecretSpec where++import Crypto.Debug (debugShow)+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import Data.List (isInfixOf)+import Network.TLS (Version (TLS13))+import Network.TLS.Extra.Cipher (ciphersuite_default)+import Network.TLS.Internal (SessionData (..))+import Network.TLS.QUIC+import Test.Hspec++-- | The traffic secrets reach a QUIC implementation through+-- 'quicInstallKeys', so a trace of what it is handed must not write them to a+-- log. 'debugShow' is how a debugging session asks for them on purpose.+spec :: Spec+spec = do+ describe "Show of the QUIC secret types" $ do+ it "does not print an early traffic secret" $+ check $+ EarlySecretInfo cipher clientSecret+ it "does not print the handshake traffic secrets" $+ check $+ HandshakeSecretInfo cipher (clientSecret, serverSecret)+ it "does not print the application traffic secrets" $+ check $+ ApplicationSecretInfo (clientSecret, serverSecret)+ describe "Show of a resumable session" $+ it "does not print the session secret" $ do+ let shown = show sessionData+ show (B.replicate 32 0xa5) `isInfixOf` shown `shouldBe` False+ "<secret>" `isInfixOf` shown `shouldBe` True+ show (B.replicate 32 0xa5)+ `isInfixOf` debugShow sessionData+ `shouldBe` True+ where+ sessionData =+ SessionData+ { sessionVersion = TLS13+ , sessionCipher = 0x1301+ , sessionCompression = 0+ , sessionClientSNI = Just "example.com"+ , sessionSecret = B.replicate 32 0xa5+ , sessionGroup = Nothing+ , sessionTicketInfo = Nothing+ , sessionALPN = Nothing+ , sessionMaxEarlyDataSize = 0+ , sessionFlags = []+ }+ cipher = case ciphersuite_default of+ c : _ -> c+ [] -> error "ciphersuite_default is empty"+ clientSecret = ClientTrafficSecret $ BA.convert $ B.replicate 32 0xa5+ serverSecret = ServerTrafficSecret $ BA.convert $ B.replicate 32 0x5a+ hexOf w = concat $ replicate 32 w+ check x = do+ let shown = show x+ hexOf "a5" `isInfixOf` shown `shouldBe` False+ hexOf "5a" `isInfixOf` shown `shouldBe` False+ "<secret>" `isInfixOf` shown `shouldBe` True+ hexOf "a5" `isInfixOf` debugShow x `shouldBe` True
tls.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: tls-version: 2.4.7+version: 2.4.8 license: BSD3 license-file: LICENSE copyright: Vincent Hanquez <vincent@snarc.org>@@ -214,6 +214,7 @@ PipeChan PubKey Run+ SecretSpec Session ThreadSpec