Hello community, here is the log from the commit of package ghc-tls for openSUSE:Factory checked in at 2015-06-23 11:59:30 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tls (Old) and /work/SRC/openSUSE:Factory/.ghc-tls.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-tls" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tls/ghc-tls.changes 2015-05-27 12:46:56.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-tls.new/ghc-tls.changes 2015-06-23 11:59:32.000000000 +0200 @@ -1,0 +2,8 @@ +Sun Jun 21 16:56:51 UTC 2015 - mimi...@gmail.com + +- update to 1.2.18 +* add more tests (network, local) +* cleanup cipher / bulk code, certificate verify / creation, and digitall signed handling +* fix handling of DHE ciphers with MS SSL stack that serialize leading zero. + +------------------------------------------------------------------- Old: ---- tls-1.2.17.tar.gz New: ---- tls-1.2.18.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tls.spec ++++++ --- /var/tmp/diff_new_pack.okzjLR/_old 2015-06-23 11:59:32.000000000 +0200 +++ /var/tmp/diff_new_pack.okzjLR/_new 2015-06-23 11:59:32.000000000 +0200 @@ -15,17 +15,18 @@ # Please submit bugfixes or comments via http://bugs.opensuse.org/ # + %global pkg_name tls %bcond_with tests -Name: ghc-%{pkg_name} -Version: 1.2.17 +Name: ghc-tls +Version: 1.2.18 Release: 0 Summary: TLS/SSL protocol native implementation (Server and Client) +License: BSD-3-Clause Group: System/Libraries -License: BSD-3-Clause Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRoot: %{_tmppath}/%{name}-%{version}-build @@ -94,36 +95,28 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check %if %{with tests} %cabal test %endif - %post devel %ghc_pkg_recache - %postun devel %ghc_pkg_recache - %files -f %{name}.files %defattr(-,root,root,-) %doc LICENSE - %files devel -f %{name}-devel.files %defattr(-,root,root,-) - %changelog ++++++ tls-1.2.17.tar.gz -> tls-1.2.18.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/CHANGELOG.md new/tls-1.2.18/CHANGELOG.md --- old/tls-1.2.17/CHANGELOG.md 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/CHANGELOG.md 2015-06-19 15:56:01.000000000 +0200 @@ -1,3 +1,13 @@ +## Version 1.2.18 + +- add more tests (network, local) +- cleanup cipher / bulk code, certificate verify / creation, and digitall signed handling +- fix handling of DHE ciphers with MS SSL stack that serialize leading zero. + +## Version 1.2.17 + +- Fix an issue of type of key / hash that prevented connection with SChannel. + ## Version 1.2.16 - Fix an issue with stream cipher not correctly calculating the internal state, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Cipher.hs new/tls-1.2.18/Network/TLS/Cipher.hs --- old/tls-1.2.17/Network/TLS/Cipher.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Cipher.hs 2015-06-19 15:56:01.000000000 +0200 @@ -8,17 +8,23 @@ -- Portability : unknown -- module Network.TLS.Cipher - ( BulkFunctions(..) - , CipherKeyExchangeType(..) + ( CipherKeyExchangeType(..) , Bulk(..) + , BulkFunctions(..) + , BulkDirection(..) + , BulkState(..) + , BulkStream(..) + , BulkBlock + , BulkAEAD + , bulkInit , Hash(..) , Cipher(..) , CipherID - , Key - , IV - , Nonce - , AdditionalData , cipherKeyBlockSize + , BulkKey + , BulkIV + , BulkNonce + , BulkAdditionalData , cipherAllowedForVersion , cipherExchangeNeedMoreData , hasMAC @@ -28,29 +34,54 @@ import Crypto.Cipher.Types (AuthTag) import Network.TLS.Types (CipherID) import Network.TLS.Struct (Version(..)) +import Network.TLS.Crypto (Hash(..), hashDigestSize) import qualified Data.ByteString as B -- FIXME convert to newtype -type Key = B.ByteString -type IV = B.ByteString -type Nonce = B.ByteString -type AdditionalData = B.ByteString +type BulkKey = B.ByteString +type BulkIV = B.ByteString +type BulkNonce = B.ByteString +type BulkAdditionalData = B.ByteString + +data BulkState = + BulkStateStream BulkStream + | BulkStateBlock BulkBlock + | BulkStateAEAD BulkAEAD + | BulkStateUninitialized + +instance Show BulkState where + show (BulkStateStream _) = "BulkStateStream" + show (BulkStateBlock _) = "BulkStateBlock" + show (BulkStateAEAD _) = "BulkStateAEAD" + show (BulkStateUninitialized) = "BulkStateUninitialized" + +newtype BulkStream = BulkStream (B.ByteString -> (B.ByteString, BulkStream)) + +type BulkBlock = BulkIV -> B.ByteString -> (B.ByteString, BulkIV) + +type BulkAEAD = BulkNonce -> B.ByteString -> BulkAdditionalData -> (B.ByteString, AuthTag) + +data BulkDirection = BulkEncrypt | BulkDecrypt + deriving (Show,Eq) + +bulkInit :: Bulk -> BulkDirection -> BulkKey -> BulkState +bulkInit bulk direction key = + case bulkF bulk of + BulkBlockF ini -> BulkStateBlock (ini direction key) + BulkStreamF ini -> BulkStateStream (ini direction key) + BulkAeadF ini -> BulkStateAEAD (ini direction key) data BulkFunctions = - BulkBlockF (Key -> IV -> B.ByteString -> B.ByteString) - (Key -> IV -> B.ByteString -> B.ByteString) - | BulkStreamF (Key -> IV) - (IV -> B.ByteString -> (B.ByteString, IV)) - (IV -> B.ByteString -> (B.ByteString, IV)) - | BulkAeadF (Key -> Nonce -> B.ByteString -> AdditionalData -> (B.ByteString, AuthTag)) - (Key -> Nonce -> B.ByteString -> AdditionalData -> (B.ByteString, AuthTag)) + BulkBlockF (BulkDirection -> BulkKey -> BulkBlock) + | BulkStreamF (BulkDirection -> BulkKey -> BulkStream) + | BulkAeadF (BulkDirection -> BulkKey -> BulkAEAD) hasMAC,hasRecordIV :: BulkFunctions -> Bool -hasMAC (BulkBlockF _ _) = True -hasMAC (BulkStreamF _ _ _) = True -hasMAC (BulkAeadF _ _ ) = False +hasMAC (BulkBlockF _ ) = True +hasMAC (BulkStreamF _) = True +hasMAC (BulkAeadF _ ) = False hasRecordIV = hasMAC @@ -84,17 +115,6 @@ , bulkBlockSize b1 == bulkBlockSize b2 ] -data Hash = Hash - { hashName :: String - , hashSize :: Int - , hashF :: B.ByteString -> B.ByteString - } - -instance Show Hash where - show hash = hashName hash -instance Eq Hash where - h1 == h2 = hashName h1 == hashName h2 && hashSize h1 == hashSize h2 - -- | Cipher algorithm data Cipher = Cipher { cipherID :: CipherID @@ -106,7 +126,7 @@ } cipherKeyBlockSize :: Cipher -> Int -cipherKeyBlockSize cipher = 2 * (hashSize (cipherHash cipher) + bulkIVSize bulk + bulkKeySize bulk) +cipherKeyBlockSize cipher = 2 * (hashDigestSize (cipherHash cipher) + bulkIVSize bulk + bulkKeySize bulk) where bulk = cipherBulk cipher -- | Check if a specific 'Cipher' is allowed to be used diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Crypto/DH.hs new/tls-1.2.18/Network/TLS/Crypto/DH.hs --- old/tls-1.2.17/Network/TLS/Crypto/DH.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Crypto/DH.hs 2015-06-19 15:56:01.000000000 +0200 @@ -9,6 +9,8 @@ , dhPublic , dhPrivate , dhParams + , dhParamsGetP + , dhParamsGetG , dhGenerateKeyPair , dhGetShared , dhUnwrap @@ -49,5 +51,11 @@ dhUnwrap :: DHParams -> DHPublic -> [Integer] dhUnwrap (DH.Params p g) (DH.PublicNumber y) = [p,g,y] +dhParamsGetP :: DHParams -> Integer +dhParamsGetP (DH.Params p _) = p + +dhParamsGetG :: DHParams -> Integer +dhParamsGetG (DH.Params _ g) = g + dhUnwrapPublic :: DHPublic -> Integer dhUnwrapPublic (DH.PublicNumber y) = y diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Crypto.hs new/tls-1.2.18/Network/TLS/Crypto.hs --- old/tls-1.2.17/Network/TLS/Crypto.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Crypto.hs 2015-06-19 15:56:01.000000000 +0200 @@ -1,7 +1,8 @@ {-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE ExistentialQuantification #-} module Network.TLS.Crypto - ( HashCtx(..) + ( HashContext + , HashCtx , hashInit , hashUpdate , hashUpdateSSL @@ -10,11 +11,12 @@ , module Network.TLS.Crypto.DH , module Network.TLS.Crypto.ECDH - -- * constructor - , hashMD5SHA1 - , hashSHA1 - , hashSHA256 - , hashSHA512 + -- * Hash + , hash + , Hash(..) + , hashName + , hashDigestSize + , hashBlockSize -- * key exchange generic interface , PubKey(..) @@ -29,11 +31,9 @@ , KxError(..) ) where -import qualified Crypto.Hash.SHA512 as SHA512 -import qualified Crypto.Hash.SHA256 as SHA256 -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Hash.MD5 as MD5 +import qualified Crypto.Hash as H import qualified Data.ByteString as B +import qualified Data.Byteable as B import Data.ByteString (ByteString) import Crypto.PubKey.HashDescr import qualified Crypto.PubKey.DSA as DSA @@ -58,76 +58,74 @@ | KxUnsupported deriving (Show) -class HashCtxC a where - hashCName :: a -> String - hashCInit :: a -> a - hashCUpdate :: a -> B.ByteString -> a - hashCUpdateSSL :: a -> (B.ByteString,B.ByteString) -> a - hashCFinal :: a -> B.ByteString - -data HashCtx = forall h . HashCtxC h => HashCtx h - -instance Show HashCtx where - show (HashCtx c) = hashCName c - -{- MD5 & SHA1 joined -} -data HashMD5SHA1 = HashMD5SHA1 SHA1.Ctx MD5.Ctx - -instance HashCtxC HashMD5SHA1 where - hashCName _ = "MD5-SHA1" - hashCInit _ = HashMD5SHA1 SHA1.init MD5.init - hashCUpdate (HashMD5SHA1 sha1ctx md5ctx) b = HashMD5SHA1 (SHA1.update sha1ctx b) (MD5.update md5ctx b) - hashCUpdateSSL (HashMD5SHA1 sha1ctx md5ctx) (b1,b2) = HashMD5SHA1 (SHA1.update sha1ctx b2) (MD5.update md5ctx b1) - hashCFinal (HashMD5SHA1 sha1ctx md5ctx) = B.concat [MD5.finalize md5ctx, SHA1.finalize sha1ctx] - -newtype HashSHA1 = HashSHA1 SHA1.Ctx - -instance HashCtxC HashSHA1 where - hashCName _ = "SHA1" - hashCInit _ = HashSHA1 SHA1.init - hashCUpdate (HashSHA1 ctx) b = HashSHA1 (SHA1.update ctx b) - hashCUpdateSSL (HashSHA1 ctx) (_,b2) = HashSHA1 (SHA1.update ctx b2) - hashCFinal (HashSHA1 ctx) = SHA1.finalize ctx - -newtype HashSHA256 = HashSHA256 SHA256.Ctx - -instance HashCtxC HashSHA256 where - hashCName _ = "SHA256" - hashCInit _ = HashSHA256 SHA256.init - hashCUpdate (HashSHA256 ctx) b = HashSHA256 (SHA256.update ctx b) - hashCUpdateSSL _ _ = error "CUpdateSSL with HashSHA256" - hashCFinal (HashSHA256 ctx) = SHA256.finalize ctx - -newtype HashSHA512 = HashSHA512 SHA512.Ctx - -instance HashCtxC HashSHA512 where - hashCName _ = "SHA512" - hashCInit _ = HashSHA512 SHA512.init - hashCUpdate (HashSHA512 ctx) b = HashSHA512 (SHA512.update ctx b) - hashCUpdateSSL _ _ = error "CUpdateSSL with HashSHA512" - hashCFinal (HashSHA512 ctx) = SHA512.finalize ctx - -- functions to use the hidden class. -hashInit :: HashCtx -> HashCtx -hashInit (HashCtx h) = HashCtx $ hashCInit h - -hashUpdate :: HashCtx -> B.ByteString -> HashCtx -hashUpdate (HashCtx h) b = HashCtx $ hashCUpdate h b +hashInit :: Hash -> HashContext +hashInit MD5 = HashContext $ ContextSimple (H.hashInit :: H.Context H.MD5) +hashInit SHA1 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA1) +hashInit SHA256 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA256) +hashInit SHA512 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA512) +hashInit SHA1_MD5 = HashContextSSL H.hashInit H.hashInit + +hashUpdate :: HashContext -> B.ByteString -> HashCtx +hashUpdate (HashContext (ContextSimple h)) b = HashContext $ ContextSimple (H.hashUpdate h b) +hashUpdate (HashContextSSL sha1Ctx md5Ctx) b = + HashContextSSL (H.hashUpdate sha1Ctx b) (H.hashUpdate md5Ctx b) hashUpdateSSL :: HashCtx -> (B.ByteString,B.ByteString) -- ^ (for the md5 context, for the sha1 context) -> HashCtx -hashUpdateSSL (HashCtx h) bs = HashCtx $ hashCUpdateSSL h bs +hashUpdateSSL (HashContext _) _ = error "internal error: update SSL without a SSL Context" +hashUpdateSSL (HashContextSSL sha1Ctx md5Ctx) (b1,b2) = + HashContextSSL (H.hashUpdate sha1Ctx b2) (H.hashUpdate md5Ctx b1) hashFinal :: HashCtx -> B.ByteString -hashFinal (HashCtx h) = hashCFinal h - --- real hash constructors -hashMD5SHA1, hashSHA1, hashSHA256, hashSHA512 :: HashCtx -hashMD5SHA1 = HashCtx (HashMD5SHA1 SHA1.init MD5.init) -hashSHA1 = HashCtx (HashSHA1 SHA1.init) -hashSHA256 = HashCtx (HashSHA256 SHA256.init) -hashSHA512 = HashCtx (HashSHA512 SHA512.init) +hashFinal (HashContext (ContextSimple h)) = B.toBytes $ H.hashFinalize h +hashFinal (HashContextSSL sha1Ctx md5Ctx) = + B.concat [B.toBytes (H.hashFinalize md5Ctx), B.toBytes (H.hashFinalize sha1Ctx)] + +data Hash = MD5 | SHA1 | SHA256 | SHA512 | SHA1_MD5 + deriving (Show,Eq) + +data HashContext = + HashContext ContextSimple + | HashContextSSL (H.Context H.SHA1) (H.Context H.MD5) + +instance Show HashContext where + show _ = "hash-context" + +data ContextSimple = forall alg . H.HashAlgorithm alg => ContextSimple (H.Context alg) + +type HashCtx = HashContext + +hash :: Hash -> B.ByteString -> B.ByteString +hash MD5 b = B.toBytes . (H.hash :: B.ByteString -> H.Digest H.MD5) $ b +hash SHA1 b = B.toBytes . (H.hash :: B.ByteString -> H.Digest H.SHA1) $ b +hash SHA256 b = B.toBytes . (H.hash :: B.ByteString -> H.Digest H.SHA256) $ b +hash SHA512 b = B.toBytes . (H.hash :: B.ByteString -> H.Digest H.SHA512) $ b +hash SHA1_MD5 b = + B.concat [B.toBytes (md5Hash b), B.toBytes (sha1Hash b)] + where + sha1Hash :: B.ByteString -> H.Digest H.SHA1 + sha1Hash = H.hash + md5Hash :: B.ByteString -> H.Digest H.MD5 + md5Hash = H.hash + +hashName :: Hash -> String +hashName = show + +hashDigestSize :: Hash -> Int +hashDigestSize MD5 = 16 +hashDigestSize SHA1 = 20 +hashDigestSize SHA256 = 32 +hashDigestSize SHA512 = 64 +hashDigestSize SHA1_MD5 = 36 + +hashBlockSize :: Hash -> Int +hashBlockSize MD5 = 64 +hashBlockSize SHA1 = 64 +hashBlockSize SHA256 = 64 +hashBlockSize SHA512 = 128 +hashBlockSize SHA1_MD5 = 64 {- key exchange methods encrypt and decrypt for each supported algorithm -} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/ErrT.hs new/tls-1.2.18/Network/TLS/ErrT.hs --- old/tls-1.2.17/Network/TLS/ErrT.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/ErrT.hs 2015-06-19 15:56:01.000000000 +0200 @@ -22,6 +22,7 @@ type ErrT = ExceptT #else import Control.Monad.Error +runErrT :: ErrorT e m a -> m (Either e a) runErrT = runErrorT type ErrT = ErrorT #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Extra/Cipher.hs new/tls-1.2.18/Network/TLS/Extra/Cipher.hs --- old/tls-1.2.17/Network/TLS/Extra/Cipher.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Extra/Cipher.hs 2015-06-19 15:56:01.000000000 +0200 @@ -43,62 +43,59 @@ import Network.TLS.Cipher import qualified "cipher-rc4" Crypto.Cipher.RC4 as RC4 -import qualified Crypto.Hash.SHA256 as SHA256 -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Hash.MD5 as MD5 - import qualified "cipher-aes" Crypto.Cipher.AES as AES import Crypto.Cipher.TripleDES import Crypto.Cipher.Types (makeKey, makeIV, cipherInit, cbcEncrypt, cbcDecrypt) import qualified Crypto.Cipher.Types as T -aes_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes_cbc_encrypt key iv d = AES.encryptCBC (AES.initAES key) iv d -aes_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes_cbc_decrypt key iv d = AES.decryptCBC (AES.initAES key) iv d +takelast :: Int -> B.ByteString -> B.ByteString +takelast i b = B.drop (B.length b - i) b -aes128_cbc_encrypt - , aes128_cbc_decrypt - , aes256_cbc_encrypt - , aes256_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes128_cbc_encrypt = aes_cbc_encrypt -aes128_cbc_decrypt = aes_cbc_decrypt -aes256_cbc_encrypt = aes_cbc_encrypt -aes256_cbc_decrypt = aes_cbc_decrypt - -aes128_gcm_encrypt, aes128_gcm_decrypt :: Key -> Nonce -> B.ByteString -> AdditionalData -> (B.ByteString, T.AuthTag) -aes128_gcm_encrypt key nonce d ad = AES.encryptGCM (AES.initAES key) nonce ad d -aes128_gcm_decrypt key nonce d ad = AES.decryptGCM (AES.initAES key) nonce ad d - -tripledes_ede_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString -tripledes_ede_cbc_encrypt key iv bs = - cbcEncrypt (cipherInit $ tripledes_key key) (tripledes_iv iv) bs - -tripledes_ede_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString -tripledes_ede_cbc_decrypt key iv bs = - cbcDecrypt (cipherInit $ tripledes_key key) (tripledes_iv iv) bs +aes128cbc :: BulkDirection -> BulkKey -> BulkBlock +aes128cbc BulkEncrypt key = + let ctx = AES.initAES key + in (\iv input -> let output = AES.encryptCBC ctx iv input in (output, takelast 16 output)) +aes128cbc BulkDecrypt key = + let ctx = AES.initAES key + in (\iv input -> let output = AES.decryptCBC ctx iv input in (output, takelast 16 input)) + +aes256cbc :: BulkDirection -> BulkKey -> BulkBlock +aes256cbc BulkEncrypt key = + let ctx = AES.initAES key + in (\iv input -> let output = AES.encryptCBC ctx iv input in (output, takelast 16 output)) +aes256cbc BulkDecrypt key = + let ctx = AES.initAES key + in (\iv input -> let output = AES.decryptCBC ctx iv input in (output, takelast 16 input)) + +aes128gcm :: BulkDirection -> BulkKey -> BulkAEAD +aes128gcm BulkEncrypt key = + let ctx = AES.initAES key + in (\nonce d ad -> AES.encryptGCM ctx nonce ad d) +aes128gcm BulkDecrypt key = + let ctx = AES.initAES key + in (\nonce d ad -> AES.decryptGCM ctx nonce ad d) + +tripledes_ede :: BulkDirection -> BulkKey -> BulkBlock +tripledes_ede BulkEncrypt key = + let ctx = cipherInit (tripledes_key key) + in (\iv input -> let output = cbcEncrypt ctx (tripledes_iv iv) input in (output, takelast 16 output)) +tripledes_ede BulkDecrypt key = + let ctx = cipherInit (tripledes_key key) + in (\iv input -> let output = cbcDecrypt ctx (tripledes_iv iv) input in (output, takelast 16 input)) -tripledes_key :: Key -> T.Key DES_EDE3 +tripledes_key :: BulkKey -> T.Key DES_EDE3 tripledes_key key = either (\ke -> error ("tripledes cipher key internal error: " ++ show ke)) id $ makeKey key -tripledes_iv :: IV -> T.IV DES_EDE3 +tripledes_iv :: BulkIV -> T.IV DES_EDE3 tripledes_iv iv = maybe (error "tripledes cipher iv internal error") id $ makeIV iv -toIV :: RC4.Ctx -> IV -toIV (RC4.Ctx ctx) = ctx - -toCtx :: IV -> RC4.Ctx -toCtx iv = RC4.Ctx iv - -initF_rc4 :: Key -> IV -initF_rc4 key = toIV $ RC4.initCtx key - -encryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV) -encryptF_rc4 iv d = (\(ctx, e) -> (e, toIV ctx)) $ RC4.combine (toCtx iv) d - -decryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV) -decryptF_rc4 iv e = (\(ctx, d) -> (d, toIV ctx)) $ RC4.combine (toCtx iv) e +rc4 :: BulkDirection -> BulkKey -> BulkStream +rc4 _ bulkKey = BulkStream (combineRC4 $ RC4.initCtx bulkKey) + where + combineRC4 ctx input = + let (ctx', output) = RC4.combine ctx input + in (output, BulkStream (combineRC4 ctx')) -- | all encrypted ciphers supported ordered from strong to weak. @@ -142,16 +139,17 @@ , bulkKeySize = 0 , bulkIVSize = 0 , bulkBlockSize = 0 - , bulkF = BulkStreamF (const B.empty) streamId streamId + , bulkF = BulkStreamF passThrough } - where streamId = \iv b -> (b,iv) + where + passThrough _ _ = BulkStream go where go inp = (inp, BulkStream go) bulk_rc4 = Bulk { bulkName = "RC4-128" , bulkKeySize = 16 , bulkIVSize = 0 , bulkBlockSize = 0 - , bulkF = BulkStreamF initF_rc4 encryptF_rc4 decryptF_rc4 + , bulkF = BulkStreamF rc4 } bulk_aes128 = Bulk @@ -159,7 +157,7 @@ , bulkKeySize = 16 , bulkIVSize = 16 , bulkBlockSize = 16 - , bulkF = BulkBlockF aes128_cbc_encrypt aes128_cbc_decrypt + , bulkF = BulkBlockF aes128cbc } bulk_aes128gcm = Bulk @@ -167,7 +165,7 @@ , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN , bulkIVSize = 4 -- RFC 5288 GCMNonce.salt, fixed_iv_length , bulkBlockSize = 0 -- dummy, not used - , bulkF = BulkAeadF aes128_gcm_encrypt aes128_gcm_decrypt + , bulkF = BulkAeadF aes128gcm } bulk_aes256 = Bulk @@ -175,7 +173,7 @@ , bulkKeySize = 32 , bulkIVSize = 16 , bulkBlockSize = 16 - , bulkF = BulkBlockF aes256_cbc_encrypt aes256_cbc_decrypt + , bulkF = BulkBlockF aes256cbc } bulk_tripledes_ede = Bulk @@ -183,26 +181,7 @@ , bulkKeySize = 24 , bulkIVSize = 8 , bulkBlockSize = 8 - , bulkF = BulkBlockF tripledes_ede_cbc_encrypt tripledes_ede_cbc_decrypt - } - -hash_md5, hash_sha1, hash_sha256 :: Hash -hash_md5 = Hash - { hashName = "MD5" - , hashSize = 16 - , hashF = MD5.hash - } - -hash_sha1 = Hash - { hashName = "SHA1" - , hashSize = 20 - , hashF = SHA1.hash - } - -hash_sha256 = Hash - { hashName = "SHA256" - , hashSize = 32 - , hashF = SHA256.hash + , bulkF = BulkBlockF tripledes_ede } -- | unencrypted cipher using RSA for key exchange and MD5 for digest @@ -211,7 +190,7 @@ { cipherID = 0x1 , cipherName = "RSA-null-MD5" , cipherBulk = bulk_null - , cipherHash = hash_md5 + , cipherHash = MD5 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } @@ -222,7 +201,7 @@ { cipherID = 0x2 , cipherName = "RSA-null-SHA1" , cipherBulk = bulk_null - , cipherHash = hash_sha1 + , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } @@ -233,7 +212,7 @@ { cipherID = 0x04 , cipherName = "RSA-rc4-128-md5" , cipherBulk = bulk_rc4 - , cipherHash = hash_md5 + , cipherHash = MD5 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } @@ -244,7 +223,7 @@ { cipherID = 0x05 , cipherName = "RSA-rc4-128-sha1" , cipherBulk = bulk_rc4 - , cipherHash = hash_sha1 + , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } @@ -255,7 +234,7 @@ { cipherID = 0x2f , cipherName = "RSA-aes128-sha1" , cipherBulk = bulk_aes128 - , cipherHash = hash_sha1 + , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just SSL3 } @@ -266,7 +245,7 @@ { cipherID = 0x35 , cipherName = "RSA-aes256-sha1" , cipherBulk = bulk_aes256 - , cipherHash = hash_sha1 + , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just SSL3 } @@ -277,7 +256,7 @@ { cipherID = 0x3c , cipherName = "RSA-aes128-sha256" , cipherBulk = bulk_aes128 - , cipherHash = hash_sha256 + , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just TLS12 } @@ -288,7 +267,7 @@ { cipherID = 0x3d , cipherName = "RSA-aes256-sha256" , cipherBulk = bulk_aes256 - , cipherHash = hash_sha256 + , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just TLS12 } @@ -299,7 +278,7 @@ { cipherID = 0x33 , cipherName = "DHE-RSA-AES128-SHA1" , cipherBulk = bulk_aes128 - , cipherHash = hash_sha1 + , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_DHE_RSA , cipherMinVer = Nothing } @@ -318,7 +297,7 @@ { cipherID = 0x32 , cipherName = "DHE-DSA-AES128-SHA1" , cipherBulk = bulk_aes128 - , cipherHash = hash_sha1 + , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_DHE_DSS , cipherMinVer = Nothing } @@ -342,7 +321,7 @@ cipher_DHE_RSA_AES128_SHA256 = cipher_DHE_RSA_AES128_SHA1 { cipherID = 0x67 , cipherName = "DHE-RSA-AES128-SHA256" - , cipherHash = hash_sha256 + , cipherHash = SHA256 , cipherMinVer = Just TLS12 } @@ -359,7 +338,7 @@ { cipherID = 0x0a , cipherName = "RSA-3DES-EDE-CBC-SHA1" , cipherBulk = bulk_tripledes_ede - , cipherHash = hash_sha1 + , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } @@ -369,7 +348,7 @@ { cipherID = 0x9e , cipherName = "DHE-RSA-AES128GCM-SHA256" , cipherBulk = bulk_aes128gcm - , cipherHash = hash_sha256 + , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_DHE_RSA , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4 } @@ -379,7 +358,7 @@ { cipherID = 0xc02f , cipherName = "ECDHE-RSA-AES128GCM-SHA256" , cipherBulk = bulk_aes128gcm - , cipherHash = hash_sha256 + , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4 } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Handshake/Client.hs new/tls-1.2.18/Network/TLS/Handshake/Client.hs --- old/tls-1.2.17/Network/TLS/Handshake/Client.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Handshake/Client.hs 2015-06-19 15:56:01.000000000 +0200 @@ -209,10 +209,12 @@ sendPacket ctx $ Handshake [ClientKeyXchg ckx] where getCKX_DHE = do xver <- usingState_ ctx getVersion - (ServerDHParams dhparams serverDHPub) <- fromJust <$> usingHState ctx (gets hstServerDHParams) - (clientDHPriv, clientDHPub) <- generateDHE ctx dhparams + serverParams <- fromJust <$> usingHState ctx (gets hstServerDHParams) + (clientDHPriv, clientDHPub) <- generateDHE ctx (serverDHParamsToParams serverParams) - let premaster = dhGetShared dhparams clientDHPriv serverDHPub + let premaster = dhGetShared (serverDHParamsToParams serverParams) + clientDHPriv + (serverDHParamsToPublic serverParams) usingHState ctx $ setMasterSecretFromPre xver ClientRole premaster return $ CKX_DH clientDHPub @@ -258,10 +260,8 @@ _ -> return Nothing -- Fetch all handshake messages up to now. - msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages - (hashMethod, toSign) <- prepareCertificateVerifySignatureData ctx usedVersion malg msgs - - sigDig <- signatureCreate ctx malg hashMethod toSign + msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages + sigDig <- certificateVerifyCreate ctx usedVersion malg msgs sendPacket ctx $ Handshake [CertVerify sigDig] _ -> return () @@ -389,15 +389,13 @@ (c,_) -> throwCore $ Error_Protocol ("unknown server key exchange received, expecting: " ++ show c, True, HandshakeFailure) doDHESignature dhparams signature signatureType = do -- TODO verify DHParams - expectedData <- generateSignedDHParams ctx dhparams - verified <- signatureVerify ctx signatureType expectedData signature - when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " for dhparams", True, HandshakeFailure) + verified <- digitallySignDHParamsVerify ctx dhparams signatureType signature + when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " for dhparams " ++ show dhparams, True, HandshakeFailure) usingHState ctx $ setServerDHParams dhparams doECDHESignature ecdhparams signature signatureType = do -- TODO verify DHParams - expectedData <- generateSignedECDHParams ctx ecdhparams - verified <- signatureVerify ctx signatureType expectedData signature + verified <- digitallySignECDHParamsVerify ctx ecdhparams signatureType signature when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " for dhparams", True, HandshakeFailure) usingHState ctx $ setServerECDHParams ecdhparams diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Handshake/Process.hs new/tls-1.2.18/Network/TLS/Handshake/Process.hs --- old/tls-1.2.17/Network/TLS/Handshake/Process.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Handshake/Process.hs 2015-06-19 15:56:01.000000000 +0200 @@ -88,9 +88,9 @@ rver <- usingState_ ctx getVersion role <- usingState_ ctx isClientContext - (ServerDHParams dhparams _) <- fromJust "server dh params" <$> usingHState ctx (gets hstServerDHParams) - dhpriv <- fromJust "dh private" <$> usingHState ctx (gets hstDHPrivate) - let premaster = dhGetShared dhparams dhpriv clientDHValue + serverParams <- fromJust "server dh params" <$> usingHState ctx (gets hstServerDHParams) + dhpriv <- fromJust "dh private" <$> usingHState ctx (gets hstDHPrivate) + let premaster = dhGetShared (serverDHParamsToParams serverParams) dhpriv clientDHValue usingHState ctx $ setMasterSecretFromPre rver role premaster processClientKeyXchg ctx (CKX_ECDH clientECDHValue) = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Handshake/Server.hs new/tls-1.2.18/Network/TLS/Handshake/Server.hs --- old/tls-1.2.17/Network/TLS/Handshake/Server.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Handshake/Server.hs 2015-06-19 15:56:01.000000000 +0200 @@ -268,7 +268,7 @@ let dhparams = fromJust "server DHE Params" $ serverDHEParams sparams (priv, pub) <- generateDHE ctx dhparams - let serverParams = ServerDHParams dhparams pub + let serverParams = serverDHParamsFrom dhparams pub usingHState ctx $ setServerDHParams serverParams usingHState ctx $ modify $ \hst -> hst { hstDHPrivate = Just priv } @@ -276,17 +276,7 @@ generateSKX_DHE sigAlg = do serverParams <- setup_DHE - signatureData <- generateSignedDHParams ctx serverParams - - usedVersion <- usingState_ ctx getVersion - let mhash = case usedVersion of - TLS12 -> case filter ((==) sigAlg . snd) $ supportedHashSignatures $ ctxSupported ctx of - [] -> error ("no hash signature for " ++ show sigAlg) - x:_ -> Just (fst x) - _ -> Nothing - let hashDescr = signatureHashData sigAlg mhash - signed <- signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) hashDescr signatureData - + signed <- digitallySignDHParams ctx serverParams sigAlg case sigAlg of SignatureRSA -> return $ SKX_DHE_RSA serverParams signed SignatureDSS -> return $ SKX_DHE_DSS serverParams signed @@ -311,22 +301,14 @@ -- There may be a better way to choose EC. nc = if null common then error "No common EllipticCurves" else maximum $ map fromEnumSafe16 common - serverParams <- setup_ECDHE nc - signatureData <- generateSignedECDHParams ctx serverParams - - usedVersion <- usingState_ ctx getVersion - let mhash = case usedVersion of - TLS12 -> case filter ((==) sigAlg . snd) $ supportedHashSignatures $ ctxSupported ctx of - [] -> error ("no hash signature for " ++ show sigAlg) - x:_ -> Just (fst x) - _ -> Nothing - let hashDescr = signatureHashData sigAlg mhash - signed <- signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) hashDescr signatureData - + serverParams <- setup_ECDHE nc + signed <- digitallySignECDHParams ctx serverParams sigAlg case sigAlg of SignatureRSA -> return $ SKX_ECDHE_RSA serverParams signed _ -> error ("generate skx_dhe unsupported signature type: " ++ show sigAlg) + -- create a DigitallySigned objects for DHParams or ECDHParams. + -- | receive Client data in handshake until the Finished handshake. -- -- <- [certificate] @@ -376,11 +358,8 @@ usedVersion <- usingState_ ctx getVersion -- Fetch all handshake messages up to now. - msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages - (hashMethod, toVerify) <- prepareCertificateVerifySignatureData ctx usedVersion mbHashSig msgs - - -- Verify the signature. - verif <- signatureVerifyWithHashDescr ctx SignatureRSA hashMethod toVerify dsig + msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages + verif <- certificateVerifyCheck ctx usedVersion mbHashSig msgs dsig case verif of True -> do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Handshake/Signature.hs new/tls-1.2.18/Network/TLS/Handshake/Signature.hs --- old/tls-1.2.17/Network/TLS/Handshake/Signature.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Handshake/Signature.hs 2015-06-19 15:56:01.000000000 +0200 @@ -7,14 +7,13 @@ -- Portability : unknown -- module Network.TLS.Handshake.Signature - ( getHashAndASN1 - , prepareCertificateVerifySignatureData - , signatureHashData - , signatureCreate - , signatureVerify - , signatureVerifyWithHashDescr - , generateSignedDHParams - , generateSignedECDHParams + ( + certificateVerifyCreate + , certificateVerifyCheck + , digitallySignDHParams + , digitallySignECDHParams + , digitallySignDHParamsVerify + , digitallySignECDHParamsVerify ) where import Crypto.PubKey.HashDescr @@ -22,6 +21,7 @@ import Network.TLS.Context.Internal import Network.TLS.Struct import Network.TLS.Packet (generateCertificateVerify_SSL, encodeSignedDHParams, encodeSignedECDHParams) +import Network.TLS.Parameters (supportedHashSignatures) import Network.TLS.State import Network.TLS.Handshake.State import Network.TLS.Handshake.Key @@ -30,6 +30,25 @@ import Control.Applicative import Control.Monad.State +certificateVerifyCheck :: Context + -> Version + -> Maybe HashAndSignatureAlgorithm + -> Bytes + -> DigitallySigned + -> IO Bool +certificateVerifyCheck ctx usedVersion malg msgs dsig = do + (hashMethod, toVerify) <- prepareCertificateVerifySignatureData ctx usedVersion malg msgs + signatureVerifyWithHashDescr ctx SignatureRSA hashMethod toVerify dsig + +certificateVerifyCreate :: Context + -> Version + -> Maybe HashAndSignatureAlgorithm + -> Bytes + -> IO DigitallySigned +certificateVerifyCreate ctx usedVersion malg msgs = do + (hashMethod, toSign) <- prepareCertificateVerifySignatureData ctx usedVersion malg msgs + signatureCreate ctx malg hashMethod toSign + getHashAndASN1 :: MonadIO m => (HashAlgorithm, SignatureAlgorithm) -> m HashDescr getHashAndASN1 hashSig = case hashSig of (HashSHA1, SignatureRSA) -> return hashDescrSHA1 @@ -47,11 +66,11 @@ prepareCertificateVerifySignatureData ctx usedVersion malg msgs | usedVersion == SSL3 = do Just masterSecret <- usingHState ctx $ gets hstMasterSecret - let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit hashMD5SHA1) msgs) + let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit SHA1_MD5) msgs) hsh = HashDescr id id return (hsh, digest) | usedVersion == TLS10 || usedVersion == TLS11 = do - let hashf bs = hashFinal (hashUpdate (hashInit hashMD5SHA1) bs) + let hashf bs = hashFinal (hashUpdate (hashInit SHA1_MD5) bs) hsh = HashDescr hashf id return (hsh, msgs) | otherwise = do @@ -65,7 +84,7 @@ Just HashSHA512 -> hashDescrSHA512 Just HashSHA256 -> hashDescrSHA256 Just HashSHA1 -> hashDescrSHA1 - Nothing -> HashDescr (hashFinal . hashUpdate (hashInit hashMD5SHA1)) id + Nothing -> HashDescr (hashFinal . hashUpdate (hashInit SHA1_MD5)) id _ -> error ("unimplemented signature hash type") signatureHashData SignatureDSS mhash = case mhash of @@ -103,14 +122,53 @@ SignatureDSS -> verifyRSA ctx cc hashDescr toVerify bs _ -> error "not implemented yet" -generateSignedDHParams :: Context -> ServerDHParams -> IO Bytes -generateSignedDHParams ctx serverParams = do - (cran, sran) <- usingHState ctx $ do - (,) <$> gets hstClientRandom <*> (fromJust "server random" <$> gets hstServerRandom) - return $ encodeSignedDHParams cran sran serverParams - -generateSignedECDHParams :: Context -> ServerECDHParams -> IO Bytes -generateSignedECDHParams ctx serverParams = do - (cran, sran) <- usingHState ctx $ do - (,) <$> gets hstClientRandom <*> (fromJust "server random" <$> gets hstServerRandom) - return $ encodeSignedECDHParams cran sran serverParams +digitallySignParams :: Context -> Bytes -> SignatureAlgorithm -> IO DigitallySigned +digitallySignParams ctx signatureData sigAlg = do + usedVersion <- usingState_ ctx getVersion + let mhash = case usedVersion of + TLS12 -> case filter ((==) sigAlg . snd) $ supportedHashSignatures $ ctxSupported ctx of + [] -> error ("no hash signature for " ++ show sigAlg) + x:_ -> Just (fst x) + _ -> Nothing + let hashDescr = signatureHashData sigAlg mhash + signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) hashDescr signatureData + +digitallySignDHParams :: Context + -> ServerDHParams + -> SignatureAlgorithm + -> IO DigitallySigned +digitallySignDHParams ctx serverParams sigAlg = do + dhParamsData <- withClientAndServerRandom ctx $ encodeSignedDHParams serverParams + digitallySignParams ctx dhParamsData sigAlg + +digitallySignECDHParams :: Context + -> ServerECDHParams + -> SignatureAlgorithm + -> IO DigitallySigned +digitallySignECDHParams ctx serverParams sigAlg = do + ecdhParamsData <- withClientAndServerRandom ctx $ encodeSignedECDHParams serverParams + digitallySignParams ctx ecdhParamsData sigAlg + +digitallySignDHParamsVerify :: Context + -> ServerDHParams + -> SignatureAlgorithm + -> DigitallySigned + -> IO Bool +digitallySignDHParamsVerify ctx dhparams sigAlg signature = do + expectedData <- withClientAndServerRandom ctx $ encodeSignedDHParams dhparams + signatureVerify ctx sigAlg expectedData signature + +digitallySignECDHParamsVerify :: Context + -> ServerECDHParams + -> SignatureAlgorithm + -> DigitallySigned + -> IO Bool +digitallySignECDHParamsVerify ctx dhparams sigAlg signature = do + expectedData <- withClientAndServerRandom ctx $ encodeSignedECDHParams dhparams + signatureVerify ctx sigAlg expectedData signature + +withClientAndServerRandom :: Context -> (ClientRandom -> ServerRandom -> b) -> IO b +withClientAndServerRandom ctx f = do + (cran, sran) <- usingHState ctx $ (,) <$> gets hstClientRandom + <*> (fromJust "withClientAndServer : server random" <$> gets hstServerRandom) + return $ f cran sran diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Handshake/State.hs new/tls-1.2.18/Network/TLS/Handshake/State.hs --- old/tls-1.2.17/Network/TLS/Handshake/State.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Handshake/State.hs 2015-06-19 15:56:01.000000000 +0200 @@ -221,7 +221,7 @@ keyblockSize = cipherKeyBlockSize cipher bulk = cipherBulk cipher - digestSize = if hasMAC (bulkF bulk) then hashSize (cipherHash cipher) + digestSize = if hasMAC (bulkF bulk) then hashDigestSize (cipherHash cipher) else 0 keySize = bulkKeySize bulk ivSize = bulkIVSize bulk @@ -232,10 +232,10 @@ (cMACSecret, sMACSecret, cWriteKey, sWriteKey, cWriteIV, sWriteIV) = fromJust "p6" $ partition6 kb (digestSize, digestSize, keySize, keySize, ivSize, ivSize) - cstClient = CryptState { cstKey = cWriteKey + cstClient = CryptState { cstKey = bulkInit bulk (BulkEncrypt `orOnServer` BulkDecrypt) cWriteKey , cstIV = cWriteIV , cstMacSecret = cMACSecret } - cstServer = CryptState { cstKey = sWriteKey + cstServer = CryptState { cstKey = bulkInit bulk (BulkDecrypt `orOnServer` BulkEncrypt) sWriteKey , cstIV = sWriteIV , cstMacSecret = sMACSecret } msClient = MacState { msSequence = 0 } @@ -254,6 +254,9 @@ , stCompression = hstPendingCompression hst } + orOnServer f g = if cc == ClientRole then f else g + + setServerHelloParameters :: Version -- ^ chosen version -> ServerRandom -> Cipher @@ -266,6 +269,6 @@ , hstPendingCompression = compression , hstHandshakeDigest = updateDigest $ hstHandshakeDigest hst } - where initCtx = if ver < TLS12 then hashMD5SHA1 else hashSHA256 - updateDigest (Left bytes) = Right $ foldl hashUpdate initCtx $ reverse bytes + where hashAlg = if ver < TLS12 then SHA1_MD5 else SHA256 + updateDigest (Left bytes) = Right $ foldl hashUpdate (hashInit hashAlg) $ reverse bytes updateDigest (Right _) = error "cannot initialize digest with another digest" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/MAC.hs new/tls-1.2.18/Network/TLS/MAC.hs --- old/tls-1.2.17/Network/TLS/MAC.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/MAC.hs 2015-06-19 15:56:01.000000000 +0200 @@ -6,10 +6,7 @@ -- Portability : unknown -- module Network.TLS.MAC - ( hmacMD5 - , hmacSHA1 - , hmacSHA256 - , macSSL + ( macSSL , hmac , prf_MD5 , prf_SHA1 @@ -17,40 +14,39 @@ , prf_MD5SHA1 ) where -import qualified Crypto.Hash.MD5 as MD5 -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Hash.SHA256 as SHA256 +import Network.TLS.Crypto import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.Bits (xor) type HMAC = ByteString -> ByteString -> ByteString -macSSL :: (ByteString -> ByteString) -> HMAC -macSSL f secret msg = f $! B.concat [ secret, B.replicate padlen 0x5c, - f $! B.concat [ secret, B.replicate padlen 0x36, msg ] ] - where -- get the type of algorithm out of the digest length by using the hash fct. - padlen = if (B.length $ f B.empty) == 16 then 48 else 40 - -hmac :: (ByteString -> ByteString) -> Int -> HMAC -hmac f bl secret msg = - f $! B.append opad (f $! B.append ipad msg) +macSSL :: Hash -> HMAC +macSSL alg secret msg = + f $! B.concat + [ secret + , B.replicate padLen 0x5c + , f $! B.concat [ secret, B.replicate padLen 0x36, msg ] + ] + where + padLen = case alg of + MD5 -> 48 + SHA1 -> 40 + _ -> error ("internal error: macSSL called with " ++ show alg) + f = hash alg + +hmac :: Hash -> HMAC +hmac alg secret msg = f $! B.append opad (f $! B.append ipad msg) where opad = B.map (xor 0x5c) k' ipad = B.map (xor 0x36) k' + f = hash alg + bl = hashBlockSize alg + k' = B.append kt pad where kt = if B.length secret > fromIntegral bl then f secret else secret pad = B.replicate (fromIntegral bl - B.length kt) 0 -hmacMD5 :: HMAC -hmacMD5 secret msg = hmac MD5.hash 64 secret msg - -hmacSHA1 :: HMAC -hmacSHA1 secret msg = hmac SHA1.hash 64 secret msg - -hmacSHA256 :: HMAC -hmacSHA256 secret msg = hmac SHA256.hash 64 secret msg - hmacIter :: HMAC -> ByteString -> ByteString -> ByteString -> Int -> [ByteString] hmacIter f secret seed aprev len = let an = f secret aprev in @@ -61,10 +57,10 @@ else out : hmacIter f secret seed an (len - digestsize) prf_SHA1 :: ByteString -> ByteString -> Int -> ByteString -prf_SHA1 secret seed len = B.concat $ hmacIter hmacSHA1 secret seed seed len +prf_SHA1 secret seed len = B.concat $ hmacIter (hmac SHA1) secret seed seed len prf_MD5 :: ByteString -> ByteString -> Int -> ByteString -prf_MD5 secret seed len = B.concat $ hmacIter hmacMD5 secret seed seed len +prf_MD5 secret seed len = B.concat $ hmacIter (hmac MD5) secret seed seed len prf_MD5SHA1 :: ByteString -> ByteString -> Int -> ByteString prf_MD5SHA1 secret seed len = @@ -74,4 +70,4 @@ s2 = B.drop (slen `div` 2) secret prf_SHA256 :: ByteString -> ByteString -> Int -> ByteString -prf_SHA256 secret seed len = B.concat $ hmacIter hmacSHA256 secret seed seed len +prf_SHA256 secret seed len = B.concat $ hmacIter (hmac SHA256) secret seed seed len diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Packet.hs new/tls-1.2.18/Network/TLS/Packet.hs --- old/tls-1.2.17/Network/TLS/Packet.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Packet.hs 2015-06-19 15:56:01.000000000 +0200 @@ -77,9 +77,6 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Hash.MD5 as MD5 - data CurrentParams = CurrentParams { cParamsVersion :: Version -- ^ current protocol version , cParamsKeyXchgType :: Maybe CipherKeyExchangeType -- ^ current key exchange type @@ -486,14 +483,10 @@ putWord8 (valOfType h) >> putWord8 (valOfType s) getServerDHParams :: Get ServerDHParams -getServerDHParams = ServerDHParams <$> getDHParams <*> getDHPublic - where getDHParams = dhParams <$> getInteger16 -- p - <*> getInteger16 -- g - getDHPublic = dhPublic <$> getInteger16 -- y(server) +getServerDHParams = ServerDHParams <$> getBigNum16 <*> getBigNum16 <*> getBigNum16 putServerDHParams :: ServerDHParams -> Put -putServerDHParams (ServerDHParams dhparams dhpub) = - mapM_ putInteger16 $ dhUnwrap dhparams dhpub +putServerDHParams (ServerDHParams p g y) = mapM_ putBigNum16 [p,g,y] getServerECDHParams :: Get ServerECDHParams getServerECDHParams = do @@ -566,8 +559,8 @@ generateMasterSecret_SSL :: Bytes -> ClientRandom -> ServerRandom -> Bytes generateMasterSecret_SSL premasterSecret (ClientRandom c) (ServerRandom s) = B.concat $ map (computeMD5) ["A","BB","CCC"] - where computeMD5 label = MD5.hash $ B.concat [ premasterSecret, computeSHA1 label ] - computeSHA1 label = SHA1.hash $ B.concat [ label, premasterSecret, c, s ] + where computeMD5 label = hash MD5 $ B.concat [ premasterSecret, computeSHA1 label ] + computeSHA1 label = hash SHA1 $ B.concat [ label, premasterSecret, c, s ] generateMasterSecret_TLS :: PRF -> Bytes -> ClientRandom -> ServerRandom -> Bytes generateMasterSecret_TLS prf premasterSecret (ClientRandom c) (ServerRandom s) = @@ -589,8 +582,8 @@ generateKeyBlock_SSL (ClientRandom c) (ServerRandom s) mastersecret kbsize = B.concat $ map computeMD5 $ take ((kbsize `div` 16) + 1) labels where labels = [ uncurry BC.replicate x | x <- zip [1..] ['A'..'Z'] ] - computeMD5 label = MD5.hash $ B.concat [ mastersecret, computeSHA1 label ] - computeSHA1 label = SHA1.hash $ B.concat [ label, mastersecret, s, c ] + computeMD5 label = hash MD5 $ B.concat [ mastersecret, computeSHA1 label ] + computeSHA1 label = hash SHA1 $ B.concat [ label, mastersecret, s, c ] generateKeyBlock :: Version -> ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes generateKeyBlock SSL2 = generateKeyBlock_SSL @@ -605,8 +598,8 @@ generateFinished_SSL :: Bytes -> Bytes -> HashCtx -> Bytes generateFinished_SSL sender mastersecret hashctx = B.concat [md5hash, sha1hash] - where md5hash = MD5.hash $ B.concat [ mastersecret, pad2, md5left ] - sha1hash = SHA1.hash $ B.concat [ mastersecret, B.take 40 pad2, sha1left ] + where md5hash = hash MD5 $ B.concat [ mastersecret, pad2, md5left ] + sha1hash = hash SHA1 $ B.concat [ mastersecret, B.take 40 pad2, sha1left ] lefthash = hashFinal $ flip hashUpdateSSL (pad1, B.take 40 pad1) $ foldl hashUpdate hashctx [sender,mastersecret] @@ -629,13 +622,13 @@ generateCertificateVerify_SSL :: Bytes -> HashCtx -> Bytes generateCertificateVerify_SSL = generateFinished_SSL "" -encodeSignedDHParams :: ClientRandom -> ServerRandom -> ServerDHParams -> Bytes -encodeSignedDHParams cran sran dhparams = runPut $ +encodeSignedDHParams :: ServerDHParams -> ClientRandom -> ServerRandom -> Bytes +encodeSignedDHParams dhparams cran sran = runPut $ putClientRandom32 cran >> putServerRandom32 sran >> putServerDHParams dhparams -- Combination of RFC 5246 and 4492 is ambiguous. -- Let's assume ecdhe_rsa and ecdhe_dss are identical to -- dhe_rsa and dhe_dss. -encodeSignedECDHParams :: ClientRandom -> ServerRandom -> ServerECDHParams -> Bytes -encodeSignedECDHParams cran sran dhparams = runPut $ +encodeSignedECDHParams :: ServerECDHParams -> ClientRandom -> ServerRandom -> Bytes +encodeSignedECDHParams dhparams cran sran = runPut $ putClientRandom32 cran >> putServerRandom32 sran >> putServerECDHParams dhparams diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Record/Disengage.hs new/tls-1.2.18/Network/TLS/Record/Disengage.hs --- old/tls-1.2.17/Network/TLS/Record/Disengage.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Record/Disengage.hs 2015-06-19 15:56:01.000000000 +0200 @@ -23,6 +23,7 @@ import Network.TLS.Record.State import Network.TLS.Record.Types import Network.TLS.Cipher +import Network.TLS.Crypto import Network.TLS.Compression import Network.TLS.Util import Network.TLS.Wire @@ -68,12 +69,11 @@ return $ cipherDataContent cdata decryptData :: Version -> Record Ciphertext -> Bytes -> RecordState -> RecordM Bytes -decryptData ver record econtent tst = decryptOf (bulkF bulk) +decryptData ver record econtent tst = decryptOf (cstKey cst) where cipher = fromJust "cipher" $ stCipher tst bulk = cipherBulk cipher cst = stCryptState tst - macSize = hashSize $ cipherHash cipher - writekey = cstKey cst + macSize = hashDigestSize $ cipherHash cipher blockSize = bulkBlockSize bulk econtentLen = B.length econtent @@ -81,18 +81,17 @@ sanityCheckError = throwError (Error_Packet "encrypted content too small for encryption parameters") - decryptOf :: BulkFunctions -> RecordM Bytes - decryptOf (BulkBlockF _ decryptF) = do + decryptOf :: BulkState -> RecordM Bytes + decryptOf (BulkStateBlock decryptF) = do let minContent = (if explicitIV then bulkIVSize bulk else 0) + max (macSize + 1) blockSize when ((econtentLen `mod` blockSize) /= 0 || econtentLen < minContent) $ sanityCheckError {- update IV -} (iv, econtent') <- if explicitIV then get2 econtent (bulkIVSize bulk, econtentLen - bulkIVSize bulk) else return (cstIV cst, econtent) - let newiv = fromJust "new iv" $ takelast (bulkBlockSize bulk) econtent' - modify $ \txs -> txs { stCryptState = cst { cstIV = newiv } } + let (content', iv') = decryptF iv econtent' + modify $ \txs -> txs { stCryptState = cst { cstIV = iv' } } - let content' = decryptF writekey iv econtent' let paddinglength = fromIntegral (B.last content') + 1 let contentlen = B.length content' - paddinglength - macSize (content, mac, padding) <- get3 content' (contentlen, macSize, paddinglength) @@ -102,20 +101,20 @@ , cipherDataPadding = Just padding } - decryptOf (BulkStreamF initF _ decryptF) = do + decryptOf (BulkStateStream (BulkStream decryptF)) = do when (econtentLen < macSize) $ sanityCheckError - let (content', newiv) = decryptF (if cstIV cst /= B.empty then cstIV cst else initF writekey) econtent + let (content', bulkStream') = decryptF econtent {- update Ctx -} let contentlen = B.length content' - macSize (content, mac) <- get2 content' (contentlen, macSize) - modify $ \txs -> txs { stCryptState = cst { cstIV = newiv } } + modify $ \txs -> txs { stCryptState = cst { cstKey = BulkStateStream bulkStream' } } getCipherData record $ CipherData { cipherDataContent = content , cipherDataMAC = Just mac , cipherDataPadding = Nothing } - decryptOf (BulkAeadF _ decryptF) = do + decryptOf (BulkStateAEAD decryptF) = do let authtaglen = 16 -- FIXME: fixed_iv_length + record_iv_length nonceexplen = 8 -- FIXME: record_iv_length econtentlen = B.length econtent - authtaglen - nonceexplen @@ -125,7 +124,7 @@ hdr = Header typ v $ fromIntegral econtentlen ad = B.concat [ encodedSeq, encodeHeader hdr ] nonce = cstIV (stCryptState tst) `B.append` enonce - (content, authTag2) = decryptF writekey nonce econtent' ad + (content, authTag2) = decryptF nonce econtent' ad when (AuthTag authTag /= authTag2) $ throwError $ Error_Protocol ("bad record mac", True, BadRecordMac) @@ -133,5 +132,8 @@ modify incrRecordState return content + decryptOf BulkStateUninitialized = + throwError $ Error_Protocol ("decrypt state uninitialized", True, InternalError) + get3 s ls = maybe (throwError $ Error_Packet "record bad format") return $ partition3 s ls get2 s (d1,d2) = get3 s (d1,d2,0) >>= \(r1,r2,_) -> return (r1,r2) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Record/Engage.hs new/tls-1.2.18/Network/TLS/Record/Engage.hs --- old/tls-1.2.17/Network/TLS/Record/Engage.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Record/Engage.hs 2015-06-19 15:56:01.000000000 +0200 @@ -8,6 +8,7 @@ -- Engage a record into the Record layer. -- The record is compressed, added some integrity field, then encrypted. -- +{-# LANGUAGE BangPatterns #-} module Network.TLS.Record.Engage ( engageRecord ) where @@ -21,7 +22,6 @@ import Network.TLS.Record.Types import Network.TLS.Cipher import Network.TLS.Compression -import Network.TLS.Util import Network.TLS.Wire import Network.TLS.Packet import Data.ByteString (ByteString) @@ -48,22 +48,23 @@ encryptContent :: Record Compressed -> ByteString -> RecordM ByteString encryptContent record content = do + cst <- getCryptState bulk <- getBulk - case bulkF bulk of - BulkBlockF encryptF _ -> do + case cstKey cst of + BulkStateBlock encryptF -> do digest <- makeDigest (recordToHeader record) content let content' = B.concat [content, digest] encryptBlock encryptF content' bulk - BulkStreamF initF encryptF _ -> do + BulkStateStream encryptF -> do digest <- makeDigest (recordToHeader record) content let content' = B.concat [content, digest] - encryptStream encryptF content' initF - BulkAeadF encryptF _ -> + encryptStream encryptF content' + BulkStateAEAD encryptF -> encryptAead encryptF content record + BulkStateUninitialized -> + return content -encryptBlock :: (Key -> IV -> ByteString -> ByteString) - -> ByteString -> Bulk - -> RecordM ByteString +encryptBlock :: BulkBlock -> ByteString -> Bulk -> RecordM ByteString encryptBlock encryptF content bulk = do cst <- getCryptState ver <- getRecordVersion @@ -76,26 +77,22 @@ else B.empty - let e = encryptF (cstKey cst) (cstIV cst) $ B.concat [ content, padding ] + let (e, iv') = encryptF (cstIV cst) $ B.concat [ content, padding ] if hasExplicitBlockIV ver then return $ B.concat [cstIV cst,e] else do - let newiv = fromJust "new iv" $ takelast (bulkIVSize bulk) e - modify $ \tstate -> tstate { stCryptState = cst { cstIV = newiv } } + modify $ \tstate -> tstate { stCryptState = cst { cstIV = iv' } } return e -encryptStream :: (IV -> ByteString -> (ByteString, IV)) - -> ByteString -> (Key -> IV) - -> RecordM ByteString -encryptStream encryptF content initF = do +encryptStream :: BulkStream -> ByteString -> RecordM ByteString +encryptStream (BulkStream encryptF) content = do cst <- getCryptState - let iv = cstIV cst - (e, newiv) = encryptF (if iv /= B.empty then iv else initF (cstKey cst)) content - modify $ \tstate -> tstate { stCryptState = cst { cstIV = newiv } } + let (!e, !newBulkStream) = encryptF content + modify $ \tstate -> tstate { stCryptState = cst { cstKey = BulkStateStream newBulkStream } } return e -encryptAead :: (Key -> Nonce -> ByteString -> AdditionalData -> (ByteString, AuthTag)) +encryptAead :: BulkAEAD -> ByteString -> Record Compressed -> RecordM ByteString encryptAead encryptF content record = do @@ -108,7 +105,7 @@ processorNum = encodeWord32 1 -- FIXME counter = B.drop 4 encodedSeq -- FIXME: probably OK nonce = B.concat [salt, processorNum, counter] - let (e, AuthTag authtag) = encryptF (cstKey cst) nonce content ad + let (e, AuthTag authtag) = encryptF nonce content ad modify incrRecordState return $ B.concat [processorNum, counter, e, authtag] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Record/State.hs new/tls-1.2.18/Network/TLS/Record/State.hs --- old/tls-1.2.17/Network/TLS/Record/State.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Record/State.hs 2015-06-19 15:56:01.000000000 +0200 @@ -41,7 +41,7 @@ import qualified Data.ByteString as B data CryptState = CryptState - { cstKey :: !Bytes + { cstKey :: !BulkState , cstIV :: !Bytes , cstMacSecret :: !Bytes } deriving (Show) @@ -99,7 +99,7 @@ newRecordState = RecordState { stCipher = Nothing , stCompression = nullCompression - , stCryptState = CryptState B.empty B.empty B.empty + , stCryptState = CryptState BulkStateUninitialized B.empty B.empty , stMacState = MacState 0 } @@ -122,12 +122,12 @@ where digest = macF (cstMacSecret cst) msg cst = stCryptState tstate cipher = fromJust "cipher" $ stCipher tstate - hashf = hashF $ cipherHash cipher + hashA = cipherHash cipher encodedSeq = encodeWord64 $ msSequence $ stMacState tstate (macF, msg) - | ver < TLS10 = (macSSL hashf, B.concat [ encodedSeq, encodeHeaderNoVer hdr, content ]) - | otherwise = (hmac hashf 64, B.concat [ encodedSeq, encodeHeader hdr, content ]) + | ver < TLS10 = (macSSL hashA, B.concat [ encodedSeq, encodeHeaderNoVer hdr, content ]) + | otherwise = (hmac hashA, B.concat [ encodedSeq, encodeHeader hdr, content ]) makeDigest :: Header -> Bytes -> RecordM Bytes makeDigest hdr content = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Struct.hs new/tls-1.2.18/Network/TLS/Struct.hs --- old/tls-1.2.17/Network/TLS/Struct.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Struct.hs 2015-06-19 15:56:01.000000000 +0200 @@ -27,7 +27,13 @@ , TLSError(..) , TLSException(..) , DistinguishedName + , BigNum(..) + , bigNumToInteger + , bigNumFromInteger , ServerDHParams(..) + , serverDHParamsToParams + , serverDHParamsToPublic + , serverDHParamsFrom , ServerECDHParams(..) , ServerRSAParams(..) , ServerKeyXchgAlgorithmData(..) @@ -64,6 +70,7 @@ import Network.TLS.Types import Network.TLS.Crypto.DH import Network.TLS.Crypto.ECDH +import Network.TLS.Util.Serialization #if MIN_VERSION_mtl(2,2,1) #else import Control.Monad.Error @@ -234,9 +241,36 @@ | HandshakeType_NPN -- Next Protocol Negotiation extension deriving (Show,Eq) -data ServerDHParams = ServerDHParams DHParams {- (p,g) -} DHPublic {- y -} +newtype BigNum = BigNum Bytes deriving (Show,Eq) +bigNumToInteger :: BigNum -> Integer +bigNumToInteger (BigNum b) = os2ip b + +bigNumFromInteger :: Integer -> BigNum +bigNumFromInteger i = BigNum $ i2osp i + +data ServerDHParams = ServerDHParams + { serverDHParams_p :: BigNum + , serverDHParams_g :: BigNum + , serverDHParams_y :: BigNum + } deriving (Show,Eq) + +serverDHParamsFrom :: DHParams -> DHPublic -> ServerDHParams +serverDHParamsFrom params dhPub = + ServerDHParams (bigNumFromInteger $ dhParamsGetP params) + (bigNumFromInteger $ dhParamsGetG params) + (bigNumFromInteger $ dhUnwrapPublic dhPub) + +serverDHParamsToParams :: ServerDHParams -> DHParams +serverDHParamsToParams serverParams = + dhParams (bigNumToInteger $ serverDHParams_p serverParams) + (bigNumToInteger $ serverDHParams_g serverParams) + +serverDHParamsToPublic :: ServerDHParams -> DHPublic +serverDHParamsToPublic serverParams = + dhPublic (bigNumToInteger $ serverDHParams_y serverParams) + data ServerECDHParams = ServerECDHParams ECDHParams ECDHPublic deriving (Show,Eq) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Network/TLS/Wire.hs new/tls-1.2.18/Network/TLS/Wire.hs --- old/tls-1.2.17/Network/TLS/Wire.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Network/TLS/Wire.hs 2015-06-19 15:56:01.000000000 +0200 @@ -27,6 +27,7 @@ , getOpaque16 , getOpaque24 , getInteger16 + , getBigNum16 , getList , processBytes , isEmpty @@ -42,6 +43,7 @@ , putOpaque16 , putOpaque24 , putInteger16 + , putBigNum16 , encodeWord16 , encodeWord32 , encodeWord64 @@ -114,6 +116,9 @@ getInteger16 :: Get Integer getInteger16 = os2ip <$> getOpaque16 +getBigNum16 :: Get BigNum +getBigNum16 = BigNum <$> getOpaque16 + getList :: Int -> (Get (Int, a)) -> Get [a] getList totalLen getElement = isolate totalLen (getElements totalLen) where getElements len @@ -162,6 +167,9 @@ putInteger16 :: Integer -> Put putInteger16 = putOpaque16 . i2osp +putBigNum16 :: BigNum -> Put +putBigNum16 (BigNum b) = putOpaque16 b + encodeWord16 :: Word16 -> Bytes encodeWord16 = runPut . putWord16 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Tests/Ciphers.hs new/tls-1.2.18/Tests/Ciphers.hs --- old/tls-1.2.17/Tests/Ciphers.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Tests/Ciphers.hs 2015-06-19 15:56:01.000000000 +0200 @@ -29,15 +29,20 @@ propertyBulkFunctional :: BulkTest -> Bool propertyBulkFunctional (BulkTest bulk key iv t additional) = - case bulkF bulk of - BulkBlockF enc dec -> block enc dec - BulkStreamF ktoi enc dec -> stream ktoi enc dec - BulkAeadF enc dec -> aead enc dec + let enc = bulkInit bulk BulkEncrypt key + dec = bulkInit bulk BulkDecrypt key + in case (enc, dec) of + (BulkStateBlock encF, BulkStateBlock decF) -> block encF decF + (BulkStateAEAD encF, BulkStateAEAD decF) -> aead encF decF + (BulkStateStream (BulkStream encF), BulkStateStream (BulkStream decF)) -> stream encF decF + _ -> True where - block e d = (d key iv . e key iv) t == t - stream ktoi e d = (fst . d siv . fst . e siv) t == t - where siv = ktoi key + block e d = + let (etxt, e_iv) = e iv t + (dtxt, d_iv) = d iv etxt + in dtxt == t && d_iv == e_iv + stream e d = (fst . d . fst . e) t == t aead e d = - let (encrypted, at) = e key iv t additional - (decrypted, at2) = d key iv encrypted additional + let (encrypted, at) = e iv t additional + (decrypted, at2) = d iv encrypted additional in decrypted == t && at == at2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/Tests/Connection.hs new/tls-1.2.18/Tests/Connection.hs --- old/tls-1.2.17/Tests/Connection.hs 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/Tests/Connection.hs 2015-06-19 15:56:01.000000000 +0200 @@ -34,13 +34,9 @@ , bulkKeySize = 16 , bulkIVSize = 16 , bulkBlockSize = 16 - , bulkF = BulkBlockF (\_ _ m -> m) (\_ _ m -> m) - } - , cipherHash = Hash - { hashName = "const-hash" - , hashSize = 16 - , hashF = (\_ -> B.replicate 16 1) + , bulkF = BulkBlockF $ \_ _ _ -> (\m -> (m, B.empty)) } + , cipherHash = MD5 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } @@ -67,9 +63,11 @@ , bulkKeySize = 16 , bulkIVSize = 0 , bulkBlockSize = 0 - , bulkF = BulkStreamF (\k -> k) (\i m -> (m,i)) (\i m -> (m,i)) + , bulkF = BulkStreamF passThrough } } + where + passThrough _ _ = BulkStream go where go inp = (inp, BulkStream go) knownCiphers :: [Cipher] knownCiphers = [blockCipher,blockCipherDHE_RSA,blockCipherDHE_DSS,streamCipher] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.2.17/tls.cabal new/tls-1.2.18/tls.cabal --- old/tls-1.2.17/tls.cabal 2015-04-12 08:21:50.000000000 +0200 +++ new/tls-1.2.18/tls.cabal 2015-06-19 15:56:01.000000000 +0200 @@ -1,5 +1,5 @@ Name: tls -Version: 1.2.17 +Version: 1.2.18 Description: Native Haskell TLS and SSL protocol implementation for server and client. .
