tls 1.3.4 → 1.3.5
raw patch · 13 files changed
+101/−46 lines, 13 filesdep ~asyncdep ~criteriondep ~cryptonite
Dependency ranges changed: async, criterion, cryptonite, memory, mtl
Files
- Benchmarks/Benchmarks.hs +1/−1
- CHANGELOG.md +14/−0
- Network/TLS.hs +1/−0
- Network/TLS/Context.hs +10/−2
- Network/TLS/Crypto/DH.hs +8/−11
- Network/TLS/Crypto/ECDH.hs +4/−8
- Network/TLS/Extra/Cipher.hs +6/−6
- Network/TLS/Handshake/Server.hs +1/−1
- Network/TLS/Handshake/State.hs +5/−3
- Network/TLS/Packet.hs +8/−6
- Network/TLS/Parameters.hs +31/−2
- Network/TLS/RNG.hs +7/−2
- tls.cabal +5/−4
Benchmarks/Benchmarks.hs view
@@ -35,7 +35,7 @@ } (pubKey, privKey) = getGlobalRSAPair -runTLSPipe params tlsServer tlsClient d name = bench name $ do+runTLSPipe params tlsServer tlsClient d name = bench name . nfIO $ do (startQueue, resultQueue) <- establishDataPipe params tlsServer tlsClient writeChan startQueue d readChan resultQueue
CHANGELOG.md view
@@ -1,3 +1,17 @@+## Version 1.3.5++- Fix a bug with ECDHE based cipher where serialization+- Debugging: Add a way to print random seed and a way to side-load a seed for replayability+- Improve tests++## Version 1.3.4++- Fix tests on 32 bits `time_t` machines (time not within bound)+- VirtualHost: Add a way to load credentials related to the hostname used by the client (Julian Beaumont)+- VirtualHost: Expose an API to query which hostname the client has contacted (Julian Beaumont)+- Add a way to disable empty packet that are use for security when+ using old versions + old CBC based cipher (Anton Dessiatov)+ ## Version 1.3.3 - Add support for Hans (Haskell Network Stack) (Adam Wick)
Network/TLS.hs view
@@ -11,6 +11,7 @@ -- * Context configuration ClientParams(..) , ServerParams(..)+ , DebugParams(..) , ClientHooks(..) , ServerHooks(..) , Supported(..)
Network/TLS/Context.hs view
@@ -98,6 +98,7 @@ instance TLSParams ClientParams where getTLSCommonParams cparams = ( clientSupported cparams , clientShared cparams+ , clientDebug cparams ) getTLSRole _ = ClientRole getCiphers cparams = supportedCiphers $ clientSupported cparams@@ -107,6 +108,7 @@ instance TLSParams ServerParams where getTLSCommonParams sparams = ( serverSupported sparams , serverShared sparams+ , serverDebug sparams ) getTLSRole _ = ServerRole -- on the server we filter our allowed ciphers here according@@ -144,11 +146,17 @@ contextNew backend params = liftIO $ do initializeBackend backend - rng <- newStateRNG+ let (supported, shared, debug) = getTLSCommonParams params + seed <- case debugSeed debug of+ Nothing -> do seed <- seedNew+ debugPrintSeed debug $ seed+ return seed+ Just determ -> return determ+ let rng = newStateRNG seed+ let role = getTLSRole params st = newTLSState rng role- (supported, shared) = getTLSCommonParams params ciphers = getCiphers params when (null ciphers) $ error "no ciphers available with those parameters"
Network/TLS/Crypto/DH.hs view
@@ -17,15 +17,14 @@ , dhUnwrapPublic ) where -import Network.TLS.Util.Serialization (i2osp) import qualified Crypto.PubKey.DH as DH-import Network.TLS.RNG-import Data.ByteString (ByteString)+import Crypto.Number.Basic (numBits)+import Network.TLS.RNG type DHPublic = DH.PublicNumber type DHPrivate = DH.PrivateNumber type DHParams = DH.Params-type DHKey = ByteString+type DHKey = DH.SharedKey dhPublic :: Integer -> DHPublic dhPublic = DH.PublicNumber@@ -34,7 +33,7 @@ dhPrivate = DH.PrivateNumber dhParams :: Integer -> Integer -> DHParams-dhParams = DH.Params+dhParams p g = DH.Params p g (numBits p) dhGenerateKeyPair :: MonadRandom r => DHParams -> r (DHPrivate, DHPublic) dhGenerateKeyPair params = do@@ -43,18 +42,16 @@ return (priv, pub) dhGetShared :: DHParams -> DHPrivate -> DHPublic -> DHKey-dhGetShared params priv pub =- let (DH.SharedKey sk) = DH.getShared params priv pub- in i2osp sk+dhGetShared params priv pub = DH.getShared params priv pub dhUnwrap :: DHParams -> DHPublic -> [Integer]-dhUnwrap (DH.Params p g) (DH.PublicNumber y) = [p,g,y]+dhUnwrap (DH.Params p g _) (DH.PublicNumber y) = [p,g,y] dhParamsGetP :: DHParams -> Integer-dhParamsGetP (DH.Params p _) = p+dhParamsGetP (DH.Params p _ _) = p dhParamsGetG :: DHParams -> Integer-dhParamsGetG (DH.Params _ g) = g+dhParamsGetG (DH.Params _ g _) = g dhUnwrapPublic :: DHPublic -> Integer dhUnwrapPublic (DH.PublicNumber y) = y
Network/TLS/Crypto/ECDH.hs view
@@ -15,13 +15,12 @@ , ecdhUnwrapPublic ) where -import Network.TLS.Util.Serialization (i2osp, lengthBytes)+import Network.TLS.Util.Serialization (lengthBytes) import Network.TLS.Extension.EC import qualified Crypto.PubKey.ECC.DH as ECDH import qualified Crypto.PubKey.ECC.Types as ECDH import qualified Crypto.PubKey.ECC.Prim as ECC (isPointValid) import Network.TLS.RNG-import Data.ByteString (ByteString) import Data.Word (Word16) data ECDHPublic = ECDHPublic ECDH.PublicPoint Int {- byte size -}@@ -31,7 +30,7 @@ data ECDHParams = ECDHParams ECDH.Curve ECDH.CurveName deriving (Show,Eq) -type ECDHKey = ByteString+type ECDHKey = ECDH.SharedKey ecdhPublic :: Integer -> Integer -> Int -> ECDHPublic ecdhPublic x y siz = ECDHPublic (ECDH.Point x y) siz@@ -55,11 +54,8 @@ ecdhGetShared :: ECDHParams -> ECDHPrivate -> ECDHPublic -> Maybe ECDHKey ecdhGetShared (ECDHParams curve _) (ECDHPrivate priv) (ECDHPublic point _)- | ECC.isPointValid curve point =- let ECDH.SharedKey sk = ECDH.getShared curve priv point- in Just $ i2osp sk- | otherwise =- Nothing+ | ECC.isPointValid curve point = Just $ ECDH.getShared curve priv point+ | otherwise = Nothing -- for server key exchange ecdhUnwrap :: ECDHParams -> ECDHPublic -> (Word16,Integer,Integer,Int)
Network/TLS/Extra/Cipher.hs view
@@ -98,10 +98,10 @@ tripledes_ede :: BulkDirection -> BulkKey -> BulkBlock tripledes_ede BulkEncrypt key = let ctx = noFail $ cipherInit key- in (\iv input -> let output = cbcEncrypt ctx (tripledes_iv iv) input in (output, takelast 16 output))+ in (\iv input -> let output = cbcEncrypt ctx (tripledes_iv iv) input in (output, takelast 8 output)) tripledes_ede BulkDecrypt key = let ctx = noFail $ cipherInit key- in (\iv input -> let output = cbcDecrypt ctx (tripledes_iv iv) input in (output, takelast 16 input))+ in (\iv input -> let output = cbcDecrypt ctx (tripledes_iv iv) input in (output, takelast 8 input)) tripledes_iv :: BulkIV -> IV DES_EDE3 tripledes_iv iv = maybe (error "tripledes cipher iv internal error") id $ makeIV iv@@ -262,7 +262,7 @@ cipher_AES128_SHA1 :: Cipher cipher_AES128_SHA1 = Cipher { cipherID = 0x2f- , cipherName = "RSA-aes128-sha1"+ , cipherName = "RSA-AES128-SHA1" , cipherBulk = bulk_aes128 , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA@@ -273,7 +273,7 @@ cipher_AES256_SHA1 :: Cipher cipher_AES256_SHA1 = Cipher { cipherID = 0x35- , cipherName = "RSA-aes256-sha1"+ , cipherName = "RSA-AES256-SHA1" , cipherBulk = bulk_aes256 , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA@@ -284,7 +284,7 @@ cipher_AES128_SHA256 :: Cipher cipher_AES128_SHA256 = Cipher { cipherID = 0x3c- , cipherName = "RSA-aes128-sha256"+ , cipherName = "RSA-AES128-SHA256" , cipherBulk = bulk_aes128 , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_RSA@@ -295,7 +295,7 @@ cipher_AES256_SHA256 :: Cipher cipher_AES256_SHA256 = Cipher { cipherID = 0x3d- , cipherName = "RSA-aes256-sha256"+ , cipherName = "RSA-AES256-SHA256" , cipherBulk = bulk_aes256 , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_RSA
Network/TLS/Handshake/Server.hs view
@@ -327,7 +327,7 @@ signed <- digitallySignECDHParams ctx serverParams sigAlg case sigAlg of SignatureRSA -> return $ SKX_ECDHE_RSA serverParams signed- _ -> error ("generate skx_dhe unsupported signature type: " ++ show sigAlg)+ _ -> error ("generate skx_ecdhe unsupported signature type: " ++ show sigAlg) -- create a DigitallySigned objects for DHParams or ECDHParams.
Network/TLS/Handshake/State.hs view
@@ -54,6 +54,7 @@ import Control.Applicative (Applicative, (<$>)) import Control.Monad.State import Data.X509 (CertificateChain)+import Data.ByteArray (ByteArrayAccess) data HandshakeKeyState = HandshakeKeyState { hksRemotePublicKey :: !(Maybe PubKey)@@ -194,9 +195,10 @@ | otherwise = generateServerFinished -- | Generate the master secret from the pre master secret.-setMasterSecretFromPre :: Version -- ^ chosen transmission version- -> Role -- ^ the role (Client or Server) of the generating side- -> Bytes -- ^ the pre master secret+setMasterSecretFromPre :: ByteArrayAccess preMaster+ => Version -- ^ chosen transmission version+ -> Role -- ^ the role (Client or Server) of the generating side+ -> preMaster -- ^ the pre master secret -> HandshakeM () setMasterSecretFromPre ver role premasterSecret = do secret <- genSecret <$> get
Network/TLS/Packet.hs view
@@ -76,6 +76,8 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC+import Data.ByteArray (ByteArrayAccess)+import qualified Data.ByteArray as B (convert) data CurrentParams = CurrentParams { cParamsVersion :: Version -- ^ current protocol version@@ -579,18 +581,18 @@ -} type PRF = Bytes -> Bytes -> Int -> Bytes -generateMasterSecret_SSL :: Bytes -> ClientRandom -> ServerRandom -> Bytes+generateMasterSecret_SSL :: ByteArrayAccess preMaster => preMaster -> ClientRandom -> ServerRandom -> Bytes generateMasterSecret_SSL premasterSecret (ClientRandom c) (ServerRandom s) = B.concat $ map (computeMD5) ["A","BB","CCC"]- where computeMD5 label = hash MD5 $ B.concat [ premasterSecret, computeSHA1 label ]- computeSHA1 label = hash SHA1 $ B.concat [ label, premasterSecret, c, s ]+ where computeMD5 label = hash MD5 $ B.concat [ B.convert premasterSecret, computeSHA1 label ]+ computeSHA1 label = hash SHA1 $ B.concat [ label, B.convert premasterSecret, c, s ] -generateMasterSecret_TLS :: PRF -> Bytes -> ClientRandom -> ServerRandom -> Bytes+generateMasterSecret_TLS :: ByteArrayAccess preMaster => PRF -> preMaster -> ClientRandom -> ServerRandom -> Bytes generateMasterSecret_TLS prf premasterSecret (ClientRandom c) (ServerRandom s) =- prf premasterSecret seed 48+ prf (B.convert premasterSecret) seed 48 where seed = B.concat [ "master secret", c, s ] -generateMasterSecret :: Version -> Bytes -> ClientRandom -> ServerRandom -> Bytes+generateMasterSecret :: ByteArrayAccess preMaster => Version -> preMaster -> ClientRandom -> ServerRandom -> Bytes generateMasterSecret SSL2 = generateMasterSecret_SSL generateMasterSecret SSL3 = generateMasterSecret_SSL generateMasterSecret TLS10 = generateMasterSecret_TLS prf_MD5SHA1
Network/TLS/Parameters.hs view
@@ -10,6 +10,7 @@ ClientParams(..) , ServerParams(..) , CommonParams+ , DebugParams(..) , ClientHooks(..) , ServerHooks(..) , Supported(..)@@ -32,14 +33,38 @@ import Network.TLS.Crypto import Network.TLS.Credentials import Network.TLS.X509+import Network.TLS.RNG (Seed) import Data.Monoid import Data.Default.Class import qualified Data.ByteString as B type HostName = String -type CommonParams = (Supported, Shared)+type CommonParams = (Supported, Shared, DebugParams) +-- | All settings should not be used in production+data DebugParams = DebugParams+ {+ -- | Disable the true randomness in favor of deterministic seed that will produce+ -- a deterministic random from. This is useful for tests and debugging purpose.+ -- Do not use in production+ debugSeed :: Maybe Seed+ -- | Add a way to print the seed that was randomly generated. re-using the same seed+ -- will reproduce the same randomness with 'debugSeed'+ , debugPrintSeed :: Seed -> IO ()+ }++defaultDebugParams :: DebugParams+defaultDebugParams = DebugParams+ { debugSeed = Nothing+ , debugPrintSeed = const (return ())+ }++instance Show DebugParams where+ show _ = "DebugParams"+instance Default DebugParams where+ def = defaultDebugParams+ data ClientParams = ClientParams { clientUseMaxFragmentLength :: Maybe MaxFragmentEnum -- | Define the name of the server, along with an extra service identification blob.@@ -60,6 +85,7 @@ , clientShared :: Shared , clientHooks :: ClientHooks , clientSupported :: Supported+ , clientDebug :: DebugParams } deriving (Show) defaultParamsClient :: HostName -> Bytes -> ClientParams@@ -71,6 +97,7 @@ , clientShared = def , clientHooks = def , clientSupported = def+ , clientDebug = defaultDebugParams } data ServerParams = ServerParams@@ -89,6 +116,7 @@ , serverShared :: Shared , serverHooks :: ServerHooks , serverSupported :: Supported+ , serverDebug :: DebugParams } deriving (Show) defaultParamsServer :: ServerParams@@ -99,6 +127,7 @@ , serverHooks = def , serverShared = def , serverSupported = def+ , serverDebug = defaultDebugParams } instance Default ServerParams where@@ -275,6 +304,6 @@ } instance Show ServerHooks where- show _ = "ClientHooks"+ show _ = "ServerHooks" instance Default ServerHooks where def = defaultServerHooks
Network/TLS/RNG.hs view
@@ -1,12 +1,17 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Network.TLS.RNG ( StateRNG(..)+ , Seed+ , seedNew+ , seedToInteger+ , seedFromInteger , withTLSRNG , newStateRNG , MonadRandom , getRandomBytes ) where +import Crypto.Random.Types import Crypto.Random newtype StateRNG = StateRNG ChaChaDRG@@ -20,5 +25,5 @@ -> (a, StateRNG) withTLSRNG rng f = withDRG rng f -newStateRNG :: MonadRandom randomly => randomly StateRNG-newStateRNG = StateRNG `fmap` drgNew+newStateRNG :: Seed -> StateRNG+newStateRNG seed = StateRNG $ drgNewSeed seed
tls.cabal view
@@ -1,5 +1,5 @@ Name: tls-Version: 1.3.4+Version: 1.3.5 Description: Native Haskell TLS and SSL protocol implementation for server and client. .@@ -28,7 +28,7 @@ CHANGELOG.md Flag compat- Description: Accept SSLv2 compatible handshake+ Description: Accept SSLv2 client hello for beginning SSLv3 / TLS handshake Default: True Flag network@@ -48,7 +48,7 @@ , data-default-class -- crypto related , memory- , cryptonite >= 0.7+ , cryptonite >= 0.14 -- certificate related , asn1-types >= 0.2.0 , asn1-encoding@@ -145,11 +145,12 @@ , x509-validation , data-default-class , cryptonite- , criterion+ , criterion >= 1.0 , mtl , bytestring , hourglass , QuickCheck >= 2+ , tasty-quickcheck source-repository head type: git