tls-extra-0.6.6/0000755000000000000000000000000012224427204011633 5ustar0000000000000000tls-extra-0.6.6/LICENSE0000644000000000000000000000273112224427204012643 0ustar0000000000000000Copyright (c) 2010-2012 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. tls-extra-0.6.6/Tests.hs0000644000000000000000000000021412224427204013266 0ustar0000000000000000import qualified Tests.Connection as Connection import qualified Tests.Ciphers as Ciphers main = do Ciphers.runTests Connection.runTests tls-extra-0.6.6/tls-extra.cabal0000644000000000000000000000404212224427204014542 0ustar0000000000000000Name: tls-extra Version: 0.6.6 Description: a set of extra definitions, default values and helpers for tls. License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Synopsis: TLS extra default values and helpers Build-Type: Simple Category: Network stability: experimental Cabal-Version: >=1.6 Homepage: http://github.com/vincenthz/hs-tls Flag test Description: Build unit test Default: False Library Build-Depends: base > 3 && < 5 , tls >= 1.1.0 && < 1.2.0 , mtl , network >= 2.3 , cryptohash >= 0.6 , bytestring , vector , cipher-rc4 , cipher-aes >= 0.2 && < 0.3 , certificate >= 1.3.5 && < 1.4.0 , crypto-pubkey >= 0.2.0 , crypto-random , pem >= 0.1 && < 0.3 , time Exposed-modules: Network.TLS.Extra other-modules: Network.TLS.Extra.Certificate Network.TLS.Extra.Cipher Network.TLS.Extra.Compression Network.TLS.Extra.Connection Network.TLS.Extra.File ghc-options: -Wall -fno-warn-missing-signatures if os(windows) cpp-options: -DNOCERTVERIFY executable Tests Main-is: Tests.hs if flag(test) Buildable: True Build-Depends: base >= 3 && < 5 , HUnit , QuickCheck >= 2 , bytestring , cprng-aes >= 0.5.0 , cipher-aes >= 0.2 && < 0.3 else Buildable: False if os(windows) cpp-options: -DNOCERTVERIFY source-repository head type: git location: git://github.com/vincenthz/hs-tls tls-extra-0.6.6/Setup.hs0000644000000000000000000000005612224427204013270 0ustar0000000000000000import Distribution.Simple main = defaultMain tls-extra-0.6.6/Network/0000755000000000000000000000000012224427204013264 5ustar0000000000000000tls-extra-0.6.6/Network/TLS/0000755000000000000000000000000012224427204013726 5ustar0000000000000000tls-extra-0.6.6/Network/TLS/Extra.hs0000644000000000000000000000113112224427204015341 0ustar0000000000000000-- | -- Module : Network.TLS.Extra -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Network.TLS.Extra ( -- * Cipher related definition module Network.TLS.Extra.Cipher -- * Certificate helpers , module Network.TLS.Extra.Certificate -- * Connection helpers , module Network.TLS.Extra.Connection -- * File helpers , module Network.TLS.Extra.File ) where import Network.TLS.Extra.Cipher import Network.TLS.Extra.Certificate import Network.TLS.Extra.Connection import Network.TLS.Extra.File tls-extra-0.6.6/Network/TLS/Extra/0000755000000000000000000000000012224427204015011 5ustar0000000000000000tls-extra-0.6.6/Network/TLS/Extra/Compression.hs0000644000000000000000000000042712224427204017651 0ustar0000000000000000-- | -- Module : Network.TLS.Extra.Compression -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Network.TLS.Extra.Compression ( ) where --import Network.TLS.Compression tls-extra-0.6.6/Network/TLS/Extra/File.hs0000644000000000000000000000422212224427204016224 0ustar0000000000000000-- | -- Module : Network.TLS.Extra.File -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Simple helpers to load private key and certificate files -- to be handled by the TLS stack module Network.TLS.Extra.File ( fileReadCertificate , fileReadPrivateKey ) where import Control.Applicative ((<$>)) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Either import Data.PEM (PEM(..), pemParseBS) import Data.Certificate.X509 import qualified Data.Certificate.KeyRSA as KeyRSA import Network.TLS -- | read one X509 certificate from a file. -- -- the certificate must be in the usual PEM format with the -- TRUSTED CERTIFICATE or CERTIFICATE pem name. -- -- If no valid PEM encoded certificate is found in the file -- this function will raise an error. fileReadCertificate :: FilePath -> IO X509 fileReadCertificate filepath = do certs <- rights . parseCerts . pemParseBS <$> B.readFile filepath case certs of [] -> error "no valid certificate found" (x:_) -> return x where parseCerts (Right pems) = map (decodeCertificate . L.fromChunks . (:[]) . pemContent) $ filter (flip elem ["CERTIFICATE", "TRUSTED CERTIFICATE"] . pemName) pems parseCerts (Left err) = error ("cannot parse PEM file " ++ show err) -- | read one private key from a file. -- -- the private key must be in the usual PEM format and at the moment only -- RSA PRIVATE KEY are supported. -- -- If no valid PEM encoded private key is found in the file -- this function will raise an error. fileReadPrivateKey :: FilePath -> IO PrivateKey fileReadPrivateKey filepath = do pk <- rights . parseKey . pemParseBS <$> B.readFile filepath case pk of [] -> error "no valid RSA key found" (x:_) -> return x where parseKey (Right pems) = map (fmap (PrivRSA . snd) . KeyRSA.decodePrivate . L.fromChunks . (:[]) . pemContent) $ filter ((== "RSA PRIVATE KEY") . pemName) pems parseKey (Left err) = error ("Cannot parse PEM file " ++ show err) tls-extra-0.6.6/Network/TLS/Extra/Certificate.hs0000644000000000000000000002505612224427204017577 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, CPP #-} -- | -- Module : Network.TLS.Extra.Certificate -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Network.TLS.Extra.Certificate ( certificateChecks , certificateVerifyChain , certificateVerifyAgainst , certificateSelfSigned , certificateVerifyDomain , certificateVerifyValidity , certificateFingerprint ) where import Control.Applicative ((<$>)) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Certificate.X509 -- for signing/verifying certificate import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.PubKey.HashDescr as HD import qualified Crypto.PubKey.RSA.PKCS15 as RSA import qualified Crypto.PubKey.DSA as DSA import Data.CertificateStore import Data.Certificate.X509.Cert (oidCommonName) import Network.TLS (CertificateUsage(..), CertificateRejectReason(..)) import Data.Time.Calendar import Data.List (find) import Data.Maybe (fromMaybe) #if defined(NOCERTVERIFY) import System.IO (hPutStrLn, stderr, hIsTerminalDevice) import Control.Monad (when) #endif -- | Returns 'CertificateUsageAccept' if all the checks pass, or the first -- failure. certificateChecks :: [ [X509] -> IO CertificateUsage ] -> [X509] -> IO CertificateUsage certificateChecks checks x509s = fromMaybe CertificateUsageAccept . find (CertificateUsageAccept /=) <$> mapM ($ x509s) checks #if defined(NOCERTVERIFY) # warning "********certificate verify chain doesn't yet work on your platform *************" # warning "********please consider contributing to the certificate to fix this issue *************" # warning "********getting trusted system certificate is platform dependant *************" {- on windows, the trusted certificates are not yet accessible, - for now, print a big fat warning (better than nothing) and returns true -} certificateVerifyChain_ :: CertificateStore -> [X509] -> IO CertificateUsage certificateVerifyChain_ _ _ = do wvisible <- hIsTerminalDevice stderr when wvisible $ do hPutStrLn stderr "tls-extra:Network.TLS.Extra.Certificate" hPutStrLn stderr "****************** certificate verify chain doesn't yet work on your platform **********************" hPutStrLn stderr "please consider contributing to the certificate package to fix this issue" return CertificateUsageAccept #else certificateVerifyChain_ :: CertificateStore -> [X509] -> IO CertificateUsage certificateVerifyChain_ _ [] = return $ CertificateUsageReject (CertificateRejectOther "empty chain / no certificates") certificateVerifyChain_ store (x:xs) = loop 0 x xs >>= return . maybe CertificateUsageAccept CertificateUsageReject where checkTrusted _ cert notFound = case findCertificate (certIssuerDN $ x509Cert cert) store of Just tCer -> verifyAgainstTrusted tCer cert Nothing -> notFound loop :: Int -> X509 -> [X509] -> IO (Maybe CertificateRejectReason) loop depth cert [] = checkTrusted depth cert (return $ Just (CertificateRejectUnknownCA)) loop depth cert (n:ns) = checkTrusted depth cert $ do case checkCA $ certExtensions $ x509Cert n of Just r -> return (Just r) Nothing | certificateVerifyAgainst cert n -> loop (depth+1) n ns | otherwise -> return certificateChainDoesntMatch verifyAgainstTrusted trustedCer cert | validChain = return Nothing | otherwise = return certificateChainDoesntMatch where validChain = certificateVerifyAgainst cert trustedCer checkCA Nothing = certificateNotAllowedToSign checkCA (Just es) = let kuCanCertSign = case extensionGet es of Just (ExtKeyUsage l) -> elem KeyUsage_keyCertSign l Nothing -> True in case extensionGet es of Just (ExtBasicConstraints True _) | kuCanCertSign -> Nothing | otherwise -> certificateNotAllowedToSign _ -> certificateNotAllowedToSign certificateNotAllowedToSign = Just $ CertificateRejectOther "certificate is not allowed to sign another certificate" certificateChainDoesntMatch = Just $ CertificateRejectOther "chain doesn't match" #endif -- | verify a certificates chain using the system certificates available. -- -- each certificate of the list is verified against the next certificate, until -- it can be verified against a system certificate (system certificates are assumed as trusted) -- -- This helper only check that the chain of certificate is valid, which means that each items -- received are signed by the next one, or by a system certificate. Some extra checks need to -- be done at the user level so that the certificate chain received make sense in the context. -- -- for example for HTTP, the user should typically verify the certificate subject match the URL -- of connection. -- -- TODO: verify validity, check revocation list if any, add optional user output to know -- the rejection reason. certificateVerifyChain :: CertificateStore -> [X509] -> IO CertificateUsage certificateVerifyChain store = certificateVerifyChain_ store . reorderList where reorderList [] = [] reorderList (x:xs) = case find (certMatchDN x) xs of Nothing -> x : reorderList xs Just found -> x : found : reorderList (filter (/= found) xs) -- | verify a certificate against another one. -- the first certificate need to be signed by the second one for this function to succeed. certificateVerifyAgainst :: X509 -> X509 -> Bool certificateVerifyAgainst ux509@(X509 _ _ _ sigalg sig) (X509 scert _ _ _ _) = verified where verified = (verifyF sigalg pk) udata esig udata = B.concat $ L.toChunks $ getSigningData ux509 esig = B.pack sig pk = certPubKey scert -- | Is this certificate self signed? certificateSelfSigned :: X509 -> Bool certificateSelfSigned x509 = certMatchDN x509 x509 certMatchDN :: X509 -> X509 -> Bool certMatchDN (X509 testedCert _ _ _ _) (X509 issuerCert _ _ _ _) = certSubjectDN issuerCert == certIssuerDN testedCert verifyF :: SignatureALG -> PubKey -> B.ByteString -> B.ByteString -> Bool -- md[245]WithRSAEncryption: -- -- pkcs-1 OBJECT IDENTIFIER ::= { iso(1) member-body(2) US(840) rsadsi(113549) pkcs(1) 1 } -- rsaEncryption OBJECT IDENTIFIER ::= { pkcs-1 1 } -- md2WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 2 } -- md4WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 3 } -- md5WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 4 } verifyF (SignatureALG HashMD2 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrMD2 rsak verifyF (SignatureALG HashMD5 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrMD5 rsak verifyF (SignatureALG HashSHA1 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrSHA1 rsak verifyF (SignatureALG HashSHA1 PubKeyALG_DSA) (PubKeyDSA dsak) = dsaSHA1Verify dsak verifyF (SignatureALG HashSHA256 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrSHA256 rsak verifyF _ _ = \_ _ -> False dsaSHA1Verify pk _ b = False --where asig = DSA.Signature 0 0 {- FIXME : need to work out how to get R/S from the bytestring a -} -- | Verify that the given certificate chain is application to the given fully qualified host name. certificateVerifyDomain :: String -> [X509] -> CertificateUsage certificateVerifyDomain _ [] = CertificateUsageReject (CertificateRejectOther "empty list") certificateVerifyDomain fqhn (X509 cert _ _ _ _:_) = let names = maybe [] ((:[]) . snd) (lookup oidCommonName $ getDistinguishedElements $ certSubjectDN cert) ++ maybe [] (maybe [] toAltName . extensionGet) (certExtensions cert) in orUsage $ map (matchDomain . splitDot) names where orUsage [] = rejectMisc "FQDN do not match this certificate" orUsage (x:xs) | x == CertificateUsageAccept = CertificateUsageAccept | otherwise = orUsage xs toAltName (ExtSubjectAltName l) = l matchDomain l | length (filter (== "") l) > 0 = rejectMisc "commonname OID got empty subdomain" | head l == "*" = wildcardMatch (reverse $ drop 1 l) | otherwise = if l == splitDot fqhn then CertificateUsageAccept else rejectMisc "FQDN and common name OID do not match" -- only 1 wildcard is valid, and if multiples are present -- they won't have a wildcard meaning but will be match as normal star -- character to the fqhn and inevitably will fail. wildcardMatch l -- .com or is always invalid | length l < 2 = rejectMisc "commonname OID wildcard match too widely" -- .com. is always invalid | length (head l) <= 2 && length (head $ drop 1 l) <= 3 && length l < 3 = rejectMisc "commonname OID wildcard match too widely" | otherwise = if l == take (length l) (reverse $ splitDot fqhn) then CertificateUsageAccept else rejectMisc "FQDN and common name OID do not match" splitDot :: String -> [String] splitDot [] = [""] splitDot x = let (y, z) = break (== '.') x in y : (if z == "" then [] else splitDot $ drop 1 z) rejectMisc s = CertificateUsageReject (CertificateRejectOther s) -- | Verify certificate validity period that need to between the bounds of the certificate. -- TODO: maybe should verify whole chain. certificateVerifyValidity :: Day -> [X509] -> CertificateUsage certificateVerifyValidity _ [] = CertificateUsageReject $ CertificateRejectOther "empty list" certificateVerifyValidity ctime (X509 cert _ _ _ _ :_) = let ((beforeDay,_,_) , (afterDay,_,_)) = certValidity cert in if beforeDay < ctime && ctime <= afterDay then CertificateUsageAccept else CertificateUsageReject CertificateRejectExpired -- | hash the certificate signing data using the supplied hash function. certificateFingerprint :: (L.ByteString -> B.ByteString) -> X509 -> B.ByteString certificateFingerprint hash x509 = hash $ getSigningData x509 tls-extra-0.6.6/Network/TLS/Extra/Connection.hs0000644000000000000000000000253112224427204017445 0ustar0000000000000000-- | -- Module : Network.TLS.Extra.Connection -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Network.TLS.Extra.Connection ( connectionClient ) where import Crypto.Random.API import Control.Applicative ((<$>)) import Control.Exception import Data.Char import System.IO import Network.BSD import Network.Socket import Network.TLS -- | @connectionClient host port param rng@ opens a TCP client connection -- to a destination host and port description (number or name). For -- example: -- -- @ -- import Network.TLS.Extra -- import Crypto.Random.AESCtr -- ... -- conn <- makeSystem >>= connectionClient 192.168.2.2 7777 defaultParams -- @ -- -- will make a new RNG (using cprng-aes) and connect to IP 192.168.2.2 -- on port 7777. connectionClient :: CPRG g => String -> String -> TLSParams -> g -> IO Context connectionClient s p params rng = do pn <- if and $ map isDigit $ p then return $ fromIntegral $ (read p :: Int) else servicePort <$> getServiceByName p "tcp" he <- getHostByName s h <- bracketOnError (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do connect sock (SockAddrInet pn (head $ hostAddresses he)) socketToHandle sock ReadWriteMode contextNewOnHandle h params rng tls-extra-0.6.6/Network/TLS/Extra/Cipher.hs0000644000000000000000000002065412224427204016566 0ustar0000000000000000-- | -- Module : Network.TLS.Extra.Cipher -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- {-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} module Network.TLS.Extra.Cipher ( -- * cipher suite ciphersuite_all , ciphersuite_medium , ciphersuite_strong , ciphersuite_unencrypted -- * individual ciphers , cipher_null_SHA1 , cipher_null_MD5 , cipher_RC4_128_MD5 , cipher_RC4_128_SHA1 , cipher_AES128_SHA1 , cipher_AES256_SHA1 , cipher_AES128_SHA256 , cipher_AES256_SHA256 ) where import qualified Data.ByteString as B import Network.TLS (Version(..)) 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 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 aes128_cbc_encrypt = aes_cbc_encrypt aes128_cbc_decrypt = aes_cbc_decrypt aes256_cbc_encrypt = aes_cbc_encrypt aes256_cbc_decrypt = aes_cbc_decrypt 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 -- | all encrypted ciphers supported ordered from strong to weak. -- this choice of ciphersuite should satisfy most normal need ciphersuite_all :: [Cipher] ciphersuite_all = [ cipher_AES128_SHA256, cipher_AES256_SHA256 , cipher_AES128_SHA1, cipher_AES256_SHA1 , cipher_RC4_128_SHA1, cipher_RC4_128_MD5 ] -- | list of medium ciphers. ciphersuite_medium :: [Cipher] ciphersuite_medium = [cipher_RC4_128_MD5, cipher_RC4_128_SHA1, cipher_AES128_SHA1, cipher_AES256_SHA1] -- | the strongest ciphers supported. ciphersuite_strong :: [Cipher] ciphersuite_strong = [cipher_AES256_SHA256, cipher_AES256_SHA1] -- | all unencrypted ciphers, do not use on insecure network. ciphersuite_unencrypted :: [Cipher] ciphersuite_unencrypted = [cipher_null_MD5, cipher_null_SHA1] bulk_null = Bulk { bulkName = "null" , bulkKeySize = 0 , bulkIVSize = 0 , bulkBlockSize = 0 , bulkF = BulkStreamF (const B.empty) streamId streamId } where streamId = \iv b -> (b,iv) bulk_rc4 = Bulk { bulkName = "RC4-128" , bulkKeySize = 16 , bulkIVSize = 0 , bulkBlockSize = 0 , bulkF = BulkStreamF initF_rc4 encryptF_rc4 decryptF_rc4 } bulk_aes128 = Bulk { bulkName = "AES128" , bulkKeySize = 16 , bulkIVSize = 16 , bulkBlockSize = 16 , bulkF = BulkBlockF aes128_cbc_encrypt aes128_cbc_decrypt } bulk_aes256 = Bulk { bulkName = "AES256" , bulkKeySize = 32 , bulkIVSize = 16 , bulkBlockSize = 16 , bulkF = BulkBlockF aes256_cbc_encrypt aes256_cbc_decrypt } 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 } -- | unencrypted cipher using RSA for key exchange and MD5 for digest cipher_null_MD5 :: Cipher cipher_null_MD5 = Cipher { cipherID = 0x1 , cipherName = "RSA-null-MD5" , cipherBulk = bulk_null , cipherHash = hash_md5 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } -- | unencrypted cipher using RSA for key exchange and SHA1 for digest cipher_null_SHA1 :: Cipher cipher_null_SHA1 = Cipher { cipherID = 0x2 , cipherName = "RSA-null-SHA1" , cipherBulk = bulk_null , cipherHash = hash_sha1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } -- | RC4 cipher, RSA key exchange and MD5 for digest cipher_RC4_128_MD5 :: Cipher cipher_RC4_128_MD5 = Cipher { cipherID = 0x04 , cipherName = "RSA-rc4-128-md5" , cipherBulk = bulk_rc4 , cipherHash = hash_md5 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } -- | RC4 cipher, RSA key exchange and SHA1 for digest cipher_RC4_128_SHA1 :: Cipher cipher_RC4_128_SHA1 = Cipher { cipherID = 0x05 , cipherName = "RSA-rc4-128-sha1" , cipherBulk = bulk_rc4 , cipherHash = hash_sha1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing } -- | AES cipher (128 bit key), RSA key exchange and SHA1 for digest cipher_AES128_SHA1 :: Cipher cipher_AES128_SHA1 = Cipher { cipherID = 0x2f , cipherName = "RSA-aes128-sha1" , cipherBulk = bulk_aes128 , cipherHash = hash_sha1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just SSL3 } -- | AES cipher (256 bit key), RSA key exchange and SHA1 for digest cipher_AES256_SHA1 :: Cipher cipher_AES256_SHA1 = Cipher { cipherID = 0x35 , cipherName = "RSA-aes256-sha1" , cipherBulk = bulk_aes256 , cipherHash = hash_sha1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just SSL3 } -- | AES cipher (128 bit key), RSA key exchange and SHA256 for digest cipher_AES128_SHA256 :: Cipher cipher_AES128_SHA256 = Cipher { cipherID = 0x3c , cipherName = "RSA-aes128-sha256" , cipherBulk = bulk_aes128 , cipherHash = hash_sha256 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just TLS12 } -- | AES cipher (256 bit key), RSA key exchange and SHA256 for digest cipher_AES256_SHA256 :: Cipher cipher_AES256_SHA256 = Cipher { cipherID = 0x3d , cipherName = "RSA-aes256-sha256" , cipherBulk = bulk_aes256 , cipherHash = hash_sha256 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just TLS12 } {- TLS 1.0 ciphers definition CipherSuite TLS_NULL_WITH_NULL_NULL = { 0x00,0x00 }; CipherSuite TLS_RSA_WITH_NULL_MD5 = { 0x00,0x01 }; CipherSuite TLS_RSA_WITH_NULL_SHA = { 0x00,0x02 }; CipherSuite TLS_RSA_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x03 }; CipherSuite TLS_RSA_WITH_RC4_128_MD5 = { 0x00,0x04 }; CipherSuite TLS_RSA_WITH_RC4_128_SHA = { 0x00,0x05 }; CipherSuite TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5 = { 0x00,0x06 }; CipherSuite TLS_RSA_WITH_IDEA_CBC_SHA = { 0x00,0x07 }; CipherSuite TLS_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x08 }; CipherSuite TLS_RSA_WITH_DES_CBC_SHA = { 0x00,0x09 }; CipherSuite TLS_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x0A }; CipherSuite TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0B }; CipherSuite TLS_DH_DSS_WITH_DES_CBC_SHA = { 0x00,0x0C }; CipherSuite TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x0D }; CipherSuite TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0E }; CipherSuite TLS_DH_RSA_WITH_DES_CBC_SHA = { 0x00,0x0F }; CipherSuite TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x10 }; CipherSuite TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x11 }; CipherSuite TLS_DHE_DSS_WITH_DES_CBC_SHA = { 0x00,0x12 }; CipherSuite TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x13 }; CipherSuite TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x14 }; CipherSuite TLS_DHE_RSA_WITH_DES_CBC_SHA = { 0x00,0x15 }; CipherSuite TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x16 }; CipherSuite TLS_DH_anon_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x17 }; CipherSuite TLS_DH_anon_WITH_RC4_128_MD5 = { 0x00,0x18 }; CipherSuite TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x19 }; CipherSuite TLS_DH_anon_WITH_DES_CBC_SHA = { 0x00,0x1A }; CipherSuite TLS_DH_anon_WITH_3DES_EDE_CBC_SHA = { 0x00,0x1B }; -}