tls 1.5.1 → 1.5.2
raw patch · 20 files changed
+618/−343 lines, 20 filesnew-uploader
Files
- CHANGELOG.md +17/−1
- Network/TLS/Core.hs +7/−7
- Network/TLS/Crypto.hs +33/−10
- Network/TLS/Crypto/Types.hs +0/−4
- Network/TLS/Handshake/Client.hs +95/−108
- Network/TLS/Handshake/Common.hs +8/−8
- Network/TLS/Handshake/Common13.hs +123/−20
- Network/TLS/Handshake/Key.hs +56/−28
- Network/TLS/Handshake/Process.hs +1/−1
- Network/TLS/Handshake/Server.hs +53/−64
- Network/TLS/Handshake/Signature.hs +67/−70
- Network/TLS/Handshake/State.hs +19/−14
- Network/TLS/Packet.hs +5/−1
- Network/TLS/Packet13.hs +42/−3
- Network/TLS/Parameters.hs +1/−1
- Network/TLS/Struct.hs +41/−1
- Network/TLS/Types.hs +34/−0
- Network/TLS/X509.hs +4/−0
- Tests/Marshalling.hs +11/−1
- tls.cabal +1/−1
CHANGELOG.md view
@@ -1,10 +1,26 @@+## Version 1.5.2++- Enabled TLS 1.3 by default [#398](https://github.com/vincenthz/hs-tls/pull/398)+- Avoid handshake failure with small RSA keys [#394](https://github.com/vincenthz/hs-tls/pull/394)++NOTES:++- Starting with tls-1.5.0, the parameter `supportedVersions` contains values+ ordered by decreasing preference, so typically the higher versions first.+ This departs from code samples previously available. For maximum+ interoperability, users overriding the default value should verify and adapt+ their code.+ ## Version 1.5.1 - Post-handshake authentication [#363](https://github.com/vincenthz/hs-tls/pull/363)+- Middlebox compatibility [#386](https://github.com/vincenthz/hs-tls/pull/386)+- Verification and configuration of session-ticket lifetime [#373](https://github.com/vincenthz/hs-tls/pull/373) - Fixing memory leak [#366](https://github.com/vincenthz/hs-tls/pull/366)-- Improve version negotiation [#368](https://github.com/vincenthz/hs-tls/pull/368) - Don't send 0-RTT data when ticket is expired [#370](https://github.com/vincenthz/hs-tls/pull/370) - Handshake packet fragmentation [#371](https://github.com/vincenthz/hs-tls/pull/371)+- Fix SSLv2 deprecated header [#383](https://github.com/vincenthz/hs-tls/pull/383)+- Other improvements to TLS 1.3 and RFC conformance [#368](https://github.com/vincenthz/hs-tls/pull/368) [#372](https://github.com/vincenthz/hs-tls/pull/372) [#375](https://github.com/vincenthz/hs-tls/pull/375) [#376](https://github.com/vincenthz/hs-tls/pull/376) [#377](https://github.com/vincenthz/hs-tls/pull/377) [#378](https://github.com/vincenthz/hs-tls/pull/378) [#380](https://github.com/vincenthz/hs-tls/pull/380) [#382](https://github.com/vincenthz/hs-tls/pull/382) [#385](https://github.com/vincenthz/hs-tls/pull/385) [#387](https://github.com/vincenthz/hs-tls/pull/387) [#388](https://github.com/vincenthz/hs-tls/pull/388) ## Version 1.5.0
Network/TLS/Core.hs view
@@ -193,10 +193,10 @@ -- read+write locks (which is also what we use for all calls to the -- session manager). withWriteLock ctx $ do- ResuptionSecret resumptionMasterSecret <- usingHState ctx getTLS13Secret- (usedHash, usedCipher, _) <- getTxState ctx- let hashSize = hashDigestSize usedHash- psk = hkdfExpandLabel usedHash resumptionMasterSecret "resumption" nonce hashSize+ Just resumptionMasterSecret <- usingHState ctx getTLS13ResumptionSecret+ (_, usedCipher, _) <- getTxState ctx+ let choice = makeCipherChoice TLS13 usedCipher+ psk = derivePSK choice resumptionMasterSecret nonce maxSize = case extensionLookup extensionID_EarlyData exts >>= extensionDecode MsgTNewSessionTicket of Just (EarlyDataIndication (Just ms)) -> fromIntegral $ safeNonNegative32 ms _ -> 0@@ -297,9 +297,9 @@ -> (Context -> Hash -> Cipher -> C8.ByteString -> IO ()) -> IO () keyUpdate ctx getState setState = do- (usedHash, usedCipher, applicationTrafficSecretN) <- getState ctx- let applicationTrafficSecretN1 = hkdfExpandLabel usedHash applicationTrafficSecretN "traffic upd" "" $ hashDigestSize usedHash- setState ctx usedHash usedCipher applicationTrafficSecretN1+ (usedHash, usedCipher, applicationSecretN) <- getState ctx+ let applicationSecretN1 = hkdfExpandLabel usedHash applicationSecretN "traffic upd" "" $ hashDigestSize usedHash+ setState ctx usedHash usedCipher applicationSecretN1 -- | How to update keys in TLS 1.3 data KeyUpdateRequest = OneWay -- ^ Unidirectional key update
Network/TLS/Crypto.hs view
@@ -25,13 +25,15 @@ , PublicKey , PrivateKey , SignatureParams(..)- , findDigitalSignatureAlg+ , isKeyExchangeSignatureKey , findKeyExchangeSignatureAlg , findFiniteFieldGroup , kxEncrypt , kxDecrypt , kxSign , kxVerify+ , kxCanUseRSApkcs1+ , kxCanUseRSApss , KxError(..) , RSAEncoding(..) ) where@@ -40,6 +42,7 @@ import qualified Data.ByteString as B import qualified Data.ByteArray as B (convert) import Crypto.Error+import Crypto.Number.Basic (numBits) import Crypto.Random import qualified Crypto.PubKey.DH as DH import qualified Crypto.PubKey.DSA as DSA@@ -72,15 +75,15 @@ | KxUnsupported deriving (Show) -findDigitalSignatureAlg :: (PubKey, PrivKey) -> Maybe DigitalSignatureAlg-findDigitalSignatureAlg keyPair =- case keyPair of- (PubKeyRSA _, PrivKeyRSA _) -> Just DS_RSA- (PubKeyDSA _, PrivKeyDSA _) -> Just DS_DSS- --(PubKeyECDSA _, PrivKeyECDSA _) -> Just DS_ECDSA- (PubKeyEd25519 _, PrivKeyEd25519 _) -> Just DS_Ed25519- (PubKeyEd448 _, PrivKeyEd448 _) -> Just DS_Ed448- _ -> Nothing+isKeyExchangeSignatureKey :: KeyExchangeSignatureAlg -> PubKey -> Bool+isKeyExchangeSignatureKey = f+ where+ f KX_RSA (PubKeyRSA _) = True+ f KX_DSS (PubKeyDSA _) = True+ f KX_ECDSA (PubKeyEC _) = True+ f KX_ECDSA (PubKeyEd25519 _) = True+ f KX_ECDSA (PubKeyEd448 _) = True+ f _ _ = False findKeyExchangeSignatureAlg :: (PubKey, PrivKey) -> Maybe KeyExchangeSignatureAlg findKeyExchangeSignatureAlg keyPair =@@ -193,6 +196,26 @@ kxDecrypt _ _ = return (Left KxUnsupported) data RSAEncoding = RSApkcs1 | RSApss deriving (Show,Eq)++-- | Test the RSASSA-PKCS1 length condition described in RFC 8017 section 9.2,+-- i.e. @emLen >= tLen + 11@. Lengths are in bytes.+kxCanUseRSApkcs1 :: RSA.PublicKey -> Hash -> Bool+kxCanUseRSApkcs1 pk h = RSA.public_size pk >= tLen + 11+ where+ tLen = prefixSize h + hashDigestSize h++ prefixSize MD5 = 18+ prefixSize SHA1 = 15+ prefixSize SHA224 = 19+ prefixSize SHA256 = 19+ prefixSize SHA384 = 19+ prefixSize SHA512 = 19+ prefixSize _ = error (show h ++ " is not supported for RSASSA-PKCS1")++-- | Test the RSASSA-PSS length condition described in RFC 8017 section 9.1.1,+-- i.e. @emBits >= 8hLen + 8sLen + 9@. Lengths are in bits.+kxCanUseRSApss :: RSA.PublicKey -> Hash -> Bool+kxCanUseRSApss pk h = numBits (RSA.public_n pk) >= 16 * hashDigestSize h + 10 -- Signature algorithm and associated parameters. --
Network/TLS/Crypto/Types.hs view
@@ -17,10 +17,6 @@ availableECGroups :: [Group] availableECGroups = [P256,P384,P521,X25519,X448] --- Digital signature algorithm, in close relation to public/private key types.-data DigitalSignatureAlg = DS_RSA | DS_DSS | DS_ECDSA | DS_Ed25519 | DS_Ed448- deriving (Show, Eq)- -- Key-exchange signature algorithm, in close relation to ciphers -- (before TLS 1.3). data KeyExchangeSignatureAlg = KX_RSA | KX_DSS | KX_ECDSA
Network/TLS/Handshake/Client.hs view
@@ -46,7 +46,6 @@ import Network.TLS.Handshake.Random import Network.TLS.Handshake.State import Network.TLS.Handshake.State13-import Network.TLS.KeySchedule import Network.TLS.Wire handshakeClientWith :: ClientParams -> Context -> Handshake -> IO ()@@ -196,16 +195,14 @@ let tinfo = fromJust "sessionTicketInfo" $ sessionTicketInfo sdata age <- getAge tinfo return $ if isAgeValid age tinfo- then Just (sid, sdata, sCipher, ageToObfuscatedAge age tinfo)+ then Just (sid, sdata, makeCipherChoice TLS13 sCipher, ageToObfuscatedAge age tinfo) else Nothing preSharedKeyExtension pskInfo = case pskInfo of Nothing -> return Nothing- Just (sid, _, sCipher, obfAge) ->- let usedHash = cipherHash sCipher- siz = hashDigestSize usedHash- zero = B.replicate siz 0+ Just (sid, _, choice, obfAge) ->+ let zero = cZero choice identity = PskIdentity sid obfAge offeredPsks = PreSharedKeyClientHello [identity] [zero] in return $ Just $ toExtensionRaw offeredPsks@@ -231,15 +228,14 @@ adjustExtentions pskInfo exts ch = case pskInfo of Nothing -> return exts- Just (_, sdata, sCipher, _) -> do- let usedHash = cipherHash sCipher- siz = hashDigestSize usedHash- zero = B.replicate siz 0- psk = sessionSecret sdata- earlySecret = hkdfExtract usedHash zero psk- usingHState ctx $ setTLS13Secret (EarlySecret earlySecret)+ Just (_, sdata, choice, _) -> do+ let psk = sessionSecret sdata+ earlySecret = initEarlySecret choice (Just psk)+ usingHState ctx $ setTLS13EarlySecret earlySecret let ech = encodeHandshake ch- binder <- makePSKBinder ctx earlySecret usedHash (siz + 3) (Just ech)+ h = cHash choice+ siz = hashDigestSize h+ binder <- makePSKBinder ctx earlySecret h (siz + 3) (Just ech) let exts' = init exts ++ [adjust (last exts)] adjust (ExtensionRaw eid withoutBinders) = ExtensionRaw eid withBinders where@@ -283,22 +279,21 @@ mapM_ send0RTT rtt0info return (rtt0, map (\(ExtensionRaw i _) -> i) extensions) - get0RTTinfo (_, sdata, sCipher, _) = do+ get0RTTinfo (_, sdata, choice, _) = do earlyData <- clientEarlyData cparams guard (B.length earlyData <= sessionMaxEarlyDataSize sdata)- return (sCipher, earlyData)+ return (choice, earlyData) - send0RTT (usedCipher, earlyData) = do- let usedHash = cipherHash usedCipher- -- fixme: not initialized yet- -- hCh <- transcriptHash ctx- hmsgs <- usingHState ctx getHandshakeMessages- let hCh = hash usedHash $ B.concat hmsgs -- fixme- EarlySecret earlySecret <- usingHState ctx getTLS13Secret -- fixme- let clientEarlyTrafficSecret = deriveSecret usedHash earlySecret "c e traffic" hCh- logKey ctx (ClientEarlyTrafficSecret clientEarlyTrafficSecret)+ send0RTT (choice, earlyData) = do+ let usedCipher = cCipher choice+ usedHash = cHash choice+ Just earlySecret <- usingHState ctx getTLS13EarlySecret+ -- Client hello is stored in hstHandshakeDigest+ -- But HandshakeDigestContext is not created yet.+ earlyKey <- calculateEarlySecret ctx choice (Right earlySecret) False+ let ClientTrafficSecret clientEarlySecret = pairClient earlyKey runPacketFlight ctx $ sendChangeCipherSpec13 ctx- setTxState ctx usedHash usedCipher clientEarlyTrafficSecret+ setTxState ctx usedHash usedCipher clientEarlySecret mapChunks_ 16384 (sendPacket13 ctx . AppData13) earlyData usingHState ctx $ setTLS13RTT0Status RTT0Sent @@ -323,10 +318,10 @@ -> Credential -> IO () storePrivInfoClient ctx cTypes (cc, privkey) = do- privalg <- storePrivInfo ctx cc privkey- unless (certificateCompatible privalg cTypes) $+ pubkey <- storePrivInfo ctx cc privkey+ unless (certificateCompatible pubkey cTypes) $ throwCore $ Error_Protocol- ( show privalg ++ " credential does not match allowed certificate types"+ ( pubkeyType pubkey ++ " credential does not match allowed certificate types" , True , InternalError ) @@ -408,7 +403,7 @@ return $ Just cc -- | Return a most preferred 'HandAndSignatureAlgorithm' that is--- compatible with the private key and server's signature+-- compatible with the local key and server's signature -- algorithms (both already saved). Must only be called for TLS -- versions 1.2 and up. --@@ -418,22 +413,22 @@ -- getLocalHashSigAlg :: Context -> [HashAndSignatureAlgorithm]- -> DigitalSignatureAlg+ -> PubKey -> IO HashAndSignatureAlgorithm-getLocalHashSigAlg ctx cHashSigs keyAlg = do+getLocalHashSigAlg ctx cHashSigs pubKey = do -- Must be present with TLS 1.2 and up. (Just (_, Just hashSigs, _)) <- usingHState ctx getCertReqCBdata- let want = (&&) <$> signatureCompatible keyAlg+ let want = (&&) <$> signatureCompatible pubKey <*> flip elem hashSigs case find want cHashSigs of Just best -> return best Nothing -> throwCore $ Error_Protocol- ( keyerr keyAlg+ ( keyerr pubKey , True , HandshakeFailure ) where- keyerr alg = "no " ++ show alg ++ " hash algorithm in common with the server"+ keyerr k = "no " ++ pubkeyType k ++ " hash algorithm in common with the server" -- | Return the supported 'CertificateType' values that are -- compatible with at least one supported signature algorithm.@@ -576,16 +571,16 @@ -- certSent <- usingHState ctx getClientCertSent when certSent $ do- keyAlg <- getLocalDigitalSignatureAlg ctx+ pubKey <- getLocalPublicKey ctx mhashSig <- case ver of TLS12 -> let cHashSigs = supportedHashSignatures $ ctxSupported ctx- in Just <$> getLocalHashSigAlg ctx cHashSigs keyAlg+ in Just <$> getLocalHashSigAlg ctx cHashSigs pubKey _ -> return Nothing -- Fetch all handshake messages up to now. msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages- sigDig <- createCertificateVerify ctx ver keyAlg mhashSig msgs+ sigDig <- createCertificateVerify ctx ver pubKey mhashSig msgs sendPacket ctx $ Handshake [CertVerify sigDig] processServerExtension :: ExtensionRaw -> TLSSt ()@@ -752,27 +747,23 @@ (c,_) -> throwCore $ Error_Protocol ("unknown server key exchange received, expecting: " ++ show c, True, HandshakeFailure) doDHESignature dhparams signature kxsAlg = do -- FF group selected by the server is verified when generating CKX- signatureType <- getSignatureType kxsAlg- verified <- digitallySignDHParamsVerify ctx dhparams signatureType signature- unless verified $ decryptError ("bad " ++ show signatureType ++ " signature for dhparams " ++ show dhparams)+ publicKey <- getSignaturePublicKey kxsAlg+ verified <- digitallySignDHParamsVerify ctx dhparams publicKey signature+ unless verified $ decryptError ("bad " ++ pubkeyType publicKey ++ " signature for dhparams " ++ show dhparams) usingHState ctx $ setServerDHParams dhparams doECDHESignature ecdhparams signature kxsAlg = do -- EC group selected by the server is verified when generating CKX- signatureType <- getSignatureType kxsAlg- verified <- digitallySignECDHParamsVerify ctx ecdhparams signatureType signature- unless verified $ decryptError ("bad " ++ show signatureType ++ " signature for ecdhparams")+ publicKey <- getSignaturePublicKey kxsAlg+ verified <- digitallySignECDHParamsVerify ctx ecdhparams publicKey signature+ unless verified $ decryptError ("bad " ++ pubkeyType publicKey ++ " signature for ecdhparams") usingHState ctx $ setServerECDHParams ecdhparams - getSignatureType kxsAlg = do+ getSignaturePublicKey kxsAlg = do publicKey <- usingHState ctx getRemotePublicKey- case (kxsAlg, publicKey) of- (KX_RSA, PubKeyRSA _) -> return DS_RSA- (KX_DSS, PubKeyDSA _) -> return DS_DSS- (KX_ECDSA, PubKeyEC _) -> return DS_ECDSA- (KX_ECDSA, PubKeyEd25519 _) -> return DS_Ed25519- (KX_ECDSA, PubKeyEd448 _) -> return DS_Ed448- _ -> throwCore $ Error_Protocol ("server public key algorithm is incompatible with " ++ show kxsAlg, True, HandshakeFailure)+ unless (isKeyExchangeSignatureKey kxsAlg publicKey) $+ throwCore $ Error_Protocol ("server public key algorithm is incompatible with " ++ show kxsAlg, True, HandshakeFailure)+ return publicKey processServerKeyExchange ctx p = processCertificateRequest ctx p @@ -820,55 +811,52 @@ handshakeClient13 :: ClientParams -> Context -> Maybe Group -> IO () handshakeClient13 cparams ctx groupSent = do- usedCipher <- usingHState ctx getPendingCipher- let usedHash = cipherHash usedCipher- handshakeClient13' cparams ctx groupSent usedCipher usedHash+ choice <- makeCipherChoice TLS13 <$> usingHState ctx getPendingCipher+ handshakeClient13' cparams ctx groupSent choice -handshakeClient13' :: ClientParams -> Context -> Maybe Group -> Cipher -> Hash -> IO ()-handshakeClient13' cparams ctx groupSent usedCipher usedHash = do- (resuming, handshakeSecret, clientHandshakeTrafficSecret, serverHandshakeTrafficSecret) <- switchToHandshakeSecret+handshakeClient13' :: ClientParams -> Context -> Maybe Group -> CipherChoice -> IO ()+handshakeClient13' cparams ctx groupSent choice = do+ (_, hkey, resuming) <- switchToHandshakeSecret+ let handshakeSecret = triBase hkey+ ClientTrafficSecret clientHandshakeSecret = triClient hkey+ ServerTrafficSecret serverHandshakeSecret = triServer hkey rtt0accepted <- runRecvHandshake13 $ do accepted <- recvHandshake13 ctx expectEncryptedExtensions unless resuming $ recvHandshake13 ctx expectCertRequest- recvHandshake13hash ctx $ expectFinished serverHandshakeTrafficSecret+ recvHandshake13hash ctx $ expectFinished serverHandshakeSecret return accepted hChSf <- transcriptHash ctx runPacketFlight ctx $ sendChangeCipherSpec13 ctx when rtt0accepted $ sendPacket13 ctx (Handshake13 [EndOfEarlyData13])- setTxState ctx usedHash usedCipher clientHandshakeTrafficSecret- sendClientFlight13 cparams ctx usedHash clientHandshakeTrafficSecret- masterSecret <- switchToTrafficSecret handshakeSecret hChSf- setResumptionSecret masterSecret+ setTxState ctx usedHash usedCipher clientHandshakeSecret+ sendClientFlight13 cparams ctx usedHash clientHandshakeSecret+ appKey <- switchToApplicationSecret handshakeSecret hChSf+ let applicationSecret = triBase appKey+ setResumptionSecret applicationSecret handshakeTerminate13 ctx where+ usedCipher = cCipher choice+ usedHash = cHash choice+ hashSize = hashDigestSize usedHash- zero = B.replicate hashSize 0 switchToHandshakeSecret = do ensureRecvComplete ctx ecdhe <- calcSharedKey (earlySecret, resuming) <- makeEarlySecret- let handshakeSecret = hkdfExtract usedHash (deriveSecret usedHash earlySecret "derived" (hash usedHash "")) ecdhe- hChSh <- transcriptHash ctx- let clientHandshakeTrafficSecret = deriveSecret usedHash handshakeSecret "c hs traffic" hChSh- serverHandshakeTrafficSecret = deriveSecret usedHash handshakeSecret "s hs traffic" hChSh- logKey ctx (ServerHandshakeTrafficSecret serverHandshakeTrafficSecret)- logKey ctx (ClientHandshakeTrafficSecret clientHandshakeTrafficSecret)- setRxState ctx usedHash usedCipher serverHandshakeTrafficSecret- return (resuming, handshakeSecret, clientHandshakeTrafficSecret, serverHandshakeTrafficSecret)+ handKey <- calculateHandshakeSecret ctx choice earlySecret ecdhe+ let ServerTrafficSecret serverHandshakeSecret = triServer handKey+ setRxState ctx usedHash usedCipher serverHandshakeSecret+ return (usedCipher, handKey, resuming) - switchToTrafficSecret handshakeSecret hChSf = do+ switchToApplicationSecret handshakeSecret hChSf = do ensureRecvComplete ctx- let masterSecret = hkdfExtract usedHash (deriveSecret usedHash handshakeSecret "derived" (hash usedHash "")) zero- let clientApplicationTrafficSecret0 = deriveSecret usedHash masterSecret "c ap traffic" hChSf- serverApplicationTrafficSecret0 = deriveSecret usedHash masterSecret "s ap traffic" hChSf- exporterMasterSecret = deriveSecret usedHash masterSecret "exp master" hChSf- usingState_ ctx $ setExporterMasterSecret exporterMasterSecret- logKey ctx (ServerTrafficSecret0 serverApplicationTrafficSecret0)- logKey ctx (ClientTrafficSecret0 clientApplicationTrafficSecret0)- setTxState ctx usedHash usedCipher clientApplicationTrafficSecret0- setRxState ctx usedHash usedCipher serverApplicationTrafficSecret0- return masterSecret+ appKey <- calculateApplicationSecret ctx choice handshakeSecret hChSf+ let ServerTrafficSecret serverApplicationSecret0 = triServer appKey+ let ClientTrafficSecret clientApplicationSecret0 = triClient appKey+ setTxState ctx usedHash usedCipher clientApplicationSecret0+ setRxState ctx usedHash usedCipher serverApplicationSecret0+ return appKey calcSharedKey = do serverKeyShare <- do@@ -884,20 +872,20 @@ usingHState ctx getGroupPrivate >>= fromServerKeyShare serverKeyShare makeEarlySecret = do- secret <- usingHState ctx getTLS13Secret- case secret of- EarlySecret sec -> do- mSelectedIdentity <- usingState_ ctx getTLS13PreSharedKey- case mSelectedIdentity of- Nothing ->- return (hkdfExtract usedHash zero zero, False)- Just (PreSharedKeyServerHello 0) -> do- unless (B.length sec == hashSize) $- throwCore $ Error_Protocol ("selected cipher is incompatible with selected PSK", True, IllegalParameter)- usingHState ctx $ setTLS13HandshakeMode PreSharedKey- return (sec, True)- Just _ -> throwCore $ Error_Protocol ("selected identity out of range", True, IllegalParameter)- _ -> return (hkdfExtract usedHash zero zero, False)+ mEarlySecretPSK <- usingHState ctx getTLS13EarlySecret+ case mEarlySecretPSK of+ Nothing -> return (initEarlySecret choice Nothing, False)+ Just earlySecretPSK@(BaseSecret sec) -> do+ mSelectedIdentity <- usingState_ ctx getTLS13PreSharedKey+ case mSelectedIdentity of+ Nothing ->+ return (initEarlySecret choice Nothing, False)+ Just (PreSharedKeyServerHello 0) -> do+ unless (B.length sec == hashSize) $+ throwCore $ Error_Protocol ("selected cipher is incompatible with selected PSK", True, IllegalParameter)+ usingHState ctx $ setTLS13HandshakeMode PreSharedKey+ return (earlySecretPSK, True)+ Just _ -> throwCore $ Error_Protocol ("selected identity out of range", True, IllegalParameter) expectEncryptedExtensions (EncryptedExtensions13 eexts) = do liftIO $ setALPN ctx eexts@@ -930,13 +918,13 @@ expectCertAndVerify (Certificate13 _ cc _) = do _ <- liftIO $ processCertificate cparams ctx (Certificates cc) let pubkey = certPubKey $ getCertificate $ getCertificateChainLeaf cc+ checkDigitalSignatureKey pubkey usingHState ctx $ setPublicKey pubkey recvHandshake13hash ctx $ expectCertVerify pubkey expectCertAndVerify p = unexpected (show p) (Just "server certificate") expectCertVerify pubkey hChSc (CertVerify13 sigAlg sig) = do- let keyAlg = fromJust "fromPubKey" (fromPubKey pubkey)- ok <- checkCertVerify ctx keyAlg sigAlg sig hChSc+ ok <- checkCertVerify ctx pubkey sigAlg sig hChSc unless ok $ decryptError "cannot verify CertificateVerify" expectCertVerify _ _ p = unexpected (show p) (Just "certificate verify") @@ -944,10 +932,9 @@ checkFinished usedHash baseKey hashValue verifyData expectFinished _ _ p = unexpected (show p) (Just "server finished") - setResumptionSecret masterSecret = do- hChCf <- transcriptHash ctx- let resumptionMasterSecret = deriveSecret usedHash masterSecret "res master" hChCf- usingHState ctx $ setTLS13Secret $ ResuptionSecret resumptionMasterSecret+ setResumptionSecret applicationSecret = do+ resumptionSecret <- calculateResumptionSecret ctx choice applicationSecret+ usingHState ctx $ setTLS13ResumptionSecret resumptionSecret processCertRequest13 :: MonadIO m => Context -> CertReqContext -> [ExtensionRaw] -> m () processCertRequest13 ctx token exts = do@@ -1017,9 +1004,9 @@ [] -> return () _ -> do hChSc <- transcriptHash ctx- keyAlg <- getLocalDigitalSignatureAlg ctx- sigAlg <- liftIO $ getLocalHashSigAlg ctx cHashSigs keyAlg- vfy <- makeCertVerify ctx keyAlg sigAlg hChSc+ pubKey <- getLocalPublicKey ctx+ sigAlg <- liftIO $ getLocalHashSigAlg ctx cHashSigs pubKey+ vfy <- makeCertVerify ctx pubKey sigAlg hChSc loadPacket13 ctx $ Handshake13 [vfy] -- sendClientData13 _ _ =@@ -1045,8 +1032,8 @@ bracket (saveHState ctx) (restoreHState ctx) $ \_ -> do processHandshake13 ctx h processCertRequest13 ctx certReqCtx exts- (usedHash, _, applicationTrafficSecretN) <- getTxState ctx- sendClientFlight13 cparams ctx usedHash applicationTrafficSecretN+ (usedHash, _, applicationSecretN) <- getTxState ctx+ sendClientFlight13 cparams ctx usedHash applicationSecretN postHandshakeAuthClientWith _ _ _ = throwCore $ Error_Protocol ("unexpected handshake message received in postHandshakeAuthClientWith", True, UnexpectedMessage)
Network/TLS/Handshake/Common.hs view
@@ -33,6 +33,7 @@ import Network.TLS.Struct13 import Network.TLS.IO import Network.TLS.State+import Network.TLS.Handshake.Key import Network.TLS.Handshake.Process import Network.TLS.Handshake.State import Network.TLS.Record.State@@ -200,18 +201,17 @@ => Context -> CertificateChain -> PrivKey- -> m DigitalSignatureAlg+ -> m PubKey storePrivInfo ctx cc privkey = do let CertificateChain (c:_) = cc pubkey = certPubKey $ getCertificate c- privalg <- case findDigitalSignatureAlg (pubkey, privkey) of- Just alg -> return alg- Nothing -> throwCore $ Error_Protocol- ( "mismatched or unsupported private key pair"- , True- , InternalError )+ unless (isDigitalSignaturePair (pubkey, privkey)) $+ throwCore $ Error_Protocol+ ( "mismatched or unsupported private key pair"+ , True+ , InternalError ) usingHState ctx $ setPublicPrivateKeys (pubkey, privkey)- return privalg+ return pubkey -- verify that the group selected by the peer is supported in the local -- configuration
Network/TLS/Handshake/Common13.hs view
@@ -34,6 +34,14 @@ , runRecvHandshake13 , recvHandshake13 , recvHandshake13hash+ , CipherChoice(..)+ , makeCipherChoice+ , initEarlySecret+ , calculateEarlySecret+ , calculateHandshakeSecret+ , calculateApplicationSecret+ , calculateResumptionSecret+ , derivePSK ) where import qualified Data.ByteArray as BA@@ -125,24 +133,26 @@ clientContextString :: ByteString clientContextString = "TLS 1.3, client CertificateVerify" -makeCertVerify :: MonadIO m => Context -> DigitalSignatureAlg -> HashAndSignatureAlgorithm -> ByteString -> m Handshake13-makeCertVerify ctx sig hs hashValue = do+makeCertVerify :: MonadIO m => Context -> PubKey -> HashAndSignatureAlgorithm -> ByteString -> m Handshake13+makeCertVerify ctx pub hs hashValue = do cc <- liftIO $ usingState_ ctx isClientContext let ctxStr | cc == ClientRole = clientContextString | otherwise = serverContextString target = makeTarget ctxStr hashValue- CertVerify13 hs <$> sign ctx sig hs target+ CertVerify13 hs <$> sign ctx pub hs target -checkCertVerify :: MonadIO m => Context -> DigitalSignatureAlg -> HashAndSignatureAlgorithm -> Signature -> ByteString -> m Bool-checkCertVerify ctx sig hs signature hashValue = liftIO $ do- cc <- usingState_ ctx isClientContext- let ctxStr | cc == ClientRole = serverContextString -- opposite context- | otherwise = clientContextString- target = makeTarget ctxStr hashValue- sigParams = signatureParams sig (Just hs)- checkHashSignatureValid13 hs- checkSupportedHashSignature ctx (Just hs)- verifyPublic ctx sigParams target signature+checkCertVerify :: MonadIO m => Context -> PubKey -> HashAndSignatureAlgorithm -> Signature -> ByteString -> m Bool+checkCertVerify ctx pub hs signature hashValue+ | pub `signatureCompatible` hs = liftIO $ do+ cc <- usingState_ ctx isClientContext+ let ctxStr | cc == ClientRole = serverContextString -- opposite context+ | otherwise = clientContextString+ target = makeTarget ctxStr hashValue+ sigParams = signatureParams pub (Just hs)+ checkHashSignatureValid13 hs+ checkSupportedHashSignature ctx (Just hs)+ verifyPublic ctx sigParams target signature+ | otherwise = return False makeTarget :: ByteString -> ByteString -> ByteString makeTarget contextString hashValue = runPut $ do@@ -151,22 +161,22 @@ putWord8 0 putBytes hashValue -sign :: MonadIO m => Context -> DigitalSignatureAlg -> HashAndSignatureAlgorithm -> ByteString -> m Signature-sign ctx sig hs target = liftIO $ do+sign :: MonadIO m => Context -> PubKey -> HashAndSignatureAlgorithm -> ByteString -> m Signature+sign ctx pub hs target = liftIO $ do cc <- usingState_ ctx isClientContext- let sigParams = signatureParams sig (Just hs)+ let sigParams = signatureParams pub (Just hs) signPrivate ctx cc sigParams target ---------------------------------------------------------------- -makePSKBinder :: Context -> ByteString -> Hash -> Int -> Maybe ByteString -> IO ByteString-makePSKBinder ctx earlySecret usedHash truncLen mch = do+makePSKBinder :: Context -> BaseSecret EarlySecret -> Hash -> Int -> Maybe ByteString -> IO ByteString+makePSKBinder ctx (BaseSecret sec) usedHash truncLen mch = do rmsgs0 <- usingHState ctx getHandshakeMessagesRev -- fixme let rmsgs = case mch of Just ch -> trunc ch : rmsgs0 Nothing -> trunc (head rmsgs0) : tail rmsgs0 hChTruncated = hash usedHash $ B.concat $ reverse rmsgs- binderKey = deriveSecret usedHash earlySecret "res binder" (hash usedHash "")+ binderKey = deriveSecret usedHash sec "res binder" (hash usedHash "") return $ makeVerifyData usedHash binderKey hChTruncated where trunc x = B.take takeLen x@@ -212,7 +222,7 @@ , hstHandshakeDigest = hstHandshakeDigest hshake , hstTLS13HandshakeMode = hstTLS13HandshakeMode hshake , hstTLS13RTT0Status = hstTLS13RTT0Status hshake- , hstTLS13Secret = hstTLS13Secret hshake+ , hstTLS13ResumptionSecret = hstTLS13ResumptionSecret hshake } -- forget handshake data stored in TLS state usingState_ ctx $ do@@ -397,3 +407,96 @@ isHashSignatureValid13 (h, SignatureECDSA) = h `elem` [ HashSHA256, HashSHA384, HashSHA512 ] isHashSignatureValid13 _ = False++data CipherChoice = CipherChoice {+ cVersion :: Version+ , cCipher :: Cipher+ , cHash :: Hash+ , cZero :: !ByteString+ }++makeCipherChoice :: Version -> Cipher -> CipherChoice+makeCipherChoice ver cipher = CipherChoice ver cipher h zero+ where+ h = cipherHash cipher+ zero = B.replicate (hashDigestSize h) 0++----------------------------------------------------------------++calculateEarlySecret :: Context -> CipherChoice+ -> Either ByteString (BaseSecret EarlySecret)+ -> Bool -> IO (SecretPair EarlySecret)+calculateEarlySecret ctx choice maux initialized = do+ hCh <- if initialized then+ transcriptHash ctx+ else do+ hmsgs <- usingHState ctx getHandshakeMessages+ return $ hash usedHash $ B.concat hmsgs+ let earlySecret = case maux of+ Right (BaseSecret sec) -> sec+ Left psk -> hkdfExtract usedHash zero psk+ clientEarlySecret = deriveSecret usedHash earlySecret "c e traffic" hCh+ cets = ClientTrafficSecret clientEarlySecret :: ClientTrafficSecret EarlySecret+ logKey ctx cets+ return $ SecretPair (BaseSecret earlySecret) cets+ where+ usedHash = cHash choice+ zero = cZero choice++initEarlySecret :: CipherChoice -> Maybe ByteString -> BaseSecret EarlySecret+initEarlySecret choice mpsk = BaseSecret sec+ where+ sec = hkdfExtract usedHash zero zeroOrPSK+ usedHash = cHash choice+ zero = cZero choice+ zeroOrPSK = case mpsk of+ Just psk -> psk+ Nothing -> zero++calculateHandshakeSecret :: Context -> CipherChoice -> BaseSecret EarlySecret -> ByteString+ -> IO (SecretTriple HandshakeSecret)+calculateHandshakeSecret ctx choice (BaseSecret sec) ecdhe = do+ hChSh <- transcriptHash ctx+ let handshakeSecret = hkdfExtract usedHash (deriveSecret usedHash sec "derived" (hash usedHash "")) ecdhe+ let clientHandshakeSecret = deriveSecret usedHash handshakeSecret "c hs traffic" hChSh+ serverHandshakeSecret = deriveSecret usedHash handshakeSecret "s hs traffic" hChSh+ let shts = ServerTrafficSecret serverHandshakeSecret :: ServerTrafficSecret HandshakeSecret+ chts = ClientTrafficSecret clientHandshakeSecret :: ClientTrafficSecret HandshakeSecret+ logKey ctx shts+ logKey ctx chts+ return $ SecretTriple (BaseSecret handshakeSecret) chts shts+ where+ usedHash = cHash choice++calculateApplicationSecret :: Context -> CipherChoice -> BaseSecret HandshakeSecret -> ByteString+ -> IO (SecretTriple ApplicationSecret)+calculateApplicationSecret ctx choice (BaseSecret sec) hChSf = do+ let applicationSecret = hkdfExtract usedHash (deriveSecret usedHash sec "derived" (hash usedHash "")) zero+ let clientApplicationSecret0 = deriveSecret usedHash applicationSecret "c ap traffic" hChSf+ serverApplicationSecret0 = deriveSecret usedHash applicationSecret "s ap traffic" hChSf+ exporterMasterSecret = deriveSecret usedHash applicationSecret "exp master" hChSf+ usingState_ ctx $ setExporterMasterSecret exporterMasterSecret+ let sts0 = ServerTrafficSecret serverApplicationSecret0 :: ServerTrafficSecret ApplicationSecret+ let cts0 = ClientTrafficSecret clientApplicationSecret0 :: ClientTrafficSecret ApplicationSecret+ logKey ctx sts0+ logKey ctx cts0+ return $ SecretTriple (BaseSecret applicationSecret) cts0 sts0+ where+ usedHash = cHash choice+ zero = cZero choice++calculateResumptionSecret :: Context -> CipherChoice -> BaseSecret ApplicationSecret+ -> IO (BaseSecret ResumptionSecret)+calculateResumptionSecret ctx choice (BaseSecret sec) = do+ hChCf <- transcriptHash ctx+ let resumptionMasterSecret = deriveSecret usedHash sec "res master" hChCf+ return $ BaseSecret resumptionMasterSecret+ where+ usedHash = cHash choice++derivePSK :: CipherChoice -> BaseSecret ResumptionSecret -> ByteString -> ByteString+derivePSK choice (BaseSecret sec) nonce =+ hkdfExpandLabel usedHash sec "resumption" nonce hashSize+ where+ usedHash = cHash choice+ hashSize = hashDigestSize usedHash
Network/TLS/Handshake/Key.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleInstances #-} -- | -- Module : Network.TLS.Handshake.Key -- License : BSD-style@@ -17,9 +18,10 @@ , generateECDHEShared , generateFFDHE , generateFFDHEShared- , getLocalDigitalSignatureAlg+ , isDigitalSignaturePair+ , checkDigitalSignatureKey+ , getLocalPublicKey , logKey- , LogKey(..) ) where import Control.Monad.State.Strict@@ -83,39 +85,65 @@ generateFFDHEShared :: Context -> Group -> DHPublic -> IO (Maybe (DHPublic, DHKey)) generateFFDHEShared ctx grp pub = usingState_ ctx $ withRNG $ dhGroupGetPubShared grp pub -getLocalDigitalSignatureAlg :: (MonadFail m, MonadIO m) => Context -> m DigitalSignatureAlg-getLocalDigitalSignatureAlg ctx = do- keys <- usingHState ctx getLocalPublicPrivateKeys- case findDigitalSignatureAlg keys of- Just sigAlg -> return sigAlg- Nothing -> fail "selected credential does not support signing"+isDigitalSignatureKey :: PubKey -> Bool+isDigitalSignatureKey (PubKeyRSA _) = True+isDigitalSignatureKey (PubKeyDSA _) = True+isDigitalSignatureKey (PubKeyEC _) = True+isDigitalSignatureKey (PubKeyEd25519 _) = True+isDigitalSignatureKey (PubKeyEd448 _) = True+isDigitalSignatureKey _ = False +-- | Test whether the argument is a public key supported for signature. This+-- also accepts a key for RSA encryption. This test is performed by clients or+-- servers before verifying a remote Certificate Verify.+checkDigitalSignatureKey :: MonadIO m => PubKey -> m ()+checkDigitalSignatureKey key =+ unless (isDigitalSignatureKey key) $+ throwCore $ Error_Protocol ("unsupported remote public key type", True, HandshakeFailure)++-- | Test whether the argument is matching key pair supported for signature.+-- This also accepts material for RSA encryption. This test is performed by+-- servers or clients before using a credential from the local configuration.+isDigitalSignaturePair :: (PubKey, PrivKey) -> Bool+isDigitalSignaturePair keyPair =+ case keyPair of+ (PubKeyRSA _, PrivKeyRSA _) -> True+ (PubKeyDSA _, PrivKeyDSA _) -> True+ --(PubKeyECDSA _, PrivKeyECDSA _) -> True+ (PubKeyEd25519 _, PrivKeyEd25519 _) -> True+ (PubKeyEd448 _, PrivKeyEd448 _) -> True+ _ -> False++getLocalPublicKey :: MonadIO m => Context -> m PubKey+getLocalPublicKey ctx =+ usingHState ctx (fst <$> getLocalPublicPrivateKeys)+ ---------------------------------------------------------------- -data LogKey = MasterSecret ByteString- | ClientEarlyTrafficSecret ByteString- | ServerHandshakeTrafficSecret ByteString- | ClientHandshakeTrafficSecret ByteString- | ServerTrafficSecret0 ByteString- | ClientTrafficSecret0 ByteString+class LogLabel a where+ labelAndKey :: a -> (String, ByteString) -labelAndKey :: LogKey -> (String, ByteString)-labelAndKey (MasterSecret key) =- ("CLIENT_RANDOM", key)-labelAndKey (ClientEarlyTrafficSecret key) =- ("CLIENT_EARLY_TRAFFIC_SECRET", key)-labelAndKey (ServerHandshakeTrafficSecret key) =- ("SERVER_HANDSHAKE_TRAFFIC_SECRET", key)-labelAndKey (ClientHandshakeTrafficSecret key) =- ("CLIENT_HANDSHAKE_TRAFFIC_SECRET", key)-labelAndKey (ServerTrafficSecret0 key) =- ("SERVER_TRAFFIC_SECRET_0", key)-labelAndKey (ClientTrafficSecret0 key) =- ("CLIENT_TRAFFIC_SECRET_0", key)+instance LogLabel MasterSecret where+ labelAndKey (MasterSecret key) = ("CLIENT_RANDOM", key) +instance LogLabel (ClientTrafficSecret EarlySecret) where+ labelAndKey (ClientTrafficSecret key) = ("CLIENT_EARLY_TRAFFIC_SECRET", key)++instance LogLabel (ServerTrafficSecret HandshakeSecret) where+ labelAndKey (ServerTrafficSecret key) = ("SERVER_HANDSHAKE_TRAFFIC_SECRET", key)++instance LogLabel (ClientTrafficSecret HandshakeSecret) where+ labelAndKey (ClientTrafficSecret key) = ("CLIENT_HANDSHAKE_TRAFFIC_SECRET", key)++instance LogLabel (ServerTrafficSecret ApplicationSecret) where+ labelAndKey (ServerTrafficSecret key) = ("SERVER_TRAFFIC_SECRET_0", key)++instance LogLabel (ClientTrafficSecret ApplicationSecret) where+ labelAndKey (ClientTrafficSecret key) = ("CLIENT_TRAFFIC_SECRET_0", key)+ -- NSS Key Log Format -- See https://developer.mozilla.org/en-US/docs/Mozilla/Projects/NSS/Key_Log_Format-logKey :: Context -> LogKey -> IO ()+logKey :: LogLabel a => Context -> a -> IO () logKey ctx logkey = do mhst <- getHState ctx case mhst of
Network/TLS/Handshake/Process.hs view
@@ -18,7 +18,7 @@ import Control.Monad.State.Strict (gets) import Control.Monad.IO.Class (liftIO) -import Network.TLS.Types (Role(..), invertRole)+import Network.TLS.Types (Role(..), invertRole, MasterSecret(..)) import Network.TLS.Util import Network.TLS.Packet import Network.TLS.ErrT
Network/TLS/Handshake/Server.hs view
@@ -44,7 +44,6 @@ import Network.TLS.Handshake.Certificate import Network.TLS.X509 import Network.TLS.Handshake.State13-import Network.TLS.KeySchedule import Network.TLS.Handshake.Common13 -- Put the server context in handshake mode.@@ -226,8 +225,8 @@ -- 'possibleHashSigAlgs' the result is Nothing, and the credential will -- not be used to sign. This avoids a failure later in 'decideHashSig'. signingRank cred =- case credentialDigitalSignatureAlg cred of- Just sig -> findIndex (sig `signatureCompatible`) possibleHashSigAlgs+ case credentialDigitalSignatureKey cred of+ Just pub -> findIndex (pub `signatureCompatible`) possibleHashSigAlgs Nothing -> Nothing -- Finally compute credential lists and resulting cipher list.@@ -438,21 +437,21 @@ -- the "signature_algorithms" extension in a client hello. -- If RSA is also used for key exchange, this function is -- not called.- decideHashSig sigAlg = do+ decideHashSig pubKey = do usedVersion <- usingState_ ctx getVersion case usedVersion of TLS12 -> do let hashSigs = hashAndSignaturesInCommon ctx exts- case filter (sigAlg `signatureCompatible`) hashSigs of- [] -> error ("no hash signature for " ++ show sigAlg)+ case filter (pubKey `signatureCompatible`) hashSigs of+ [] -> error ("no hash signature for " ++ pubkeyType pubKey) x:_ -> return $ Just x _ -> return Nothing generateSKX_DHE kxsAlg = do serverParams <- setup_DHE- sigAlg <- getLocalDigitalSignatureAlg ctx- mhashSig <- decideHashSig sigAlg- signed <- digitallySignDHParams ctx serverParams sigAlg mhashSig+ pubKey <- getLocalPublicKey ctx+ mhashSig <- decideHashSig pubKey+ signed <- digitallySignDHParams ctx serverParams pubKey mhashSig case kxsAlg of KX_RSA -> return $ SKX_DHE_RSA serverParams signed KX_DSS -> return $ SKX_DHE_DSS serverParams signed@@ -474,9 +473,9 @@ [] -> throwCore $ Error_Protocol ("no common group", True, HandshakeFailure) g:_ -> return g serverParams <- setup_ECDHE grp- sigAlg <- getLocalDigitalSignatureAlg ctx- mhashSig <- decideHashSig sigAlg- signed <- digitallySignECDHParams ctx serverParams sigAlg mhashSig+ pubKey <- getLocalPublicKey ctx+ mhashSig <- decideHashSig pubKey+ signed <- digitallySignECDHParams ctx serverParams pubKey mhashSig case kxsAlg of KX_RSA -> return $ SKX_ECDHE_RSA serverParams signed KX_ECDSA -> return $ SKX_ECDHE_ECDSA serverParams signed@@ -522,9 +521,10 @@ -- Fetch all handshake messages up to now. msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages - sigAlgExpected <- getRemoteSignatureAlg+ pubKey <- usingHState ctx getRemotePublicKey+ checkDigitalSignatureKey pubKey - verif <- checkCertificateVerify ctx usedVersion sigAlgExpected msgs dsig+ verif <- checkCertificateVerify ctx usedVersion pubKey msgs dsig clientCertVerify sparams ctx certs verif return $ RecvStateNext expectChangeCipher @@ -536,12 +536,6 @@ Nothing -> return () expectChangeCipher p - getRemoteSignatureAlg = do- pk <- usingHState ctx getRemotePublicKey- case fromPubKey pk of- Nothing -> throwCore $ Error_Protocol ("unsupported remote public key type", True, HandshakeFailure)- Just sig -> return sig- expectChangeCipher ChangeCipherSpec = do return $ RecvStateHandshake expectFinish @@ -581,9 +575,11 @@ in serverGroups `intersect` clientGroups _ -> [] -credentialDigitalSignatureAlg :: Credential -> Maybe DigitalSignatureAlg-credentialDigitalSignatureAlg cred =- findDigitalSignatureAlg (credentialPublicPrivateKeys cred)+credentialDigitalSignatureKey :: Credential -> Maybe PubKey+credentialDigitalSignatureKey cred+ | isDigitalSignaturePair keys = Just pubkey+ | otherwise = Nothing+ where keys@(pubkey, _) = credentialPublicPrivateKeys cred filterSortCredentials :: Ord a => (Credential -> Maybe a) -> Credentials -> Credentials filterSortCredentials rankFun (Credentials creds) =@@ -695,10 +691,9 @@ usingHState ctx $ setNegotiatedGroup $ keyShareEntryGroup clientKeyShare srand <- setServerParameter (psk, binderInfo, is0RTTvalid) <- choosePSK- hCh <- transcriptHash ctx- let earlySecret = hkdfExtract usedHash zero psk- clientEarlyTrafficSecret = deriveSecret usedHash earlySecret "c e traffic" hCh- logKey ctx (ClientEarlyTrafficSecret clientEarlyTrafficSecret)+ earlyKey <- calculateEarlySecret ctx choice (Left psk) True+ let earlySecret = pairBase earlyKey+ ClientTrafficSecret clientEarlySecret = pairClient earlyKey extensions <- checkBinder earlySecret binderInfo hrr <- usingState_ ctx getTLS13HRR let authenticated = isJust binderInfo@@ -721,39 +716,32 @@ mCredInfo <- if authenticated then return Nothing else decideCredentialInfo (ecdhe,keyShare) <- makeServerKeyShare ctx clientKeyShare ensureRecvComplete ctx- let handshakeSecret = hkdfExtract usedHash (deriveSecret usedHash earlySecret "derived" (hash usedHash "")) ecdhe- clientHandshakeTrafficSecret <- runPacketFlight ctx $ do+ (clientHandshakeSecret, handshakeSecret) <- runPacketFlight ctx $ do sendServerHello keyShare srand extensions sendChangeCipherSpec13 ctx ----------------------------------------------------------------- hChSh <- transcriptHash ctx- let clientHandshakeTrafficSecret = deriveSecret usedHash handshakeSecret "c hs traffic" hChSh- serverHandshakeTrafficSecret = deriveSecret usedHash handshakeSecret "s hs traffic" hChSh+ handKey <- liftIO $ calculateHandshakeSecret ctx choice earlySecret ecdhe+ let ServerTrafficSecret serverHandshakeSecret = triServer handKey+ ClientTrafficSecret clientHandshakeSecret = triClient handKey liftIO $ do- logKey ctx (ServerHandshakeTrafficSecret serverHandshakeTrafficSecret)- logKey ctx (ClientHandshakeTrafficSecret clientHandshakeTrafficSecret)- setRxState ctx usedHash usedCipher $ if rtt0OK then clientEarlyTrafficSecret else clientHandshakeTrafficSecret- setTxState ctx usedHash usedCipher serverHandshakeTrafficSecret+ setRxState ctx usedHash usedCipher $ if rtt0OK then clientEarlySecret else clientHandshakeSecret+ setTxState ctx usedHash usedCipher serverHandshakeSecret ---------------------------------------------------------------- sendExtensions rtt0OK case mCredInfo of Nothing -> return () Just (cred, hashSig) -> sendCertAndVerify cred hashSig- rawFinished <- makeFinished ctx usedHash serverHandshakeTrafficSecret+ rawFinished <- makeFinished ctx usedHash serverHandshakeSecret loadPacket13 ctx $ Handshake13 [rawFinished]- return clientHandshakeTrafficSecret+ return (clientHandshakeSecret, triBase handKey) sfSentTime <- getCurrentTimeFromBase ----------------------------------------------------------------- let masterSecret = hkdfExtract usedHash (deriveSecret usedHash handshakeSecret "derived" (hash usedHash "")) zero hChSf <- transcriptHash ctx- let clientApplicationTrafficSecret0 = deriveSecret usedHash masterSecret "c ap traffic" hChSf- serverApplicationTrafficSecret0 = deriveSecret usedHash masterSecret "s ap traffic" hChSf- exporterMasterSecret = deriveSecret usedHash masterSecret "exp master" hChSf- usingState_ ctx $ setExporterMasterSecret exporterMasterSecret- ----------------------------------------------------------------- logKey ctx (ServerTrafficSecret0 serverApplicationTrafficSecret0)- logKey ctx (ClientTrafficSecret0 clientApplicationTrafficSecret0)- setTxState ctx usedHash usedCipher serverApplicationTrafficSecret0+ appKey <- calculateApplicationSecret ctx choice handshakeSecret hChSf+ let ClientTrafficSecret clientApplicationSecret0 = triClient appKey+ ServerTrafficSecret serverApplicationSecret0 = triServer appKey+ applicationSecret = triBase appKey+ setTxState ctx usedHash usedCipher serverApplicationSecret0 ---------------------------------------------------------------- if rtt0OK then setEstablished ctx (EarlyDataAllowed rtt0max)@@ -761,14 +749,14 @@ setEstablished ctx (EarlyDataNotAllowed 3) -- hardcoding let expectFinished hChBeforeCf (Finished13 verifyData) = liftIO $ do- checkFinished usedHash clientHandshakeTrafficSecret hChBeforeCf verifyData+ checkFinished usedHash clientHandshakeSecret hChBeforeCf verifyData handshakeTerminate13 ctx- setRxState ctx usedHash usedCipher clientApplicationTrafficSecret0- sendNewSessionTicket masterSecret sfSentTime+ setRxState ctx usedHash usedCipher clientApplicationSecret0+ sendNewSessionTicket applicationSecret sfSentTime expectFinished _ hs = unexpected (show hs) (Just "finished 13") let expectEndOfEarlyData EndOfEarlyData13 =- setRxState ctx usedHash usedCipher clientHandshakeTrafficSecret+ setRxState ctx usedHash usedCipher clientHandshakeSecret expectEndOfEarlyData hs = unexpected (show hs) (Just "end of early data") if not authenticated && serverWantClientCert sparams then@@ -785,6 +773,8 @@ recvHandshake13hash ctx expectFinished ensureRecvComplete ctx where+ choice = makeCipherChoice chosenVersion usedCipher+ setServerParameter = do srand <- serverRandom ctx chosenVersion $ supportedVersions $ serverSupported sparams usingState_ ctx $ setVersion chosenVersion@@ -884,8 +874,8 @@ ess = replicate (length cs) [] loadPacket13 ctx $ Handshake13 [Certificate13 "" certChain ess] hChSc <- transcriptHash ctx- sigAlg <- getLocalDigitalSignatureAlg ctx- vrfy <- makeCertVerify ctx sigAlg hashSig hChSc+ pubkey <- getLocalPublicKey ctx+ vrfy <- makeCertVerify ctx pubkey hashSig hChSc loadPacket13 ctx $ Handshake13 [vrfy] sendExtensions rtt0OK = do@@ -910,14 +900,13 @@ let extensions = catMaybes [earlyDataExtension, groupExtension, sniExtension] ++ protoExt loadPacket13 ctx $ Handshake13 [EncryptedExtensions13 extensions] - sendNewSessionTicket masterSecret sfSentTime = when sendNST $ do+ sendNewSessionTicket applicationSecret sfSentTime = when sendNST $ do cfRecvTime <- getCurrentTimeFromBase let rtt = cfRecvTime - sfSentTime- hChCf <- transcriptHash ctx nonce <- getStateRNG ctx 32- let resumptionMasterSecret = deriveSecret usedHash masterSecret "res master" hChCf- life = toSeconds $ serverTicketLifetime sparams- psk = hkdfExpandLabel usedHash resumptionMasterSecret "resumption" nonce hashSize+ resumptionMasterSecret <- calculateResumptionSecret ctx choice applicationSecret+ let life = toSeconds $ serverTicketLifetime sparams+ psk = derivePSK choice resumptionMasterSecret nonce (label, add) <- generateSession life psk rtt0max rtt let nst = createNewSessionTicket life add nonce label rtt0max sendPacket13 ctx $ Handshake13 [nst]@@ -960,9 +949,9 @@ pubkey <- case cc of [] -> throwCore $ Error_Protocol ("client certificate missing", True, HandshakeFailure) c:_ -> return $ certPubKey $ getCertificate c+ checkDigitalSignatureKey pubkey usingHState ctx $ setPublicKey pubkey- let keyAlg = fromJust "fromPubKey" (fromPubKey pubkey)- verif <- checkCertVerify ctx keyAlg sigAlg sig hChCc+ verif <- checkCertVerify ctx pubkey sigAlg sig hChCc clientCertVerify sparams ctx certs verif expectCertVerify _ _ _ hs = unexpected (show hs) (Just "certificate verify 13") @@ -1066,9 +1055,9 @@ credentialsFindForSigning13' :: HashAndSignatureAlgorithm -> Credentials -> Maybe Credential credentialsFindForSigning13' sigAlg (Credentials l) = find forSigning l where- forSigning cred = case credentialDigitalSignatureAlg cred of+ forSigning cred = case credentialDigitalSignatureKey cred of Nothing -> False- Just sig -> sig `signatureCompatible` sigAlg+ Just pub -> pub `signatureCompatible` sigAlg clientCertificate :: ServerParams -> Context -> CertificateChain -> IO () clientCertificate sparams ctx certs = do@@ -1138,10 +1127,10 @@ processHandshake13 ctx certReq processHandshake13 ctx h - (usedHash, _, applicationTrafficSecretN) <- getRxState ctx+ (usedHash, _, applicationSecretN) <- getRxState ctx let expectFinished hChBeforeCf (Finished13 verifyData) = do- checkFinished usedHash applicationTrafficSecretN hChBeforeCf verifyData+ checkFinished usedHash applicationSecretN hChBeforeCf verifyData void $ restoreHState ctx baseHState expectFinished _ hs = unexpected (show hs) (Just "finished 13")
Network/TLS/Handshake/Signature.hs view
@@ -19,7 +19,6 @@ , signatureCompatible , hashSigToCertType , signatureParams- , fromPubKey , decryptError ) where @@ -34,40 +33,37 @@ import Network.TLS.Handshake.State import Network.TLS.Handshake.Key import Network.TLS.Util+import Network.TLS.X509 import Control.Monad.State.Strict -fromPubKey :: PubKey -> Maybe DigitalSignatureAlg-fromPubKey (PubKeyRSA _) = Just DS_RSA-fromPubKey (PubKeyDSA _) = Just DS_DSS-fromPubKey (PubKeyEC _) = Just DS_ECDSA-fromPubKey (PubKeyEd25519 _) = Just DS_Ed25519-fromPubKey (PubKeyEd448 _) = Just DS_Ed448-fromPubKey _ = Nothing- decryptError :: MonadIO m => String -> m a decryptError msg = throwCore $ Error_Protocol (msg, True, DecryptError) --- | Check that the signature algorithm is compatible with a list of--- 'CertificateType' values. Ed25519 and Ed448 have no assigned code point--- and are checked with extension "signature_algorithms" only.-certificateCompatible :: DigitalSignatureAlg -> [CertificateType] -> Bool-certificateCompatible DS_RSA cTypes = CertificateType_RSA_Sign `elem` cTypes-certificateCompatible DS_DSS cTypes = CertificateType_DSS_Sign `elem` cTypes-certificateCompatible DS_ECDSA cTypes = CertificateType_ECDSA_Sign `elem` cTypes-certificateCompatible DS_Ed25519 _ = True-certificateCompatible DS_Ed448 _ = True+-- | Check that the key is compatible with a list of 'CertificateType' values.+-- Ed25519 and Ed448 have no assigned code point and are checked with extension+-- "signature_algorithms" only.+certificateCompatible :: PubKey -> [CertificateType] -> Bool+certificateCompatible (PubKeyRSA _) cTypes = CertificateType_RSA_Sign `elem` cTypes+certificateCompatible (PubKeyDSA _) cTypes = CertificateType_DSS_Sign `elem` cTypes+certificateCompatible (PubKeyEC _) cTypes = CertificateType_ECDSA_Sign `elem` cTypes+certificateCompatible (PubKeyEd25519 _) _ = True+certificateCompatible (PubKeyEd448 _) _ = True+certificateCompatible _ _ = False -signatureCompatible :: DigitalSignatureAlg -> HashAndSignatureAlgorithm -> Bool-signatureCompatible DS_RSA (_, SignatureRSA) = True-signatureCompatible DS_RSA (_, SignatureRSApssRSAeSHA256) = True-signatureCompatible DS_RSA (_, SignatureRSApssRSAeSHA384) = True-signatureCompatible DS_RSA (_, SignatureRSApssRSAeSHA512) = True-signatureCompatible DS_DSS (_, SignatureDSS) = True-signatureCompatible DS_ECDSA (_, SignatureECDSA) = True-signatureCompatible DS_Ed25519 (_, SignatureEd25519) = True-signatureCompatible DS_Ed448 (_, SignatureEd448) = True-signatureCompatible _ (_, _) = False+signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool+signatureCompatible (PubKeyRSA pk) (HashSHA1, SignatureRSA) = kxCanUseRSApkcs1 pk SHA1+signatureCompatible (PubKeyRSA pk) (HashSHA256, SignatureRSA) = kxCanUseRSApkcs1 pk SHA256+signatureCompatible (PubKeyRSA pk) (HashSHA384, SignatureRSA) = kxCanUseRSApkcs1 pk SHA384+signatureCompatible (PubKeyRSA pk) (HashSHA512, SignatureRSA) = kxCanUseRSApkcs1 pk SHA512+signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA256) = kxCanUseRSApss pk SHA256+signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA384) = kxCanUseRSApss pk SHA384+signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA512) = kxCanUseRSApss pk SHA512+signatureCompatible (PubKeyDSA _) (_, SignatureDSS) = True+signatureCompatible (PubKeyEC _) (_, SignatureECDSA) = True+signatureCompatible (PubKeyEd25519 _) (_, SignatureEd25519) = True+signatureCompatible (PubKeyEd448 _) (_, SignatureEd448) = True+signatureCompatible _ (_, _) = False -- | Translate a 'HashAndSignatureAlgorithm' to an acceptable 'CertificateType'. -- Perhaps this needs to take supported groups into account, so that, for@@ -111,30 +107,30 @@ checkCertificateVerify :: Context -> Version- -> DigitalSignatureAlg+ -> PubKey -> ByteString -> DigitallySigned -> IO Bool-checkCertificateVerify ctx usedVersion sigAlgExpected msgs digSig@(DigitallySigned hashSigAlg _) =+checkCertificateVerify ctx usedVersion pubKey msgs digSig@(DigitallySigned hashSigAlg _) = case (usedVersion, hashSigAlg) of (TLS12, Nothing) -> return False- (TLS12, Just hs) | sigAlgExpected `signatureCompatible` hs -> doVerify- | otherwise -> return False+ (TLS12, Just hs) | pubKey `signatureCompatible` hs -> doVerify+ | otherwise -> return False (_, Nothing) -> doVerify (_, Just _) -> return False where doVerify =- prepareCertificateVerifySignatureData ctx usedVersion sigAlgExpected hashSigAlg msgs >>=+ prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs >>= signatureVerifyWithCertVerifyData ctx digSig createCertificateVerify :: Context -> Version- -> DigitalSignatureAlg+ -> PubKey -> Maybe HashAndSignatureAlgorithm -- TLS12 only -> ByteString -> IO DigitallySigned-createCertificateVerify ctx usedVersion sigAlg hashSigAlg msgs =- prepareCertificateVerifySignatureData ctx usedVersion sigAlg hashSigAlg msgs >>=+createCertificateVerify ctx usedVersion pubKey hashSigAlg msgs =+ prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs >>= signatureCreateWithCertVerifyData ctx hashSigAlg type CertVerifyData = (SignatureParams, ByteString)@@ -147,25 +143,25 @@ prepareCertificateVerifySignatureData :: Context -> Version- -> DigitalSignatureAlg+ -> PubKey -> Maybe HashAndSignatureAlgorithm -- TLS12 only -> ByteString -> IO CertVerifyData-prepareCertificateVerifySignatureData ctx usedVersion sigAlg hashSigAlg msgs+prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs | usedVersion == SSL3 = do (hashCtx, params, generateCV_SSL) <-- case sigAlg of- DS_RSA -> return (hashInit SHA1_MD5, RSAParams SHA1_MD5 RSApkcs1, generateCertificateVerify_SSL)- DS_DSS -> return (hashInit SHA1, DSSParams, generateCertificateVerify_SSL_DSS)- _ -> throwCore $ Error_Misc ("unsupported CertificateVerify signature for SSL3: " ++ show sigAlg)+ case pubKey of+ PubKeyRSA _ -> return (hashInit SHA1_MD5, RSAParams SHA1_MD5 RSApkcs1, generateCertificateVerify_SSL)+ PubKeyDSA _ -> return (hashInit SHA1, DSSParams, generateCertificateVerify_SSL_DSS)+ _ -> throwCore $ Error_Misc ("unsupported CertificateVerify signature for SSL3: " ++ pubkeyType pubKey) Just masterSecret <- usingHState ctx $ gets hstMasterSecret return (params, generateCV_SSL masterSecret $ hashUpdate hashCtx msgs) | usedVersion == TLS10 || usedVersion == TLS11 =- return $ buildVerifyData (signatureParams sigAlg Nothing) msgs- | otherwise = return (signatureParams sigAlg hashSigAlg, msgs)+ return $ buildVerifyData (signatureParams pubKey Nothing) msgs+ | otherwise = return (signatureParams pubKey hashSigAlg, msgs) -signatureParams :: DigitalSignatureAlg -> Maybe HashAndSignatureAlgorithm -> SignatureParams-signatureParams DS_RSA hashSigAlg =+signatureParams :: PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams+signatureParams (PubKeyRSA _) hashSigAlg = case hashSigAlg of Just (HashSHA512, SignatureRSA) -> RSAParams SHA512 RSApkcs1 Just (HashSHA384, SignatureRSA) -> RSAParams SHA384 RSApkcs1@@ -177,13 +173,13 @@ Nothing -> RSAParams SHA1_MD5 RSApkcs1 Just (hsh , SignatureRSA) -> error ("unimplemented RSA signature hash type: " ++ show hsh) Just (_ , sigAlg) -> error ("signature algorithm is incompatible with RSA: " ++ show sigAlg)-signatureParams DS_DSS hashSigAlg =+signatureParams (PubKeyDSA _) hashSigAlg = case hashSigAlg of Nothing -> DSSParams Just (HashSHA1, SignatureDSS) -> DSSParams Just (_ , SignatureDSS) -> error "invalid DSA hash choice, only SHA1 allowed" Just (_ , sigAlg) -> error ("signature algorithm is incompatible with DSS: " ++ show sigAlg)-signatureParams DS_ECDSA hashSigAlg =+signatureParams (PubKeyEC _) hashSigAlg = case hashSigAlg of Just (HashSHA512, SignatureECDSA) -> ECDSAParams SHA512 Just (HashSHA384, SignatureECDSA) -> ECDSAParams SHA384@@ -192,18 +188,19 @@ Nothing -> ECDSAParams SHA1 Just (hsh , SignatureECDSA) -> error ("unimplemented ECDSA signature hash type: " ++ show hsh) Just (_ , sigAlg) -> error ("signature algorithm is incompatible with ECDSA: " ++ show sigAlg)-signatureParams DS_Ed25519 hashSigAlg =+signatureParams (PubKeyEd25519 _) hashSigAlg = case hashSigAlg of Nothing -> Ed25519Params Just (HashIntrinsic , SignatureEd25519) -> Ed25519Params Just (hsh , SignatureEd25519) -> error ("unimplemented Ed25519 signature hash type: " ++ show hsh) Just (_ , sigAlg) -> error ("signature algorithm is incompatible with Ed25519: " ++ show sigAlg)-signatureParams DS_Ed448 hashSigAlg =+signatureParams (PubKeyEd448 _) hashSigAlg = case hashSigAlg of Nothing -> Ed448Params Just (HashIntrinsic , SignatureEd448) -> Ed448Params Just (hsh , SignatureEd448) -> error ("unimplemented Ed448 signature hash type: " ++ show hsh) Just (_ , sigAlg) -> error ("signature algorithm is incompatible with Ed448: " ++ show sigAlg)+signatureParams pk _ = error ("signatureParams: " ++ pubkeyType pk ++ " is not supported") signatureCreateWithCertVerifyData :: Context -> Maybe HashAndSignatureAlgorithm@@ -213,15 +210,15 @@ cc <- usingState_ ctx isClientContext DigitallySigned malg <$> signPrivate ctx cc sigParam toSign -signatureVerify :: Context -> DigitallySigned -> DigitalSignatureAlg -> ByteString -> IO Bool-signatureVerify ctx digSig@(DigitallySigned hashSigAlg _) sigAlgExpected toVerifyData = do+signatureVerify :: Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool+signatureVerify ctx digSig@(DigitallySigned hashSigAlg _) pubKey toVerifyData = do usedVersion <- usingState_ ctx getVersion let (sigParam, toVerify) = case (usedVersion, hashSigAlg) of (TLS12, Nothing) -> error "expecting hash and signature algorithm in a TLS12 digitally signed structure"- (TLS12, Just hs) | sigAlgExpected `signatureCompatible` hs -> (signatureParams sigAlgExpected hashSigAlg, toVerifyData)- | otherwise -> error "expecting different signature algorithm"- (_, Nothing) -> buildVerifyData (signatureParams sigAlgExpected Nothing) toVerifyData+ (TLS12, Just hs) | pubKey `signatureCompatible` hs -> (signatureParams pubKey hashSigAlg, toVerifyData)+ | otherwise -> error "expecting different signature algorithm"+ (_, Nothing) -> buildVerifyData (signatureParams pubKey Nothing) toVerifyData (_, Just _) -> error "not expecting hash and signature algorithm in a < TLS12 digitially signed structure" signatureVerifyWithCertVerifyData ctx digSig (sigParam, toVerify) @@ -233,46 +230,46 @@ checkSupportedHashSignature ctx hs verifyPublic ctx sigParam toVerify bs -digitallySignParams :: Context -> ByteString -> DigitalSignatureAlg -> Maybe HashAndSignatureAlgorithm -> IO DigitallySigned-digitallySignParams ctx signatureData sigAlg hashSigAlg =- let sigParam = signatureParams sigAlg hashSigAlg+digitallySignParams :: Context -> ByteString -> PubKey -> Maybe HashAndSignatureAlgorithm -> IO DigitallySigned+digitallySignParams ctx signatureData pubKey hashSigAlg =+ let sigParam = signatureParams pubKey hashSigAlg in signatureCreateWithCertVerifyData ctx hashSigAlg (buildVerifyData sigParam signatureData) digitallySignDHParams :: Context -> ServerDHParams- -> DigitalSignatureAlg+ -> PubKey -> Maybe HashAndSignatureAlgorithm -- TLS12 only -> IO DigitallySigned-digitallySignDHParams ctx serverParams sigAlg mhash = do+digitallySignDHParams ctx serverParams pubKey mhash = do dhParamsData <- withClientAndServerRandom ctx $ encodeSignedDHParams serverParams- digitallySignParams ctx dhParamsData sigAlg mhash+ digitallySignParams ctx dhParamsData pubKey mhash digitallySignECDHParams :: Context -> ServerECDHParams- -> DigitalSignatureAlg+ -> PubKey -> Maybe HashAndSignatureAlgorithm -- TLS12 only -> IO DigitallySigned-digitallySignECDHParams ctx serverParams sigAlg mhash = do+digitallySignECDHParams ctx serverParams pubKey mhash = do ecdhParamsData <- withClientAndServerRandom ctx $ encodeSignedECDHParams serverParams- digitallySignParams ctx ecdhParamsData sigAlg mhash+ digitallySignParams ctx ecdhParamsData pubKey mhash digitallySignDHParamsVerify :: Context -> ServerDHParams- -> DigitalSignatureAlg+ -> PubKey -> DigitallySigned -> IO Bool-digitallySignDHParamsVerify ctx dhparams sigAlg signature = do+digitallySignDHParamsVerify ctx dhparams pubKey signature = do expectedData <- withClientAndServerRandom ctx $ encodeSignedDHParams dhparams- signatureVerify ctx signature sigAlg expectedData+ signatureVerify ctx signature pubKey expectedData digitallySignECDHParamsVerify :: Context -> ServerECDHParams- -> DigitalSignatureAlg+ -> PubKey -> DigitallySigned -> IO Bool-digitallySignECDHParamsVerify ctx dhparams sigAlg signature = do+digitallySignECDHParamsVerify ctx dhparams pubKey signature = do expectedData <- withClientAndServerRandom ctx $ encodeSignedECDHParams dhparams- signatureVerify ctx signature sigAlg expectedData+ signatureVerify ctx signature pubKey expectedData withClientAndServerRandom :: Context -> (ClientRandom -> ServerRandom -> b) -> IO b withClientAndServerRandom ctx f = do
Network/TLS/Handshake/State.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -- | -- Module : Network.TLS.Handshake.State@@ -14,7 +15,6 @@ , HandshakeDigest(..) , HandshakeMode13(..) , RTT0Status(..)- , Secret13(..) , CertReqCBdata , HandshakeM , newEmptyHandshake@@ -64,8 +64,10 @@ , getTLS13HandshakeMode , setTLS13RTT0Status , getTLS13RTT0Status- , setTLS13Secret- , getTLS13Secret+ , setTLS13EarlySecret+ , getTLS13EarlySecret+ , setTLS13ResumptionSecret+ , getTLS13ResumptionSecret , setCCS13Sent , getCCS13Sent ) where@@ -83,11 +85,6 @@ import Data.X509 (CertificateChain) import Data.ByteArray (ByteArrayAccess) -data Secret13 = NoSecret- | EarlySecret ByteString- | ResuptionSecret ByteString- deriving (Eq, Show)- data HandshakeKeyState = HandshakeKeyState { hksRemotePublicKey :: !(Maybe PubKey) , hksLocalPublicPrivateKeys :: !(Maybe (PubKey, PrivKey))@@ -131,7 +128,8 @@ , hstNegotiatedGroup :: Maybe Group , hstTLS13HandshakeMode :: HandshakeMode13 , hstTLS13RTT0Status :: !RTT0Status- , hstTLS13Secret :: Secret13+ , hstTLS13EarlySecret :: Maybe (BaseSecret EarlySecret)+ , hstTLS13ResumptionSecret :: Maybe (BaseSecret ResumptionSecret) , hstCCS13Sent :: !Bool } deriving (Show) @@ -220,7 +218,8 @@ , hstNegotiatedGroup = Nothing , hstTLS13HandshakeMode = FullHandshake , hstTLS13RTT0Status = RTT0None- , hstTLS13Secret = NoSecret+ , hstTLS13EarlySecret = Nothing+ , hstTLS13ResumptionSecret = Nothing , hstCCS13Sent = False } @@ -301,11 +300,17 @@ getTLS13RTT0Status :: HandshakeM RTT0Status getTLS13RTT0Status = gets hstTLS13RTT0Status -setTLS13Secret :: Secret13 -> HandshakeM ()-setTLS13Secret secret = modify (\hst -> hst { hstTLS13Secret = secret })+setTLS13EarlySecret :: BaseSecret EarlySecret -> HandshakeM ()+setTLS13EarlySecret secret = modify (\hst -> hst { hstTLS13EarlySecret = Just secret }) -getTLS13Secret :: HandshakeM Secret13-getTLS13Secret = gets hstTLS13Secret+getTLS13EarlySecret :: HandshakeM (Maybe (BaseSecret EarlySecret))+getTLS13EarlySecret = gets hstTLS13EarlySecret++setTLS13ResumptionSecret :: BaseSecret ResumptionSecret -> HandshakeM ()+setTLS13ResumptionSecret secret = modify (\hst -> hst { hstTLS13ResumptionSecret = Just secret })++getTLS13ResumptionSecret :: HandshakeM (Maybe (BaseSecret ResumptionSecret))+getTLS13ResumptionSecret = gets hstTLS13ResumptionSecret setCCS13Sent :: Bool -> HandshakeM () setCCS13Sent sent = modify (\hst -> hst { hstCCS13Sent = sent })
Network/TLS/Packet.hs view
@@ -59,9 +59,13 @@ , putSignatureHashAlgorithm , getBinaryVersion , putBinaryVersion+ , getClientRandom32+ , putClientRandom32+ , getServerRandom32 , putServerRandom32- , putExtension , getExtensions+ , putExtension+ , getSession , putSession , putDNames , getDNames
Network/TLS/Packet13.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-} -- | -- Module : Network.TLS.Packet13@@ -14,6 +15,7 @@ , getHandshakeType13 , decodeHandshakeRecord13 , decodeHandshake13+ , decodeHandshakes13 ) where import qualified Data.ByteString as B@@ -23,6 +25,7 @@ import Network.TLS.Wire import Network.TLS.Imports import Data.X509 (CertificateChainRaw(..), encodeCertificateChain, decodeCertificateChain)+import Network.TLS.ErrT encodeHandshakes13 :: [Handshake13] -> ByteString encodeHandshakes13 hss = B.concat $ map encodeHandshake13 hss@@ -41,6 +44,13 @@ putExtensions es = putOpaque16 (runPut $ mapM_ putExtension es) encodeHandshake13' :: Handshake13 -> ByteString+encodeHandshake13' (ClientHello13 version random session cipherIDs exts) = runPut $ do+ putBinaryVersion version+ putClientRandom32 random+ putSession session+ putWords16 cipherIDs+ putWords8 [0]+ putExtensions exts encodeHandshake13' (ServerHello13 random session cipherId exts) = runPut $ do putBinaryVersion TLS12 putServerRandom32 random@@ -74,13 +84,21 @@ encodeHandshake13' (KeyUpdate13 UpdateNotRequested) = runPut $ putWord8 0 encodeHandshake13' (KeyUpdate13 UpdateRequested) = runPut $ putWord8 1 -encodeHandshake13' _ = error "encodeHandshake13'"- encodeHandshakeHeader13 :: HandshakeType13 -> Int -> ByteString encodeHandshakeHeader13 ty len = runPut $ do putWord8 (valOfType ty) putWord24 len +decodeHandshakes13 :: MonadError TLSError m => ByteString -> m [Handshake13]+decodeHandshakes13 bs = case decodeHandshakeRecord13 bs of+ GotError err -> throwError err+ GotPartial _cont -> error "decodeHandshakes13"+ GotSuccess (ty,content) -> case decodeHandshake13 ty content of+ Left e -> throwError e+ Right h -> return [h]+ GotSuccessRemaining (ty,content) left -> case decodeHandshake13 ty content of+ Left e -> throwError e+ Right h -> (h:) <$> decodeHandshakes13 left {- decode and encode HANDSHAKE -} getHandshakeType13 :: Get HandshakeType13@@ -98,6 +116,8 @@ decodeHandshake13 :: HandshakeType13 -> ByteString -> Either TLSError Handshake13 decodeHandshake13 ty = runGetErr ("handshake[" ++ show ty ++ "]") $ case ty of+ HandshakeType_ClientHello13 -> decodeClientHello13+ HandshakeType_ServerHello13 -> decodeServerHello13 HandshakeType_Finished13 -> decodeFinished13 HandshakeType_EncryptedExtensions13 -> decodeEncryptedExtensions13 HandshakeType_CertRequest13 -> decodeCertRequest13@@ -106,7 +126,26 @@ HandshakeType_NewSessionTicket13 -> decodeNewSessionTicket13 HandshakeType_EndOfEarlyData13 -> return EndOfEarlyData13 HandshakeType_KeyUpdate13 -> decodeKeyUpdate13- _fixme -> error $ "decodeHandshake13 " ++ show _fixme++decodeClientHello13 :: Get Handshake13+decodeClientHello13 = do+ Just ver <- getBinaryVersion+ random <- getClientRandom32+ session <- getSession+ ciphers <- getWords16+ _comp <- getWords8+ exts <- fromIntegral <$> getWord16 >>= getExtensions+ return $ ClientHello13 ver random session ciphers exts++decodeServerHello13 :: Get Handshake13+decodeServerHello13 = do+ Just _ver <- getBinaryVersion+ random <- getServerRandom32+ session <- getSession+ cipherid <- getWord16+ _comp <- getWord8+ exts <- fromIntegral <$> getWord16 >>= getExtensions+ return $ ServerHello13 random session cipherid exts decodeFinished13 :: Get Handshake13 decodeFinished13 = Finished13 <$> (remaining >>= getBytes)
Network/TLS/Parameters.hs view
@@ -239,7 +239,7 @@ defaultSupported :: Supported defaultSupported = Supported- { supportedVersions = [TLS12,TLS11,TLS10]+ { supportedVersions = [TLS13,TLS12,TLS11,TLS10] , supportedCiphers = [] , supportedCompressions = [nullCompression] , supportedHashSignatures = [ (HashIntrinsic, SignatureEd448)
Network/TLS/Struct.hs view
@@ -214,7 +214,47 @@ deriving (Eq) instance Show ExtensionRaw where- show (ExtensionRaw eid bs) = "ExtensionRaw " ++ show eid ++ " " ++ showBytesHex bs ++ ""+ show (ExtensionRaw eid bs) = "ExtensionRaw " ++ showEID eid ++ " " ++ showBytesHex bs++showEID :: ExtensionID -> String+showEID 0x0 = "ServerName"+showEID 0x1 = "MaxFragmentLength"+showEID 0x2 = "ClientCertificateUrl"+showEID 0x3 = "TrustedCAKeys"+showEID 0x4 = "TruncatedHMAC"+showEID 0x5 = "StatusRequest"+showEID 0x6 = "UserMapping"+showEID 0x7 = "ClientAuthz"+showEID 0x8 = "ServerAuthz"+showEID 0x9 = "CertType"+showEID 0xa = "NegotiatedGroups"+showEID 0xb = "EcPointFormats"+showEID 0xc = "SRP"+showEID 0xd = "SignatureAlgorithm"+showEID 0xe = "SRTP"+showEID 0xf = "Heartbeat"+showEID 0x10 = "ApplicationLayerProtocolNegotiation"+showEID 0x11 = "StatusRequestv2"+showEID 0x12 = "SignedCertificateTimestamp"+showEID 0x13 = "ClientCertificateType"+showEID 0x14 = "ServerCertificateType"+showEID 0x15 = "Padding"+showEID 0x16 = "EncryptThenMAC"+showEID 0x17 = "ExtendedMasterSecret"+showEID 0x23 = "SessionTicket"+showEID 0x29 = "PreShardeKey"+showEID 0x2a = "EarlyData"+showEID 0x2b = "SupportedVersions"+showEID 0x2c = "Cookie"+showEID 0x2d = "PskKeyExchangeModes"+showEID 0x2f = "CertificateAuthorities"+showEID 0x30 = "OidFilters"+showEID 0x31 = "PostHandshakeAuth"+showEID 0x32 = "SignatureAlgorithmsCert"+showEID 0x33 = "KeyShare"+showEID 0xff01 = "SecureRenegotiation"+showEID 0xffa5 = "QuicTransportParameters"+showEID x = show x data AlertLevel = AlertLevel_Warning
Network/TLS/Types.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE EmptyDataDecls #-} -- | -- Module : Network.TLS.Types -- License : BSD-style@@ -19,6 +20,16 @@ , HostName , Second , Millisecond+ , EarlySecret+ , HandshakeSecret+ , ApplicationSecret+ , ResumptionSecret+ , BaseSecret(..)+ , ClientTrafficSecret(..)+ , ServerTrafficSecret(..)+ , SecretTriple(..)+ , SecretPair(..)+ , MasterSecret(..) ) where import Network.TLS.Imports@@ -76,3 +87,26 @@ invertRole :: Role -> Role invertRole ClientRole = ServerRole invertRole ServerRole = ClientRole++data EarlySecret+data HandshakeSecret+data ApplicationSecret+data ResumptionSecret++newtype BaseSecret a = BaseSecret ByteString deriving Show+newtype ClientTrafficSecret a = ClientTrafficSecret ByteString deriving Show+newtype ServerTrafficSecret a = ServerTrafficSecret ByteString deriving Show++data SecretTriple a = SecretTriple+ { triBase :: BaseSecret a+ , triClient :: ClientTrafficSecret a+ , triServer :: ServerTrafficSecret a+ }++data SecretPair a = SecretPair+ { pairBase :: BaseSecret a+ , pairClient :: ClientTrafficSecret a+ }++-- Master secret for TLS 1.2 or earlier.+newtype MasterSecret = MasterSecret ByteString deriving Show
Network/TLS/X509.hs view
@@ -23,6 +23,7 @@ , FailedReason , ServiceID , wrapCertificateChecks+ , pubkeyType ) where import Data.X509@@ -60,3 +61,6 @@ | SelfSigned `elem` l = CertificateUsageReject CertificateRejectUnknownCA | EmptyChain `elem` l = CertificateUsageReject CertificateRejectAbsent | otherwise = CertificateUsageReject $ CertificateRejectOther (show l)++pubkeyType :: PubKey -> String+pubkeyType = show . pubkeyToAlg
Tests/Marshalling.hs view
@@ -133,7 +133,17 @@ instance Arbitrary Handshake13 where arbitrary = oneof- [ NewSessionTicket13+ [ arbitrary >>= \ver -> ClientHello13 ver+ <$> arbitrary+ <*> arbitrary+ <*> arbitraryCiphersIDs+ <*> arbitraryHelloExtensions ver+ , arbitrary >>= \ver -> ServerHello13+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitraryHelloExtensions ver+ , NewSessionTicket13 <$> arbitrary <*> arbitrary <*> genByteString 32 -- nonce
tls.cabal view
@@ -1,5 +1,5 @@ Name: tls-Version: 1.5.1+Version: 1.5.2 Description: Native Haskell TLS and SSL protocol implementation for server and client. .