tls 1.2.18 → 1.3.0
raw patch · 17 files changed
+245/−193 lines, 17 filesdep +cryptonitedep +memorydep −cipher-aesdep −cipher-desdep −cipher-rc4dep ~asyncdep ~mtldep ~x509
Dependencies added: cryptonite, memory
Dependencies removed: cipher-aes, cipher-des, cipher-rc4, cprng-aes, crypto-cipher-types, crypto-numbers, crypto-pubkey, crypto-pubkey-types, crypto-random, cryptohash
Dependency ranges changed: async, mtl, x509, x509-store, x509-validation
Files
- Network/TLS/Context.hs +9/−11
- Network/TLS/Crypto.hs +77/−36
- Network/TLS/Crypto/DH.hs +6/−7
- Network/TLS/Crypto/ECDH.hs +14/−11
- Network/TLS/Extension/EC.hs +1/−1
- Network/TLS/Extra/Cipher.hs +37/−24
- Network/TLS/Handshake/Client.hs +1/−1
- Network/TLS/Handshake/Key.hs +8/−8
- Network/TLS/Handshake/Signature.hs +47/−45
- Network/TLS/RNG.hs +12/−5
- Network/TLS/Record/Disengage.hs +2/−1
- Network/TLS/Record/Engage.hs +2/−1
- Network/TLS/State.hs +4/−6
- Network/TLS/Util/Serialization.hs +5/−1
- Tests/Connection.hs +2/−6
- Tests/PubKey.hs +10/−9
- tls.cabal +8/−20
Network/TLS/Context.hs view
@@ -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 ()
Network/TLS/Crypto.hs view
@@ -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)+generalizeRSAError :: Either RSA.Error a -> Either KxError a+generalizeRSAError (Left e) = Left (RSAError e)+generalizeRSAError (Right x) = Right x -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)+kxEncrypt :: MonadRandom r => PublicKey -> ByteString -> r (Either KxError ByteString)+kxEncrypt (PubKeyRSA pk) b = generalizeRSAError `fmap` RSA.encrypt pk b+kxEncrypt _ _ = return (Left KxUnsupported) -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)+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
Network/TLS/Crypto/DH.hs view
@@ -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 =
Network/TLS/Crypto/ECDH.hs view
@@ -18,18 +18,21 @@ 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 _)
Network/TLS/Extension/EC.hs view
@@ -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
Network/TLS/Extra/Cipher.hs view
@@ -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
Network/TLS/Handshake/Client.hs view
@@ -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
Network/TLS/Handshake/Key.hs view
@@ -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
Network/TLS/Handshake/Signature.hs view
@@ -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,89 @@ -> 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+ DigitallySigned malg <$> signRSA ctx cc hashAlg toSign -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 +133,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 +158,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 +167,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
Network/TLS/RNG.hs view
@@ -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
Network/TLS/Record/Disengage.hs view
@@ -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
Network/TLS/Record/Engage.hs view
@@ -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
Network/TLS/State.hs view
@@ -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
Network/TLS/Util/Serialization.hs view
@@ -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
Tests/Connection.hs view
@@ -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@@ -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: ")
Tests/PubKey.hs view
@@ -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)
tls.cabal view
@@ -1,5 +1,5 @@ Name: tls-Version: 1.2.18+Version: 1.3.0 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