tls-extra 0.4.7.1 → 0.6.6
raw patch · 8 files changed
Files
- LICENSE +1/−1
- Network/TLS/Extra/Certificate.hs +113/−133
- Network/TLS/Extra/Cipher.hs +130/−153
- Network/TLS/Extra/Compression.hs +10/−3
- Network/TLS/Extra/Connection.hs +15/−15
- Network/TLS/Extra/Thread.hs +0/−3
- Tests.hs +0/−2
- tls-extra.cabal +14/−11
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2010-2011 Vincent Hanquez <vincent@snarc.org>+Copyright (c) 2010-2012 Vincent Hanquez <vincent@snarc.org> All rights reserved.
Network/TLS/Extra/Certificate.hs view
@@ -7,46 +7,42 @@ -- Portability : unknown -- module Network.TLS.Extra.Certificate- ( certificateChecks- , certificateVerifyChain- , certificateVerifyChainAgainst- , certificateVerifyAgainst- , certificateSelfSigned- , certificateVerifyDomain- , certificateVerifyValidity- , certificateFingerprint- ) where+ ( 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-import System.Certificate.X509 as SysCert -- for signing/verifying certificate import qualified Crypto.Hash.SHA1 as SHA1-import qualified Crypto.Hash.MD2 as MD2-import qualified Crypto.Hash.MD5 as MD5-import qualified Crypto.Cipher.RSA as RSA-import qualified Crypto.Cipher.DSA as DSA+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 (TLSCertificateUsage(..), TLSCertificateRejectReason(..))+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 +-- | Returns 'CertificateUsageAccept' if all the checks pass, or the first -- failure.-certificateChecks :: [ [X509] -> IO TLSCertificateUsage ] -> [X509] -> IO TLSCertificateUsage+certificateChecks :: [ [X509] -> IO CertificateUsage ] -> [X509] -> IO CertificateUsage certificateChecks checks x509s = fromMaybe CertificateUsageAccept . find (CertificateUsageAccept /=) <$> mapM ($ x509s) checks @@ -56,10 +52,10 @@ # warning "********please consider contributing to the certificate to fix this issue *************" # warning "********getting trusted system certificate is platform dependant *************" -{- on windows and OSX, the trusted certificates are not yet accessible,+{- on windows, the trusted certificates are not yet accessible, - for now, print a big fat warning (better than nothing) and returns true -}-certificateVerifyChain_ :: [X509] -> IO TLSCertificateUsage-certificateVerifyChain_ _ = do+certificateVerifyChain_ :: CertificateStore -> [X509] -> IO CertificateUsage+certificateVerifyChain_ _ _ = do wvisible <- hIsTerminalDevice stderr when wvisible $ do hPutStrLn stderr "tls-extra:Network.TLS.Extra.Certificate"@@ -68,39 +64,41 @@ return CertificateUsageAccept #else-certificateVerifyChain_ :: [X509] -> IO TLSCertificateUsage-certificateVerifyChain_ [] = return $ CertificateUsageReject (CertificateRejectOther "empty chain / no certificates")-certificateVerifyChain_ (x:xs) = do- -- find a matching certificate that we trust (== installed on the system)- foundCert <- SysCert.findCertificate (certMatchDN x)- case foundCert of- Just sysx509 -> - if certificateVerifyAgainst x sysx509- then return CertificateUsageAccept- else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other")- Nothing -> case xs of- [] -> return $ CertificateUsageReject CertificateRejectUnknownCA- _ -> if certificateVerifyAgainst x (head xs)- then certificateVerifyChain_ xs- else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other")-#endif+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 -certificateVerifyChainAgainst_ :: [X509] -> [X509] -> TLSCertificateUsage-certificateVerifyChainAgainst_ _ [] = CertificateUsageReject (CertificateRejectOther "empty chain / no certificates")-certificateVerifyChainAgainst_ allCerts (x:xs) = - -- find a matching certificate that we trust (== installed on the system)- -- foundCert <- SysCert.findCertificate (certMatchDN x)- case find (certMatchDN x) allCerts of- Just sysx509 -> - if certificateVerifyAgainst x sysx509- then CertificateUsageAccept- else CertificateUsageReject (CertificateRejectOther "chain doesn't match each other")- Nothing -> case xs of- [] -> CertificateUsageReject CertificateRejectUnknownCA- _ -> if certificateVerifyAgainst x (head xs)- then certificateVerifyChainAgainst_ allCerts xs- else CertificateUsageReject (CertificateRejectOther "chain doesn't match each other")+ 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@@ -115,35 +113,24 @@ -- -- TODO: verify validity, check revocation list if any, add optional user output to know -- the rejection reason.-certificateVerifyChain :: [X509] -> IO TLSCertificateUsage-certificateVerifyChain = certificateVerifyChain_ . reorderList- where- reorderList [] = []- reorderList (x:xs) =- case find (certMatchDN x) xs of- Nothing -> x : reorderList xs- Just found -> x : found : reorderList (filter (/= found) xs)--certificateVerifyChainAgainst :: [X509] -> [X509] -> TLSCertificateUsage-certificateVerifyChainAgainst allCerts = certificateVerifyChainAgainst_ allCerts . reorderList- where- reorderList [] = []- reorderList (x:xs) =- case find (certMatchDN x) xs of- Nothing -> x : reorderList xs- Just found -> x : found : reorderList (filter (/= found) xs)+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 _ _ _ _) = do- case verifyF sigalg pk udata esig of- Right True -> True- _ -> False- where- udata = B.concat $ L.toChunks $ getSigningData ux509- esig = B.pack sig- pk = certPubKey scert+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@@ -151,9 +138,9 @@ certMatchDN :: X509 -> X509 -> Bool certMatchDN (X509 testedCert _ _ _ _) (X509 issuerCert _ _ _ _) =- certSubjectDN issuerCert == certIssuerDN testedCert+ certSubjectDN issuerCert == certIssuerDN testedCert -verifyF :: SignatureALG -> PubKey -> B.ByteString -> B.ByteString -> Either String Bool+verifyF :: SignatureALG -> PubKey -> B.ByteString -> B.ByteString -> Bool -- md[245]WithRSAEncryption: --@@ -162,75 +149,68 @@ -- 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) = rsaVerify MD2.hash asn1 rsak- where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x02\x10"--verifyF (SignatureALG HashMD5 PubKeyALG_RSA) (PubKeyRSA rsak) = rsaVerify MD5.hash asn1 rsak- where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10"--verifyF (SignatureALG HashSHA1 PubKeyALG_RSA) (PubKeyRSA rsak) = rsaVerify SHA1.hash asn1 rsak- where asn1 = "\x30\x21\x30\x09\x06\x05\x2b\x0e\x03\x02\x1a\x05\x00\x04\x14"-+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 _ _ = (\_ _ -> Left "unexpected/wrong signature")+verifyF (SignatureALG HashSHA256 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrSHA256 rsak -dsaSHA1Verify pk _ b = either (Left . show) (Right) $ DSA.verify asig SHA1.hash pk b- where asig = (0,0) {- FIXME : need to work out how to get R/S from the bytestring a -}+verifyF _ _ = \_ _ -> False -rsaVerify h hdesc pk a b = either (Left . show) (Right) $ RSA.verify h hdesc pk a b+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] -> TLSCertificateUsage+certificateVerifyDomain :: String -> [X509] -> CertificateUsage certificateVerifyDomain _ [] = CertificateUsageReject (CertificateRejectOther "empty list") certificateVerifyDomain fqhn (X509 cert _ _ _ _:_) =- let names = maybe [] ((:[]) . snd) (lookup oidCommonName $ 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+ 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"+ 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- -- <star>.com or <star> is always invalid- | length l < 2 = rejectMisc "commonname OID wildcard match too widely"- -- <star>.com.<country> 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"+ -- 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+ -- <star>.com or <star> is always invalid+ | length l < 2 = rejectMisc "commonname OID wildcard match too widely"+ -- <star>.com.<country> 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)+ 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)+ 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] -> TLSCertificateUsage+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+ 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
Network/TLS/Extra/Cipher.hs view
@@ -5,80 +5,73 @@ -- 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_null- , 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+ (+ -- * 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.Vector.Unboxed as Vector (fromList, toList) import qualified Data.ByteString as B import Network.TLS (Version(..)) import Network.TLS.Cipher-import qualified Crypto.Cipher.AES as AES-import qualified Crypto.Cipher.RC4 as RC4+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 -aes128_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString-aes128_cbc_encrypt key iv d = AES.encryptCBC pkey iv d- where (Right pkey) = AES.initKey128 key+import qualified "cipher-aes" Crypto.Cipher.AES as AES -aes128_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString-aes128_cbc_decrypt key iv d = AES.decryptCBC pkey iv d- where (Right pkey) = AES.initKey128 key+aes_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString+aes_cbc_encrypt key iv d = AES.encryptCBC (AES.initAES key) iv d -aes256_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString-aes256_cbc_encrypt key iv d = AES.encryptCBC pkey iv d- where (Right pkey) = AES.initKey256 key+aes_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString+aes_cbc_decrypt key iv d = AES.decryptCBC (AES.initAES key) iv d -aes256_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString-aes256_cbc_decrypt key iv d = AES.decryptCBC pkey iv d- where (Right pkey) = AES.initKey256 key+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 (v, x, y) = B.pack (x : y : Vector.toList v)+toIV (RC4.Ctx ctx) = ctx toCtx :: IV -> RC4.Ctx-toCtx iv =- case B.unpack iv of- x:y:l -> (Vector.fromList l, x, y)- _ -> (Vector.fromList [], 0, 0)+toCtx iv = RC4.Ctx iv initF_rc4 :: Key -> IV-initF_rc4 key = toIV $ RC4.initCtx (B.unpack key)+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.encrypt (toCtx iv) d+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.decrypt (toCtx iv) e+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- ]+ [ 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]@@ -93,159 +86,143 @@ ciphersuite_unencrypted = [cipher_null_MD5, cipher_null_SHA1] bulk_null = Bulk- { bulkName = "null"- , bulkKeySize = 0- , bulkIVSize = 0- , bulkBlockSize = 0- , bulkF = BulkNoneF- }+ { 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- }+ { 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- }+ { 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- }+ { 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- }+ { hashName = "MD5"+ , hashSize = 16+ , hashF = MD5.hash+ } hash_sha1 = Hash- { hashName = "SHA1"- , hashSize = 20- , hashF = SHA1.hash- }+ { hashName = "SHA1"+ , hashSize = 20+ , hashF = SHA1.hash+ } hash_sha256 = Hash- { hashName = "SHA256"- , hashSize = 32- , hashF = SHA256.hash- }--hash_null = Hash- { hashName = "null"- , hashSize = 0- , hashF = const B.empty- }---- | this is not stricly a usable cipher; it's the initial cipher of a TLS connection-cipher_null_null :: Cipher-cipher_null_null = Cipher- { cipherID = 0x0- , cipherName = "null-null"- , cipherBulk = bulk_null- , cipherHash = hash_null- , cipherKeyExchange = CipherKeyExchange_RSA- , cipherMinVer = Nothing- }+ { 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- }+ { 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- }+ { 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- }+ { 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- }+ { 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- }+ { 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- }+ { 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- }+ { 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- }+ { cipherID = 0x3d+ , cipherName = "RSA-aes256-sha256"+ , cipherBulk = bulk_aes256+ , cipherHash = hash_sha256+ , cipherKeyExchange = CipherKeyExchange_RSA+ , cipherMinVer = Just TLS12+ } {- TLS 1.0 ciphers definition
Network/TLS/Extra/Compression.hs view
@@ -1,5 +1,12 @@+-- |+-- Module : Network.TLS.Extra.Compression+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unknown+-- module Network.TLS.Extra.Compression- (- ) where+ (+ ) where -import Network.TLS.Compression+--import Network.TLS.Compression
Network/TLS/Extra/Connection.hs view
@@ -6,10 +6,10 @@ -- Portability : unknown -- module Network.TLS.Extra.Connection- ( connectionClient- ) where+ ( connectionClient+ ) where -import Crypto.Random+import Crypto.Random.API import Control.Applicative ((<$>)) import Control.Exception import Data.Char@@ -26,21 +26,21 @@ -- -- @ -- import Network.TLS.Extra--- import Crypto.Random+-- import Crypto.Random.AESCtr -- ...--- conn <- (newGenIO::IO SystemRandom) >>= connectionClient 192.168.2.2 7777 defaultParams g+-- conn <- makeSystem >>= connectionClient 192.168.2.2 7777 defaultParams -- @ ----- will make a new RNG (using system entropy) and connect to IP 192.168.2.2+-- will make a new RNG (using cprng-aes) and connect to IP 192.168.2.2 -- on port 7777.-connectionClient :: CryptoRandomGen g => String -> String -> TLSParams -> g -> IO (TLSCtx Handle)+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+ 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- client params rng h+ h <- bracketOnError (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do+ connect sock (SockAddrInet pn (head $ hostAddresses he))+ socketToHandle sock ReadWriteMode+ contextNewOnHandle h params rng
− Network/TLS/Extra/Thread.hs
@@ -1,3 +0,0 @@-module Network.TLS.Extra.Thread- (- ) where
Tests.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- import qualified Tests.Connection as Connection import qualified Tests.Ciphers as Ciphers
tls-extra.cabal view
@@ -1,5 +1,5 @@ Name: tls-extra-Version: 0.4.7.1+Version: 0.6.6 Description: a set of extra definitions, default values and helpers for tls. License: BSD3@@ -12,7 +12,7 @@ Category: Network stability: experimental Cabal-Version: >=1.6-Homepage: http://github.com/vincenthz/hs-tls-extra+Homepage: http://github.com/vincenthz/hs-tls Flag test Description: Build unit test@@ -20,24 +20,24 @@ Library Build-Depends: base > 3 && < 5- , tls >= 0.9.4 && < 1.0.0+ , tls >= 1.1.0 && < 1.2.0 , mtl , network >= 2.3 , cryptohash >= 0.6 , bytestring , vector- , crypto-api >= 0.5- , cryptocipher >= 0.3.0 && < 0.4.0- , certificate >= 1.2.0 && < 1.3.0- , pem >= 0.1.0 && < 0.2.0- , text >= 0.5 && < 1.0+ , 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.Thread Network.TLS.Extra.File ghc-options: -Wall -fno-warn-missing-signatures if os(windows)@@ -51,10 +51,13 @@ , HUnit , QuickCheck >= 2 , bytestring- , cprng-aes >= 0.2.3+ , 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-extra+ location: git://github.com/vincenthz/hs-tls