tls-extra 0.6.0 → 0.6.1
raw patch · 6 files changed
+226/−209 lines, 6 filesdep ~certificatePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: certificate
API changes (from Hackage documentation)
Files
- Network/TLS/Extra/Certificate.hs +86/−69
- Network/TLS/Extra/Cipher.hs +124/−124
- Network/TLS/Extra/Compression.hs +2/−2
- Network/TLS/Extra/Connection.hs +10/−10
- Network/TLS/Extra/Thread.hs +2/−2
- tls-extra.cabal +2/−2
Network/TLS/Extra/Certificate.hs view
@@ -7,14 +7,14 @@ -- Portability : unknown -- module Network.TLS.Extra.Certificate- ( certificateChecks- , certificateVerifyChain- , certificateVerifyAgainst- , certificateSelfSigned- , certificateVerifyDomain- , certificateVerifyValidity- , certificateFingerprint- ) where+ ( certificateChecks+ , certificateVerifyChain+ , certificateVerifyAgainst+ , certificateSelfSigned+ , certificateVerifyDomain+ , certificateVerifyValidity+ , certificateFingerprint+ ) where import Control.Applicative ((<$>)) import qualified Data.ByteString as B@@ -40,7 +40,7 @@ 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 CertificateUsage ] -> [X509] -> IO CertificateUsage certificateChecks checks x509s =@@ -67,20 +67,37 @@ certificateVerifyChain_ :: CertificateStore -> [X509] -> IO CertificateUsage certificateVerifyChain_ _ [] = return $ CertificateUsageReject (CertificateRejectOther "empty chain / no certificates") certificateVerifyChain_ store (x:xs) =- -- find a matching certificate that we trust (== installed on the system)- case findCertificate (certIssuerDN $ x509Cert x) store of- Just sysx509 -> do- validChain <- certificateVerifyAgainst x sysx509- if validChain- then return CertificateUsageAccept- else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other")- Nothing -> case xs of- [] -> return $ CertificateUsageReject CertificateRejectUnknownCA- _ -> do- validChain <- certificateVerifyAgainst x (head xs)- if validChain- then certificateVerifyChain_ store xs- else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other")+ -- find a matching certificate that we trust (== installed on the system)+ case findCertificate (certIssuerDN $ x509Cert x) store of+ Just sysx509 -> do+ validChain <- certificateVerifyAgainst x sysx509+ if validChain+ then return CertificateUsageAccept+ else return certificateChainDoesntMatch+ Nothing ->+ case xs of+ [] -> return $ CertificateUsageReject CertificateRejectUnknownCA+ cert:_ -> do+ let exts = certExtensions (x509Cert cert)+ case checkCA exts of+ Just r -> return r+ Nothing -> do+ validChain <- certificateVerifyAgainst x cert+ if validChain+ then certificateVerifyChain_ store xs+ else return certificateChainDoesntMatch+ where checkCA Nothing = return $ certificateNotAllowedToSign+ checkCA (Just es) = do+ let kuCanCertSign = case extensionGet es of+ Just (ExtKeyUsage l) -> elem KeyUsage_keyCertSign l+ Nothing -> False+ case extensionGet es of+ Just (ExtBasicConstraints True _)+ | kuCanCertSign -> Nothing+ | otherwise -> Just certificateNotAllowedToSign+ _ -> Just certificateNotAllowedToSign+ certificateNotAllowedToSign = CertificateUsageReject $ CertificateRejectOther "certificate is not allowed to sign another certificate"+ certificateChainDoesntMatch = CertificateUsageReject $ CertificateRejectOther "chain doesn't match each other" #endif -- | verify a certificates chain using the system certificates available.@@ -99,12 +116,12 @@ -- 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)+ 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.@@ -122,7 +139,7 @@ certMatchDN :: X509 -> X509 -> Bool certMatchDN (X509 testedCert _ _ _ _) (X509 issuerCert _ _ _ _) =- certSubjectDN issuerCert == certIssuerDN testedCert+ certSubjectDN issuerCert == certIssuerDN testedCert verifyF :: SignatureALG -> PubKey -> B.ByteString -> B.ByteString -> Bool @@ -137,63 +154,63 @@ 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 _ _ = \_ _ -> False dsaSHA1Verify pk _ b = DSA.verify SHA1.hash pk asig b- where asig = (0,0) {- FIXME : need to work out how to get R/S from the bytestring a -}+ where asig = (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+ 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] -> 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
@@ -8,23 +8,23 @@ {-# 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_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 import qualified Data.ByteString as B @@ -69,10 +69,10 @@ -- 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]@@ -87,159 +87,159 @@ 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 = BulkNoneF+ } 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- }+ { hashName = "SHA256"+ , hashSize = 32+ , hashF = SHA256.hash+ } hash_null = Hash- { hashName = "null"- , hashSize = 0- , hashF = const B.empty- }+ { 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- }+ { cipherID = 0x0+ , cipherName = "null-null"+ , cipherBulk = bulk_null+ , cipherHash = hash_null+ , cipherKeyExchange = CipherKeyExchange_RSA+ , cipherMinVer = Nothing+ } -- | 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
@@ -6,7 +6,7 @@ -- Portability : unknown -- module Network.TLS.Extra.Compression- (- ) where+ (+ ) where import Network.TLS.Compression
Network/TLS/Extra/Connection.hs view
@@ -6,8 +6,8 @@ -- Portability : unknown -- module Network.TLS.Extra.Connection- ( connectionClient- ) where+ ( connectionClient+ ) where import Crypto.Random.API import Control.Applicative ((<$>))@@ -35,12 +35,12 @@ -- 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+ 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+ 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 view
@@ -1,3 +1,3 @@ module Network.TLS.Extra.Thread- (- ) where+ (+ ) where
tls-extra.cabal view
@@ -1,5 +1,5 @@ Name: tls-extra-Version: 0.6.0+Version: 0.6.1 Description: a set of extra definitions, default values and helpers for tls. License: BSD3@@ -32,7 +32,7 @@ , vector , cipher-rc4 , cipher-aes >= 0.1 && < 0.2- , certificate >= 1.3.0 && < 1.4.0+ , certificate >= 1.3.5 && < 1.4.0 , crypto-pubkey , crypto-random-api , pem >= 0.1.0 && < 0.2.0