tls-extra 0.4.2 → 0.4.2.1

raw patch · 2 files changed

+30/−21 lines, 2 files

Files

• Network/TLS/Extra/Certificate.hs +29/−20
• tls-extra.cabal +1/−1

@@ -50,30 +50,16 @@  {- on windows and OSX, 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_ :: [X509] -> IO TLSCertificateUsage+certificateVerifyChain_ _ = do 	putStrLn "****************** certificate verify chain doesn't yet work on your platform **********************" 	putStrLn "please consider contributing to the certificate package to fix this issue" 	return CertificateUsageAccept  #else--- | 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 :: [X509] -> IO TLSCertificateUsage-certificateVerifyChain []     = return $ CertificateUsageReject (CertificateRejectOther "empty chain / no certificates")-certificateVerifyChain (x:xs) = do+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@@ -87,9 +73,32 @@ 			_  -> do 				validChain <- certificateVerifyAgainst x (head xs) 				if validChain-					then certificateVerifyChain xs+					then certificateVerifyChain_ xs 					else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other") #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 :: [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)  -- | verify a certificate against another one. -- the first certificate need to be signed by the second one for this function to succeed.

@@ -1,5 +1,5 @@ Name:                tls-extra-Version:             0.4.2+Version:             0.4.2.1 Description:    a set of extra definitions, default values and helpers for tls. License:             BSD3