Hello community,
here is the log from the commit of package ghc-tls for openSUSE:Factory checked
in at 2015-08-25 07:19:21
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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-06-23
11:59:32.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-tls.new/ghc-tls.changes 2015-08-25
08:48:26.000000000 +0200
@@ -1,0 +2,7 @@
+Thu Aug 6 20:43:26 UTC 2015 - mimi...@gmail.com
+
+- update to 1.3.1
+* Repair DHE RSA handling on the cipher by creating signature properly
+* modernize the crypto stack by using cryptonite.
+
+-------------------------------------------------------------------
Old:
----
tls-1.2.18.tar.gz
New:
----
tls-1.3.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-tls.spec ++++++
--- /var/tmp/diff_new_pack.6HLH8V/_old 2015-08-25 08:48:27.000000000 +0200
+++ /var/tmp/diff_new_pack.6HLH8V/_new 2015-08-25 08:48:27.000000000 +0200
@@ -21,7 +21,7 @@
%bcond_with tests
Name: ghc-tls
-Version: 1.2.18
+Version: 1.3.1
Release: 0
Summary: TLS/SSL protocol native implementation (Server and Client)
License: BSD-3-Clause
@@ -40,15 +40,7 @@
BuildRequires: ghc-byteable-devel
BuildRequires: ghc-bytestring-devel
BuildRequires: ghc-cereal-devel
-BuildRequires: ghc-cipher-aes-devel
-BuildRequires: ghc-cipher-des-devel
-BuildRequires: ghc-cipher-rc4-devel
-BuildRequires: ghc-crypto-cipher-types-devel
-BuildRequires: ghc-crypto-numbers-devel
-BuildRequires: ghc-crypto-pubkey-devel
-BuildRequires: ghc-crypto-pubkey-types-devel
-BuildRequires: ghc-crypto-random-devel
-BuildRequires: ghc-cryptohash-devel
+BuildRequires: ghc-cryptonite-devel
BuildRequires: ghc-data-default-class-devel
BuildRequires: ghc-mtl-devel
BuildRequires: ghc-network-devel
++++++ tls-1.2.18.tar.gz -> tls-1.3.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/CHANGELOG.md new/tls-1.3.1/CHANGELOG.md
--- old/tls-1.2.18/CHANGELOG.md 2015-06-19 15:56:01.000000000 +0200
+++ new/tls-1.3.1/CHANGELOG.md 2015-06-20 09:31:09.000000000 +0200
@@ -1,3 +1,11 @@
+## Version 1.3.1
+
+- Repair DHE RSA handling on the cipher by creating signature properly
+
+## Version 1.3.0
+
+- modernize the crypto stack by using cryptonite.
+
## Version 1.2.18
- add more tests (network, local)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Context.hs
new/tls-1.3.1/Network/TLS/Context.hs
--- old/tls-1.2.18/Network/TLS/Context.hs 2015-06-19 15:56:01.000000000
+0200
+++ new/tls-1.3.1/Network/TLS/Context.hs 2015-06-20 09:31:09.000000000
+0200
@@ -72,10 +72,9 @@
import Network.TLS.Types (Role(..))
import Network.TLS.Handshake (handshakeClient, handshakeClientWith,
handshakeServer, handshakeServerWith)
import Network.TLS.X509
+import Network.TLS.RNG
import Data.Maybe (isJust)
-import Crypto.Random
-
import Control.Concurrent.MVar
import Control.Monad.State
import Data.IORef
@@ -133,14 +132,15 @@
doHandshakeWith = handshakeServerWith
-- | create a new context using the backend and parameters specified.
-contextNew :: (MonadIO m, CPRG rng, HasBackend backend, TLSParams params)
+contextNew :: (MonadIO m, HasBackend backend, TLSParams params)
=> backend -- ^ Backend abstraction with specific method to
interact with the connection type.
-> params -- ^ Parameters of the context.
- -> rng -- ^ Random number generator associated with this
context.
-> m Context
-contextNew backend params rng = liftIO $ do
+contextNew backend params = liftIO $ do
initializeBackend backend
+ rng <- newStateRNG
+
let role = getTLSRole params
st = newTLSState rng role
(supported, shared) = getTLSCommonParams params
@@ -187,21 +187,19 @@
}
-- | create a new context on an handle.
-contextNewOnHandle :: (MonadIO m, CPRG rng, TLSParams params)
+contextNewOnHandle :: (MonadIO m, TLSParams params)
=> Handle -- ^ Handle of the connection.
-> params -- ^ Parameters of the context.
- -> rng -- ^ Random number generator associated with this
context.
-> m Context
-contextNewOnHandle handle params st = contextNew handle params st
+contextNewOnHandle handle params = contextNew handle params
{-# DEPRECATED contextNewOnHandle "use contextNew" #-}
-- | create a new context on a socket.
-contextNewOnSocket :: (MonadIO m, CPRG rng, TLSParams params)
+contextNewOnSocket :: (MonadIO m, TLSParams params)
=> Socket -- ^ Socket of the connection.
-> params -- ^ Parameters of the context.
- -> rng -- ^ Random number generator associated with this
context.
-> m Context
-contextNewOnSocket sock params st = contextNew sock params st
+contextNewOnSocket sock params = contextNew sock params
{-# DEPRECATED contextNewOnSocket "use contextNew" #-}
contextHookSetHandshakeRecv :: Context -> (Handshake -> IO Handshake) -> IO ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Crypto/DH.hs
new/tls-1.3.1/Network/TLS/Crypto/DH.hs
--- old/tls-1.2.18/Network/TLS/Crypto/DH.hs 2015-06-19 15:56:01.000000000
+0200
+++ new/tls-1.3.1/Network/TLS/Crypto/DH.hs 2015-06-20 09:31:09.000000000
+0200
@@ -19,8 +19,7 @@
import Network.TLS.Util.Serialization (i2osp)
import qualified Crypto.PubKey.DH as DH
-import qualified Crypto.Types.PubKey.DH as DH
-import Crypto.Random (CPRG)
+import Network.TLS.RNG
import Data.ByteString (ByteString)
type DHPublic = DH.PublicNumber
@@ -37,11 +36,11 @@
dhParams :: Integer -> Integer -> DHParams
dhParams = DH.Params
-dhGenerateKeyPair :: CPRG g => g -> DHParams -> ((DHPrivate, DHPublic), g)
-dhGenerateKeyPair rng params =
- let (priv, g') = DH.generatePrivate rng params
- pub = DH.generatePublic params priv
- in ((priv, pub), g')
+dhGenerateKeyPair :: MonadRandom r => DHParams -> r (DHPrivate, DHPublic)
+dhGenerateKeyPair params = do
+ priv <- DH.generatePrivate params
+ let pub = DH.generatePublic params priv
+ return (priv, pub)
dhGetShared :: DHParams -> DHPrivate -> DHPublic -> DHKey
dhGetShared params priv pub =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Crypto/ECDH.hs
new/tls-1.3.1/Network/TLS/Crypto/ECDH.hs
--- old/tls-1.2.18/Network/TLS/Crypto/ECDH.hs 2015-06-19 15:56:01.000000000
+0200
+++ new/tls-1.3.1/Network/TLS/Crypto/ECDH.hs 2015-06-20 09:31:09.000000000
+0200
@@ -18,17 +18,20 @@
import Network.TLS.Util.Serialization (i2osp, lengthBytes)
import Network.TLS.Extension.EC
import qualified Crypto.PubKey.ECC.DH as ECDH
-import qualified Crypto.Types.PubKey.ECC as ECDH
+import qualified Crypto.PubKey.ECC.Types as ECDH
import qualified Crypto.PubKey.ECC.Prim as ECC (isPointValid)
-import Crypto.Random (CPRG)
+import Network.TLS.RNG
import Data.ByteString (ByteString)
import Data.Word (Word16)
-data ECDHPublic = ECDHPublic ECDH.PublicPoint Int {- byte size -}
- deriving (Show,Eq)
+data ECDHPublic = ECDHPublic ECDH.PublicPoint Int {- byte size -}
+ deriving (Show,Eq)
+
newtype ECDHPrivate = ECDHPrivate ECDH.PrivateNumber deriving (Show,Eq)
-data ECDHParams = ECDHParams ECDH.Curve ECDH.CurveName deriving (Show,Eq)
-type ECDHKey = ByteString
+
+data ECDHParams = ECDHParams ECDH.Curve ECDH.CurveName deriving (Show,Eq)
+
+type ECDHKey = ByteString
ecdhPublic :: Integer -> Integer -> Int -> ECDHPublic
ecdhPublic x y siz = ECDHPublic (ECDH.Point x y) siz
@@ -42,13 +45,13 @@
Just name = toCurveName w16 -- FIXME
curve = ECDH.getCurveByName name
-ecdhGenerateKeyPair :: CPRG g => g -> ECDHParams -> ((ECDHPrivate,
ECDHPublic), g)
-ecdhGenerateKeyPair rng (ECDHParams curve _) =
- let (priv, g') = ECDH.generatePrivate rng curve
- siz = pointSize curve
+ecdhGenerateKeyPair :: MonadRandom r => ECDHParams -> r (ECDHPrivate,
ECDHPublic)
+ecdhGenerateKeyPair (ECDHParams curve _) = do
+ priv <- ECDH.generatePrivate curve
+ let siz = pointSize curve
point = ECDH.calculatePublic curve priv
pub = ECDHPublic point siz
- in ((ECDHPrivate priv, pub), g')
+ return (ECDHPrivate priv, pub)
ecdhGetShared :: ECDHParams -> ECDHPrivate -> ECDHPublic -> Maybe ECDHKey
ecdhGetShared (ECDHParams curve _) (ECDHPrivate priv) (ECDHPublic point _)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Crypto.hs
new/tls-1.3.1/Network/TLS/Crypto.hs
--- old/tls-1.2.18/Network/TLS/Crypto.hs 2015-06-19 15:56:01.000000000
+0200
+++ new/tls-1.3.1/Network/TLS/Crypto.hs 2015-06-20 09:31:09.000000000 +0200
@@ -23,7 +23,6 @@
, PrivKey(..)
, PublicKey
, PrivateKey
- , HashDescr(..)
, kxEncrypt
, kxDecrypt
, kxSign
@@ -33,13 +32,13 @@
import qualified Crypto.Hash as H
import qualified Data.ByteString as B
-import qualified Data.Byteable as B
+import qualified Data.ByteArray as B (convert)
import Data.ByteString (ByteString)
-import Crypto.PubKey.HashDescr
+import Crypto.Random
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.RSA.PKCS15 as RSA
-import Crypto.Random
+
import Data.X509 (PrivKey(..), PubKey(..))
import Network.TLS.Crypto.DH
import Network.TLS.Crypto.ECDH
@@ -62,7 +61,9 @@
hashInit :: Hash -> HashContext
hashInit MD5 = HashContext $ ContextSimple (H.hashInit :: H.Context H.MD5)
hashInit SHA1 = HashContext $ ContextSimple (H.hashInit :: H.Context
H.SHA1)
+hashInit SHA224 = HashContext $ ContextSimple (H.hashInit :: H.Context
H.SHA224)
hashInit SHA256 = HashContext $ ContextSimple (H.hashInit :: H.Context
H.SHA256)
+hashInit SHA384 = HashContext $ ContextSimple (H.hashInit :: H.Context
H.SHA384)
hashInit SHA512 = HashContext $ ContextSimple (H.hashInit :: H.Context
H.SHA512)
hashInit SHA1_MD5 = HashContextSSL H.hashInit H.hashInit
@@ -79,11 +80,11 @@
HashContextSSL (H.hashUpdate sha1Ctx b2) (H.hashUpdate md5Ctx b1)
hashFinal :: HashCtx -> B.ByteString
-hashFinal (HashContext (ContextSimple h)) = B.toBytes $ H.hashFinalize h
+hashFinal (HashContext (ContextSimple h)) = B.convert $ H.hashFinalize h
hashFinal (HashContextSSL sha1Ctx md5Ctx) =
- B.concat [B.toBytes (H.hashFinalize md5Ctx), B.toBytes (H.hashFinalize
sha1Ctx)]
+ B.concat [B.convert (H.hashFinalize md5Ctx), B.convert (H.hashFinalize
sha1Ctx)]
-data Hash = MD5 | SHA1 | SHA256 | SHA512 | SHA1_MD5
+data Hash = MD5 | SHA1 | SHA224 | SHA256 | SHA384 | SHA512 | SHA1_MD5
deriving (Show,Eq)
data HashContext =
@@ -98,12 +99,14 @@
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 MD5 b = B.convert . (H.hash :: B.ByteString -> H.Digest H.MD5) $ b
+hash SHA1 b = B.convert . (H.hash :: B.ByteString -> H.Digest H.SHA1) $ b
+hash SHA224 b = B.convert . (H.hash :: B.ByteString -> H.Digest H.SHA224) $ b
+hash SHA256 b = B.convert . (H.hash :: B.ByteString -> H.Digest H.SHA256) $ b
+hash SHA384 b = B.convert . (H.hash :: B.ByteString -> H.Digest H.SHA384) $ b
+hash SHA512 b = B.convert . (H.hash :: B.ByteString -> H.Digest H.SHA512) $ b
hash SHA1_MD5 b =
- B.concat [B.toBytes (md5Hash b), B.toBytes (sha1Hash b)]
+ B.concat [B.convert (md5Hash b), B.convert (sha1Hash b)]
where
sha1Hash :: B.ByteString -> H.Digest H.SHA1
sha1Hash = H.hash
@@ -116,52 +119,90 @@
hashDigestSize :: Hash -> Int
hashDigestSize MD5 = 16
hashDigestSize SHA1 = 20
+hashDigestSize SHA224 = 28
hashDigestSize SHA256 = 32
+hashDigestSize SHA384 = 48
hashDigestSize SHA512 = 64
hashDigestSize SHA1_MD5 = 36
hashBlockSize :: Hash -> Int
hashBlockSize MD5 = 64
hashBlockSize SHA1 = 64
+hashBlockSize SHA224 = 64
hashBlockSize SHA256 = 64
+hashBlockSize SHA384 = 128
hashBlockSize SHA512 = 128
hashBlockSize SHA1_MD5 = 64
{- key exchange methods encrypt and decrypt for each supported algorithm -}
-generalizeRSAWithRNG :: CPRG g => (Either RSA.Error a, g) -> (Either KxError
a, g)
-generalizeRSAWithRNG (Left e, g) = (Left (RSAError e), g)
-generalizeRSAWithRNG (Right x, g) = (Right x, g)
-
-kxEncrypt :: CPRG g => g -> PublicKey -> ByteString -> (Either KxError
ByteString, g)
-kxEncrypt g (PubKeyRSA pk) b = generalizeRSAWithRNG $ RSA.encrypt g pk b
-kxEncrypt g _ _ = (Left KxUnsupported, g)
-
-kxDecrypt :: CPRG g => g -> PrivateKey -> ByteString -> (Either KxError
ByteString, g)
-kxDecrypt g (PrivKeyRSA pk) b = generalizeRSAWithRNG $ RSA.decryptSafer g pk b
-kxDecrypt g _ _ = (Left KxUnsupported, g)
+generalizeRSAError :: Either RSA.Error a -> Either KxError a
+generalizeRSAError (Left e) = Left (RSAError e)
+generalizeRSAError (Right x) = Right x
+
+kxEncrypt :: MonadRandom r => PublicKey -> ByteString -> r (Either KxError
ByteString)
+kxEncrypt (PubKeyRSA pk) b = generalizeRSAError `fmap` RSA.encrypt pk b
+kxEncrypt _ _ = return (Left KxUnsupported)
+
+kxDecrypt :: MonadRandom r => PrivateKey -> ByteString -> r (Either KxError
ByteString)
+kxDecrypt (PrivKeyRSA pk) b = generalizeRSAError `fmap` RSA.decryptSafer pk b
+kxDecrypt _ _ = return (Left KxUnsupported)
-- Verify that the signature matches the given message, using the
-- public key.
--
-kxVerify :: PublicKey -> HashDescr -> ByteString -> ByteString -> Bool
-kxVerify (PubKeyRSA pk) hashDescr msg sign = RSA.verify hashDescr pk msg sign
-kxVerify (PubKeyDSA pk) hashDescr msg signBS =
- case signature of
- Right (sig, []) -> DSA.verify (hashFunction hashDescr) pk sig msg
- _ -> False
- where signature = case decodeASN1' BER signBS of
- Left err -> Left (show err)
- Right asn1s -> fromASN1 asn1s
+kxVerify :: PublicKey -> Hash -> ByteString -> ByteString -> Bool
+kxVerify (PubKeyRSA pk) alg msg sign = rsaVerifyHash alg pk msg sign
+kxVerify (PubKeyDSA pk) _ msg signBS =
+ case dsaToSignature signBS of
+ Just sig -> DSA.verify H.SHA1 pk sig msg
+ _ -> False
+ where
+ dsaToSignature :: ByteString -> Maybe DSA.Signature
+ dsaToSignature b =
+ case decodeASN1' BER b of
+ Left _ -> Nothing
+ Right asn1 ->
+ case asn1 of
+ Start Sequence:IntVal r:IntVal s:End Sequence:_ ->
+ Just $ DSA.Signature { DSA.sign_r = r, DSA.sign_s
= s }
+ _ ->
+ Nothing
kxVerify _ _ _ _ = False
-- Sign the given message using the private key.
--
-kxSign :: CPRG g => g -> PrivateKey -> HashDescr -> ByteString -> (Either
KxError ByteString, g)
-kxSign g (PrivKeyRSA pk) hashDescr msg =
- generalizeRSAWithRNG $ RSA.signSafer g hashDescr pk msg
-kxSign g (PrivKeyDSA pk) hashDescr msg =
- let (sign, g') = DSA.sign g pk (hashFunction hashDescr) msg
- in (Right $ encodeASN1' DER $ toASN1 sign [], g')
+kxSign :: MonadRandom r
+ => PrivateKey
+ -> Hash
+ -> ByteString
+ -> r (Either KxError ByteString)
+kxSign (PrivKeyRSA pk) hashAlg msg =
+ generalizeRSAError `fmap` rsaSignHash hashAlg pk msg
+kxSign (PrivKeyDSA pk) _ msg = do
+ sign <- DSA.sign pk H.SHA1 msg
+ return (Right $ encodeASN1' DER $ dsaSequence sign)
+ where dsaSequence sign = [Start Sequence,IntVal (DSA.sign_r sign),IntVal
(DSA.sign_s sign),End Sequence]
--kxSign g _ _ _ =
-- (Left KxUnsupported, g)
+
+rsaSignHash :: MonadRandom m => Hash -> RSA.PrivateKey -> ByteString -> m
(Either RSA.Error ByteString)
+rsaSignHash SHA1_MD5 pk msg = RSA.signSafer noHash pk msg
+rsaSignHash MD5 pk msg = RSA.signSafer (Just H.MD5) pk msg
+rsaSignHash SHA1 pk msg = RSA.signSafer (Just H.SHA1) pk msg
+rsaSignHash SHA224 pk msg = RSA.signSafer (Just H.SHA224) pk msg
+rsaSignHash SHA256 pk msg = RSA.signSafer (Just H.SHA256) pk msg
+rsaSignHash SHA384 pk msg = RSA.signSafer (Just H.SHA384) pk msg
+rsaSignHash SHA512 pk msg = RSA.signSafer (Just H.SHA512) pk msg
+
+rsaVerifyHash :: Hash -> RSA.PublicKey -> ByteString -> ByteString -> Bool
+rsaVerifyHash SHA1_MD5 = RSA.verify noHash
+rsaVerifyHash MD5 = RSA.verify (Just H.MD5)
+rsaVerifyHash SHA1 = RSA.verify (Just H.SHA1)
+rsaVerifyHash SHA224 = RSA.verify (Just H.SHA224)
+rsaVerifyHash SHA256 = RSA.verify (Just H.SHA256)
+rsaVerifyHash SHA384 = RSA.verify (Just H.SHA384)
+rsaVerifyHash SHA512 = RSA.verify (Just H.SHA512)
+
+noHash :: Maybe H.MD5
+noHash = Nothing
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Extension/EC.hs
new/tls-1.3.1/Network/TLS/Extension/EC.hs
--- old/tls-1.2.18/Network/TLS/Extension/EC.hs 2015-06-19 15:56:01.000000000
+0200
+++ new/tls-1.3.1/Network/TLS/Extension/EC.hs 2015-06-20 09:31:09.000000000
+0200
@@ -4,7 +4,7 @@
, fromCurveName
) where
-import Crypto.Types.PubKey.ECC (CurveName(..))
+import Crypto.PubKey.ECC.Types (CurveName(..))
import Data.Word (Word16)
toCurveName :: Word16 -> Maybe CurveName
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Extra/Cipher.hs
new/tls-1.3.1/Network/TLS/Extra/Cipher.hs
--- old/tls-1.2.18/Network/TLS/Extra/Cipher.hs 2015-06-19 15:56:01.000000000
+0200
+++ new/tls-1.3.1/Network/TLS/Extra/Cipher.hs 2015-06-20 09:31:09.000000000
+0200
@@ -41,57 +41,70 @@
import Network.TLS (Version(..))
import Network.TLS.Cipher
-import qualified "cipher-rc4" Crypto.Cipher.RC4 as RC4
+import Data.Tuple (swap)
-import qualified "cipher-aes" Crypto.Cipher.AES as AES
+import Crypto.Cipher.AES
+import qualified Crypto.Cipher.RC4 as RC4
import Crypto.Cipher.TripleDES
-import Crypto.Cipher.Types (makeKey, makeIV, cipherInit, cbcEncrypt,
cbcDecrypt)
-import qualified Crypto.Cipher.Types as T
-
+import Crypto.Cipher.Types hiding (Cipher, cipherName)
+import Crypto.Error
takelast :: Int -> B.ByteString -> B.ByteString
takelast i b = B.drop (B.length b - i) b
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))
+ let ctx = noFail (cipherInit key) :: AES128
+ in (\iv input -> let output = cbcEncrypt ctx (makeIV_ 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))
+ let ctx = noFail (cipherInit key) :: AES128
+ in (\iv input -> let output = cbcDecrypt ctx (makeIV_ 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))
+ let ctx = noFail (cipherInit key) :: AES256
+ in (\iv input -> let output = cbcEncrypt ctx (makeIV_ 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))
+ let ctx = noFail (cipherInit key) :: AES256
+ in (\iv input -> let output = cbcDecrypt ctx (makeIV_ 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)
+ let ctx = noFail (cipherInit key) :: AES128
+ in (\nonce d ad ->
+ let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)
+ in swap $ aeadSimpleEncrypt aeadIni ad d 16)
aes128gcm BulkDecrypt key =
- let ctx = AES.initAES key
- in (\nonce d ad -> AES.decryptGCM ctx nonce ad d)
+ let ctx = noFail (cipherInit key) :: AES128
+ in (\nonce d ad ->
+ let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)
+ in simpleDecrypt aeadIni ad d)
+ where
+ simpleDecrypt aeadIni header input = (output, tag)
+ where
+ aead = aeadAppendHeader aeadIni header
+ (output, aeadFinal) = aeadDecrypt aead input
+ tag = aeadFinalize aeadFinal 16
+
+noFail :: CryptoFailable a -> a
+noFail = throwCryptoError
+
+makeIV_ :: BlockCipher a => B.ByteString -> IV a
+makeIV_ = maybe (error "makeIV_") id . makeIV
tripledes_ede :: BulkDirection -> BulkKey -> BulkBlock
tripledes_ede BulkEncrypt key =
- let ctx = cipherInit (tripledes_key key)
+ let ctx = noFail $ cipherInit 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)
+ let ctx = noFail $ cipherInit key
in (\iv input -> let output = cbcDecrypt ctx (tripledes_iv iv) input in
(output, takelast 16 input))
-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 :: BulkIV -> T.IV DES_EDE3
+tripledes_iv :: BulkIV -> IV DES_EDE3
tripledes_iv iv = maybe (error "tripledes cipher iv internal error") id $
makeIV iv
rc4 :: BulkDirection -> BulkKey -> BulkStream
-rc4 _ bulkKey = BulkStream (combineRC4 $ RC4.initCtx bulkKey)
+rc4 _ bulkKey = BulkStream (combineRC4 $ RC4.initialize bulkKey)
where
combineRC4 ctx input =
let (ctx', output) = RC4.combine ctx input
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Handshake/Client.hs
new/tls-1.3.1/Network/TLS/Handshake/Client.hs
--- old/tls-1.2.18/Network/TLS/Handshake/Client.hs 2015-06-19
15:56:01.000000000 +0200
+++ new/tls-1.3.1/Network/TLS/Handshake/Client.hs 2015-06-20
09:31:09.000000000 +0200
@@ -396,7 +396,7 @@
doECDHESignature ecdhparams signature signatureType = do
-- TODO verify DHParams
verified <- digitallySignECDHParamsVerify ctx ecdhparams
signatureType signature
- when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show
signatureType ++ " for dhparams", True, HandshakeFailure)
+ when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show
signatureType ++ " for ecdhparams", True, HandshakeFailure)
usingHState ctx $ setServerECDHParams ecdhparams
processServerKeyExchange ctx p = processCertificateRequest ctx p
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Handshake/Key.hs
new/tls-1.3.1/Network/TLS/Handshake/Key.hs
--- old/tls-1.2.18/Network/TLS/Handshake/Key.hs 2015-06-19 15:56:01.000000000
+0200
+++ new/tls-1.3.1/Network/TLS/Handshake/Key.hs 2015-06-20 09:31:09.000000000
+0200
@@ -32,16 +32,16 @@
encryptRSA ctx content = do
publicKey <- usingHState ctx getRemotePublicKey
usingState_ ctx $ do
- v <- withRNG (\g -> kxEncrypt g publicKey content)
+ v <- withRNG $ kxEncrypt publicKey content
case v of
Left err -> fail ("rsa encrypt failed: " ++ show err)
Right econtent -> return econtent
-signRSA :: Context -> Role -> HashDescr -> ByteString -> IO ByteString
+signRSA :: Context -> Role -> Hash -> ByteString -> IO ByteString
signRSA ctx _ hsh content = do
privateKey <- usingHState ctx getLocalPrivateKey
usingState_ ctx $ do
- r <- withRNG (\g -> kxSign g privateKey hsh content)
+ r <- withRNG $ kxSign privateKey hsh content
case r of
Left err -> fail ("rsa sign failed: " ++ show err)
Right econtent -> return econtent
@@ -50,17 +50,17 @@
decryptRSA ctx econtent = do
privateKey <- usingHState ctx getLocalPrivateKey
usingState_ ctx $ do
- ver <- getVersion
+ ver <- getVersion
let cipher = if ver < TLS10 then econtent else B.drop 2 econtent
- withRNG (\g -> kxDecrypt g privateKey cipher)
+ withRNG $ kxDecrypt privateKey cipher
-verifyRSA :: Context -> Role -> HashDescr -> ByteString -> ByteString -> IO
Bool
+verifyRSA :: Context -> Role -> Hash -> ByteString -> ByteString -> IO Bool
verifyRSA ctx _ hsh econtent sign = do
publicKey <- usingHState ctx getRemotePublicKey
return $ kxVerify publicKey hsh econtent sign
generateDHE :: Context -> DHParams -> IO (DHPrivate, DHPublic)
-generateDHE ctx dhp = usingState_ ctx $ withRNG $ \rng -> dhGenerateKeyPair
rng dhp
+generateDHE ctx dhp = usingState_ ctx $ withRNG $ dhGenerateKeyPair dhp
generateECDHE :: Context -> ECDHParams -> IO (ECDHPrivate, ECDHPublic)
-generateECDHE ctx dhp = usingState_ ctx $ withRNG $ \rng ->
ecdhGenerateKeyPair rng dhp
+generateECDHE ctx dhp = usingState_ ctx $ withRNG $ ecdhGenerateKeyPair dhp
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Handshake/Signature.hs
new/tls-1.3.1/Network/TLS/Handshake/Signature.hs
--- old/tls-1.2.18/Network/TLS/Handshake/Signature.hs 2015-06-19
15:56:01.000000000 +0200
+++ new/tls-1.3.1/Network/TLS/Handshake/Signature.hs 2015-06-20
09:31:09.000000000 +0200
@@ -16,7 +16,6 @@
, digitallySignECDHParamsVerify
) where
-import Crypto.PubKey.HashDescr
import Network.TLS.Crypto
import Network.TLS.Context.Internal
import Network.TLS.Struct
@@ -36,86 +35,93 @@
-> Bytes
-> DigitallySigned
-> IO Bool
-certificateVerifyCheck ctx usedVersion malg msgs dsig = do
- (hashMethod, toVerify) <- prepareCertificateVerifySignatureData ctx
usedVersion malg msgs
- signatureVerifyWithHashDescr ctx SignatureRSA hashMethod toVerify dsig
+certificateVerifyCheck ctx usedVersion malg msgs dsig =
+ prepareCertificateVerifySignatureData ctx usedVersion malg msgs >>=
+ signatureVerifyWithHashDescr ctx SignatureRSA 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
+certificateVerifyCreate ctx usedVersion malg msgs =
+ prepareCertificateVerifySignatureData ctx usedVersion malg msgs >>=
+ signatureCreate ctx malg
-getHashAndASN1 :: MonadIO m => (HashAlgorithm, SignatureAlgorithm) -> m
HashDescr
+getHashAndASN1 :: MonadIO m => (HashAlgorithm, SignatureAlgorithm) -> m Hash
getHashAndASN1 hashSig = case hashSig of
- (HashSHA1, SignatureRSA) -> return hashDescrSHA1
- (HashSHA224, SignatureRSA) -> return hashDescrSHA224
- (HashSHA256, SignatureRSA) -> return hashDescrSHA256
- (HashSHA384, SignatureRSA) -> return hashDescrSHA384
- (HashSHA512, SignatureRSA) -> return hashDescrSHA512
+ (HashSHA1, SignatureRSA) -> return SHA1
+ (HashSHA224, SignatureRSA) -> return SHA224
+ (HashSHA256, SignatureRSA) -> return SHA256
+ (HashSHA384, SignatureRSA) -> return SHA384
+ (HashSHA512, SignatureRSA) -> return SHA512
_ -> throwCore $ Error_Misc "unsupported hash/sig
algorithm"
+type CertVerifyData = (Hash, Bytes)
+
prepareCertificateVerifySignatureData :: Context
-> Version
-> Maybe HashAndSignatureAlgorithm
-> Bytes
- -> IO (HashDescr, Bytes)
+ -> IO CertVerifyData
prepareCertificateVerifySignatureData ctx usedVersion malg msgs
| usedVersion == SSL3 = do
Just masterSecret <- usingHState ctx $ gets hstMasterSecret
- let digest = generateCertificateVerify_SSL masterSecret (hashUpdate
(hashInit SHA1_MD5) msgs)
- hsh = HashDescr id id
- return (hsh, digest)
+ return (SHA1_MD5, generateCertificateVerify_SSL masterSecret
(hashUpdate (hashInit SHA1_MD5) msgs))
| usedVersion == TLS10 || usedVersion == TLS11 = do
- let hashf bs = hashFinal (hashUpdate (hashInit SHA1_MD5) bs)
- hsh = HashDescr hashf id
- return (hsh, msgs)
+ return (SHA1_MD5, hashFinal $ hashUpdate (hashInit SHA1_MD5) msgs)
| otherwise = do
let Just hashSig = malg
hsh <- getHashAndASN1 hashSig
return (hsh, msgs)
-signatureHashData :: SignatureAlgorithm -> Maybe HashAlgorithm -> HashDescr
+signatureHashData :: SignatureAlgorithm -> Maybe HashAlgorithm -> Hash
signatureHashData SignatureRSA mhash =
case mhash of
- Just HashSHA512 -> hashDescrSHA512
- Just HashSHA256 -> hashDescrSHA256
- Just HashSHA1 -> hashDescrSHA1
- Nothing -> HashDescr (hashFinal . hashUpdate (hashInit
SHA1_MD5)) id
+ Just HashSHA512 -> SHA512
+ Just HashSHA256 -> SHA256
+ Just HashSHA1 -> SHA1
+ Nothing -> SHA1_MD5
_ -> error ("unimplemented signature hash type")
signatureHashData SignatureDSS mhash =
case mhash of
- Nothing -> hashDescrSHA1
- Just HashSHA1 -> hashDescrSHA1
+ Nothing -> SHA1
+ Just HashSHA1 -> SHA1
Just _ -> error "invalid DSA hash choice, only SHA1 allowed"
signatureHashData sig _ = error ("unimplemented signature type: " ++ show sig)
-signatureCreate :: Context -> Maybe HashAndSignatureAlgorithm -> HashDescr ->
Bytes -> IO DigitallySigned
-signatureCreate ctx malg hashMethod toSign = do
+--signatureCreate :: Context -> Maybe HashAndSignatureAlgorithm -> HashDescr
-> Bytes -> IO DigitallySigned
+signatureCreate :: Context -> Maybe HashAndSignatureAlgorithm ->
CertVerifyData -> IO DigitallySigned
+signatureCreate ctx malg (hashAlg, toSign) = do
cc <- usingState_ ctx $ isClientContext
- DigitallySigned malg <$> signRSA ctx cc hashMethod toSign
+ let signData =
+ case (malg, hashAlg) of
+ (Nothing, SHA1_MD5) -> hashFinal $ hashUpdate (hashInit
SHA1_MD5) toSign
+ _ -> toSign
+ DigitallySigned malg <$> signRSA ctx cc hashAlg signData
-signatureVerify :: Context -> SignatureAlgorithm -> Bytes -> DigitallySigned
-> IO Bool
-signatureVerify ctx sigAlgExpected toVerify digSig@(DigitallySigned hashSigAlg
_) = do
+signatureVerify :: Context -> DigitallySigned -> SignatureAlgorithm -> Bytes
-> IO Bool
+signatureVerify ctx digSig@(DigitallySigned hashSigAlg _) sigAlgExpected
toVerifyData = do
usedVersion <- usingState_ ctx getVersion
- let hashDescr = case (usedVersion, hashSigAlg) of
- (TLS12, Nothing) -> error "expecting hash and signature
algorithm in a TLS12 digitally signed structure"
- (TLS12, Just (h,s)) | s == sigAlgExpected -> signatureHashData
sigAlgExpected (Just h)
- | otherwise -> error "expecting
different signature algorithm"
- (_, Nothing) -> signatureHashData sigAlgExpected Nothing
- (_, Just _) -> error "not expecting hash and signature
algorithm in a < TLS12 digitially signed structure"
- signatureVerifyWithHashDescr ctx sigAlgExpected hashDescr toVerify digSig
+ -- in the case of TLS < 1.2, RSA signing, then the data need to be hashed
first, as
+ -- the SHA_MD5 algorithm expect an already digested data
+ let (hashDescr, toVerify) =
+ case (usedVersion, hashSigAlg) of
+ (TLS12, Nothing) -> error "expecting hash and signature
algorithm in a TLS12 digitally signed structure"
+ (TLS12, Just (h,s)) | s == sigAlgExpected ->
(signatureHashData sigAlgExpected (Just h), toVerifyData)
+ | otherwise -> error "expecting
different signature algorithm"
+ (_, Nothing) -> case signatureHashData sigAlgExpected
Nothing of
+ SHA1_MD5 -> (SHA1_MD5, hashFinal $
hashUpdate (hashInit SHA1_MD5) toVerifyData)
+ alg -> (alg, toVerifyData)
+ (_, Just _) -> error "not expecting hash and signature
algorithm in a < TLS12 digitially signed structure"
+ signatureVerifyWithHashDescr ctx sigAlgExpected digSig (hashDescr,
toVerify)
signatureVerifyWithHashDescr :: Context
-> SignatureAlgorithm
- -> HashDescr
- -> Bytes
-> DigitallySigned
+ -> CertVerifyData
-> IO Bool
-signatureVerifyWithHashDescr ctx sigAlgExpected hashDescr toVerify
(DigitallySigned _ bs) = do
+signatureVerifyWithHashDescr ctx sigAlgExpected (DigitallySigned _ bs)
(hashDescr, toVerify) = do
cc <- usingState_ ctx $ isClientContext
case sigAlgExpected of
SignatureRSA -> verifyRSA ctx cc hashDescr toVerify bs
@@ -131,7 +137,7 @@
x:_ -> Just (fst x)
_ -> Nothing
let hashDescr = signatureHashData sigAlg mhash
- signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) hashDescr
signatureData
+ signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) (hashDescr,
signatureData)
digitallySignDHParams :: Context
-> ServerDHParams
@@ -156,7 +162,7 @@
-> IO Bool
digitallySignDHParamsVerify ctx dhparams sigAlg signature = do
expectedData <- withClientAndServerRandom ctx $ encodeSignedDHParams
dhparams
- signatureVerify ctx sigAlg expectedData signature
+ signatureVerify ctx signature sigAlg expectedData
digitallySignECDHParamsVerify :: Context
-> ServerECDHParams
@@ -165,7 +171,7 @@
-> IO Bool
digitallySignECDHParamsVerify ctx dhparams sigAlg signature = do
expectedData <- withClientAndServerRandom ctx $ encodeSignedECDHParams
dhparams
- signatureVerify ctx sigAlg expectedData signature
+ signatureVerify ctx signature sigAlg expectedData
withClientAndServerRandom :: Context -> (ClientRandom -> ServerRandom -> b) ->
IO b
withClientAndServerRandom ctx f = do
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/RNG.hs
new/tls-1.3.1/Network/TLS/RNG.hs
--- old/tls-1.2.18/Network/TLS/RNG.hs 2015-06-19 15:56:01.000000000 +0200
+++ new/tls-1.3.1/Network/TLS/RNG.hs 2015-06-20 09:31:09.000000000 +0200
@@ -1,17 +1,24 @@
-{-# LANGUAGE ExistentialQuantification, RankNTypes #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Network.TLS.RNG
( StateRNG(..)
, withTLSRNG
+ , newStateRNG
+ , MonadRandom
+ , getRandomBytes
) where
import Crypto.Random
-data StateRNG = forall g . CPRG g => StateRNG g
+newtype StateRNG = StateRNG ChaChaDRG
+ deriving (DRG)
instance Show StateRNG where
show _ = "rng[..]"
-withTLSRNG :: StateRNG -> (forall g . CPRG g => g -> (a,g)) -> (a, StateRNG)
-withTLSRNG (StateRNG rng) f = let (a, rng') = f rng
- in (a, StateRNG rng')
+withTLSRNG :: StateRNG
+ -> MonadPseudoRandom StateRNG a
+ -> (a, StateRNG)
+withTLSRNG rng f = withDRG rng f
+newStateRNG :: MonadRandom randomly => randomly StateRNG
+newStateRNG = StateRNG `fmap` drgNew
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Record/Disengage.hs
new/tls-1.3.1/Network/TLS/Record/Disengage.hs
--- old/tls-1.2.18/Network/TLS/Record/Disengage.hs 2015-06-19
15:56:01.000000000 +0200
+++ new/tls-1.3.1/Network/TLS/Record/Disengage.hs 2015-06-20
09:31:09.000000000 +0200
@@ -30,6 +30,7 @@
import Network.TLS.Packet
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
+import qualified Data.ByteArray as B (convert)
disengageRecord :: Record Ciphertext -> RecordM (Record Plaintext)
disengageRecord = decryptRecord >=> uncompressRecord
@@ -126,7 +127,7 @@
nonce = cstIV (stCryptState tst) `B.append` enonce
(content, authTag2) = decryptF nonce econtent' ad
- when (AuthTag authTag /= authTag2) $
+ when (AuthTag (B.convert authTag) /= authTag2) $
throwError $ Error_Protocol ("bad record mac", True,
BadRecordMac)
modify incrRecordState
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Record/Engage.hs
new/tls-1.3.1/Network/TLS/Record/Engage.hs
--- old/tls-1.2.18/Network/TLS/Record/Engage.hs 2015-06-19 15:56:01.000000000
+0200
+++ new/tls-1.3.1/Network/TLS/Record/Engage.hs 2015-06-20 09:31:09.000000000
+0200
@@ -26,6 +26,7 @@
import Network.TLS.Packet
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
+import qualified Data.ByteArray as B (convert)
engageRecord :: Record Plaintext -> RecordM (Record Ciphertext)
engageRecord = compressRecord >=> encryptRecord
@@ -107,7 +108,7 @@
nonce = B.concat [salt, processorNum, counter]
let (e, AuthTag authtag) = encryptF nonce content ad
modify incrRecordState
- return $ B.concat [processorNum, counter, e, authtag]
+ return $ B.concat [processorNum, counter, e, B.convert authtag]
getCryptState :: RecordM CryptState
getCryptState = stCryptState <$> get
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/State.hs
new/tls-1.3.1/Network/TLS/State.hs
--- old/tls-1.2.18/Network/TLS/State.hs 2015-06-19 15:56:01.000000000 +0200
+++ new/tls-1.3.1/Network/TLS/State.hs 2015-06-20 09:31:09.000000000 +0200
@@ -100,7 +100,7 @@
runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState)
runTLSState f st = runState (runErrT (runTLSSt f)) st
-newTLSState :: CPRG g => g -> Role -> TLSState
+newTLSState :: StateRNG -> Role -> TLSState
newTLSState rng clientContext = TLSState
{ stSession = Session Nothing
, stSessionResuming = False
@@ -116,7 +116,7 @@
, stClientEllipticCurveSuggest = Nothing
, stClientEcPointFormatSuggest = Nothing
, stClientCertificateChain = Nothing
- , stRandomGen = StateRNG rng
+ , stRandomGen = rng
, stVersion = Nothing
, stClientContext = clientContext
}
@@ -246,11 +246,9 @@
genRandom :: Int -> TLSSt Bytes
genRandom n = do
- st <- get
- case withTLSRNG (stRandomGen st) (cprgGenerate n) of
- (bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
+ withRNG (getRandomBytes n)
-withRNG :: (forall g . CPRG g => g -> (a, g)) -> TLSSt a
+withRNG :: MonadPseudoRandom StateRNG a -> TLSSt a
withRNG f = do
st <- get
let (a,rng') = withTLSRNG (stRandomGen st) f
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Network/TLS/Util/Serialization.hs
new/tls-1.3.1/Network/TLS/Util/Serialization.hs
--- old/tls-1.2.18/Network/TLS/Util/Serialization.hs 2015-06-19
15:56:01.000000000 +0200
+++ new/tls-1.3.1/Network/TLS/Util/Serialization.hs 2015-06-20
09:31:09.000000000 +0200
@@ -5,4 +5,8 @@
, lengthBytes
) where
-import Crypto.Number.Serialize (os2ip, i2osp, i2ospOf_, lengthBytes)
+import Crypto.Number.Basic (numBytes)
+import Crypto.Number.Serialize (os2ip, i2osp, i2ospOf_)
+
+lengthBytes :: Integer -> Int
+lengthBytes = numBytes
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Tests/Connection.hs
new/tls-1.3.1/Tests/Connection.hs
--- old/tls-1.2.18/Tests/Connection.hs 2015-06-19 15:56:01.000000000 +0200
+++ new/tls-1.3.1/Tests/Connection.hs 2015-06-20 09:31:09.000000000 +0200
@@ -20,7 +20,6 @@
import Control.Concurrent
import qualified Control.Exception as E
-import qualified Crypto.Random.AESCtr as RNG
import qualified Data.ByteString as B
debug = False
@@ -36,7 +35,7 @@
, bulkBlockSize = 16
, bulkF = BulkBlockF $ \_ _ _ -> (\m -> (m, B.empty))
}
- , cipherHash = MD5
+ , cipherHash = MD5
, cipherKeyExchange = CipherKeyExchange_RSA
, cipherMinVer = Nothing
}
@@ -127,13 +126,10 @@
let noFlush = return ()
let noClose = return ()
- cRNG <- RNG.makeSystem
- sRNG <- RNG.makeSystem
-
let cBackend = Backend noFlush noClose (writePipeA pipe) (readPipeA pipe)
let sBackend = Backend noFlush noClose (writePipeB pipe) (readPipeB pipe)
- cCtx' <- contextNew cBackend cParams cRNG
- sCtx' <- contextNew sBackend sParams sRNG
+ cCtx' <- contextNew cBackend cParams
+ sCtx' <- contextNew sBackend sParams
contextHookSetLogging cCtx' (logging "client: ")
contextHookSetLogging sCtx' (logging "server: ")
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Tests/PubKey.hs
new/tls-1.3.1/Tests/PubKey.hs
--- old/tls-1.2.18/Tests/PubKey.hs 2015-06-19 15:56:01.000000000 +0200
+++ new/tls-1.3.1/Tests/PubKey.hs 2015-06-20 09:31:09.000000000 +0200
@@ -11,26 +11,27 @@
import Test.Tasty.QuickCheck
import qualified Crypto.PubKey.DH as DH
-import Crypto.Random (createTestEntropyPool)
-import qualified Crypto.Random.AESCtr as RNG
+import Crypto.Random
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.DSA as DSA
-import qualified Data.ByteString as B
-
import Control.Concurrent.MVar
import System.IO.Unsafe
arbitraryRSAPair :: Gen (RSA.PublicKey, RSA.PrivateKey)
-arbitraryRSAPair = do
- rng <- (RNG.make . createTestEntropyPool . B.pack) `fmap` vector 1024
- arbitraryRSAPairWithRNG rng
+arbitraryRSAPair = (rngToRSA . drgNewTest) `fmap` arbitrary
+ where
+ rngToRSA :: ChaChaDRG -> (RSA.PublicKey, RSA.PrivateKey)
+ rngToRSA rng = fst $ withDRG rng arbitraryRSAPairWithRNG
-arbitraryRSAPairWithRNG rng = return $ fst $ RSA.generate rng 128 0x10001
+arbitraryRSAPairWithRNG :: MonadRandom m => m (RSA.PublicKey, RSA.PrivateKey)
+arbitraryRSAPairWithRNG = RSA.generate 256 0x10001
{-# NOINLINE globalRSAPair #-}
globalRSAPair :: MVar (RSA.PublicKey, RSA.PrivateKey)
-globalRSAPair = unsafePerformIO (RNG.makeSystem >>= arbitraryRSAPairWithRNG
>>= newMVar)
+globalRSAPair = unsafePerformIO $ do
+ drg <- drgNew
+ newMVar (fst $ withDRG drg arbitraryRSAPairWithRNG)
{-# NOINLINE getGlobalRSAPair #-}
getGlobalRSAPair :: (RSA.PublicKey, RSA.PrivateKey)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/Tests/Tests.hs
new/tls-1.3.1/Tests/Tests.hs
--- old/tls-1.2.18/Tests/Tests.hs 2015-06-19 15:56:01.000000000 +0200
+++ new/tls-1.3.1/Tests/Tests.hs 2015-06-20 09:31:09.000000000 +0200
@@ -21,6 +21,8 @@
import Data.IORef
+import System.Timeout
+
prop_pipe_work :: PropertyM IO ()
prop_pipe_work = do
pipe <- run newPipe
@@ -48,9 +50,9 @@
d <- B.pack <$> pick (someWords8 256)
run $ writeChan startQueue d
-- receive it
- dres <- run $ readChan resultQueue
+ dres <- run $ timeout 10000000 $ readChan resultQueue
-- check if it equal
- d `assertEq` dres
+ Just d `assertEq` dres
return ()
prop_handshake_initiate :: PropertyM IO ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.2.18/tls.cabal new/tls-1.3.1/tls.cabal
--- old/tls-1.2.18/tls.cabal 2015-06-19 15:56:01.000000000 +0200
+++ new/tls-1.3.1/tls.cabal 2015-06-20 09:31:09.000000000 +0200
@@ -1,5 +1,5 @@
Name: tls
-Version: 1.2.18
+Version: 1.3.1
Description:
Native Haskell TLS and SSL protocol implementation for server and client.
.
@@ -41,21 +41,14 @@
, network
, data-default-class
-- crypto related
- , cryptohash >= 0.6
- , crypto-random >= 0.0 && < 0.1
- , crypto-numbers
- , crypto-cipher-types >= 0.0.8
- , crypto-pubkey >= 0.2.8
- , crypto-pubkey-types >= 0.4
- , cipher-rc4
- , cipher-des
- , cipher-aes >= 0.2 && < 0.3
+ , memory
+ , cryptonite >= 0.3
-- certificate related
, asn1-types >= 0.2.0
, asn1-encoding
- , x509 >= 1.5.0 && < 1.6.0
- , x509-store >= 1.5.0
- , x509-validation >= 1.5.1 && < 1.6.0
+ , x509 >= 1.6 && < 1.7.0
+ , x509-store >= 1.6
+ , x509-validation >= 1.6 && < 1.7.0
, async
Exposed-modules: Network.TLS
Network.TLS.Cipher
@@ -122,15 +115,12 @@
, tasty
, tasty-quickcheck
, QuickCheck
- , cprng-aes >= 0.5
- , crypto-pubkey >= 0.2
+ , cryptonite
, bytestring
, x509
, x509-validation
, tls
, hourglass
- , crypto-random
- , crypto-pubkey
ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures
-fwarn-tabs
Benchmark bench-tls
@@ -142,12 +132,10 @@
, x509
, x509-validation
, data-default-class
- , crypto-random
+ , cryptonite
, criterion
- , cprng-aes
, mtl
, bytestring
- , crypto-pubkey >= 0.2
, hourglass
, QuickCheck >= 2
