change related to the new certificatestore.

debug/src/RetrieveCertificate.hs

@@ -3,12 +3,11 @@
 import Network.TLS
 import Network.TLS.Extra
 
-import Data.Char
 import Data.IORef
 import Data.Time.Clock
 import Data.Certificate.X509
+import System.Certificate.X509
 
-import System.IO
 import Control.Monad
 
 import qualified Crypto.Random.AESCtr as RNG
@@ -77,9 +76,10 @@ main = do
 			showCert (output a) $ head certs
 
 	when (verify a) $ do
+		store <- getSystemCertificateStore
 		putStrLn "### certificate chain trust"
 		ctime <- utctDay `fmap` getCurrentTime
-		certificateVerifyChain certs >>= showUsage "chain validity"
+		certificateVerifyChain store certs >>= showUsage "chain validity"
 		showUsage "time validity" (certificateVerifyValidity ctime certs)
 		when (verifyFQDN a /= "") $
 			showUsage "fqdn match" (certificateVerifyDomain (verifyFQDN a) certs)

debug/src/SimpleClient.hs

@@ -10,6 +10,7 @@ import qualified Data.ByteString.Lazy.Char8 as LC
 import Control.Exception
 import qualified Control.Exception as E
 import System.Environment
+import System.Certificate.X509
 
 import Data.IORef
 
@@ -43,7 +44,7 @@ instance SessionManager SessionRef where
     sessionResume (SessionRef ref) sid = readIORef ref >>= \(s,d) -> if s == sid then return (Just d) else return Nothing
     sessionInvalidate _ _ = return ()
 
-getDefaultParams sStorage session = updateClientParams setCParams $ setSessionManager (SessionRef sStorage) $ defaultParams
+getDefaultParams store sStorage session = updateClientParams setCParams $ setSessionManager (SessionRef sStorage) $ defaultParamsClient
 	{ pConnectVersion    = TLS10
 	, pAllowedVersions   = [TLS10,TLS11,TLS12]
 	, pCiphers           = ciphers
@@ -57,7 +58,7 @@ getDefaultParams sStorage session = updateClientParams setCParams $ setSessionMa
 			{ loggingPacketSent = putStrLn . ("debug: >> " ++)
 			, loggingPacketRecv = putStrLn . ("debug: << " ++)
 			}
-		crecv = if validateCert then certificateVerifyChain else (\_ -> return CertificateUsageAccept)
+		crecv = if validateCert then certificateVerifyChain store else (\_ -> return CertificateUsageAccept)
 
 
 main = do
@@ -65,7 +66,8 @@ main = do
 	args     <- getArgs
 	let hostname = args !! 0
 	let port = read (args !! 1) :: Int
-	runTLS (getDefaultParams sStorage Nothing) hostname (fromIntegral port) $ \ctx -> do
+	store <- getSystemCertificateStore
+	runTLS (getDefaultParams store sStorage Nothing) hostname (fromIntegral port) $ \ctx -> do
 		handshake ctx
 		sendData ctx $ LC.pack "GET / HTTP/1.0\r\n\r\n"
 		d <- recvData' ctx

debug/src/Stunnel.hs

@@ -5,6 +5,7 @@ import Network.Socket
 import System.IO
 import System.IO.Error (isEOFError)
 import System.Console.CmdArgs
+import System.Certificate.X509
 
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
@@ -199,7 +200,8 @@ doClient pargs = do
 		, loggingPacketRecv = putStrLn . ("debug: recv: " ++)
 		}
 
-	let crecv = if validCert pargs then certificateVerifyChain else (\_ -> return CertificateUsageAccept)
+	store <- getSystemCertificateStore
+	let crecv = if validCert pargs then certificateVerifyChain store else (\_ -> return CertificateUsageAccept)
 	let clientstate = defaultParamsClient
 		{ pConnectVersion = TLS10
 		, pAllowedVersions = [TLS10,TLS11,TLS12]

extra/Network/TLS/Extra/Certificate.hs

@@ -20,7 +20,6 @@ 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
@@ -29,6 +28,7 @@ import qualified Crypto.Hash.MD5 as MD5
 import qualified Crypto.Cipher.RSA as RSA
 import qualified Crypto.Cipher.DSA as DSA
 
+import Data.CertificateStore
 import Data.Certificate.X509.Cert (oidCommonName)
 import Network.TLS (CertificateUsage(..), CertificateRejectReason(..))
 
@@ -36,39 +36,17 @@ import Data.Time.Calendar
 import Data.List (find)
 import Data.Maybe (fromMaybe)
 
-#if defined(NOCERTVERIFY)
-
-import System.IO (hPutStrLn, stderr)
-
-#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)
+certificateVerifyChain_ :: CertificateStore -> [X509] -> IO CertificateUsage
-
+certificateVerifyChain_ _     []     = return $ CertificateUsageReject (CertificateRejectOther "empty chain / no certificates")
-# warning "********certificate verify chain doesn't yet work on your platform *************"
+certificateVerifyChain_ store (x:xs) = do
-# 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,
- - for now, print a big fat warning (better than nothing) and returns true  -}
-certificateVerifyChain_ :: [X509] -> IO CertificateUsage
-certificateVerifyChain_ _ = do
-	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_ :: [X509] -> IO CertificateUsage
-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 findCertificate (certIssuerDN $ x509Cert x) store of
-	case foundCert of
 		Just sysx509 -> do
 			validChain <- certificateVerifyAgainst x sysx509
 			if validChain
@@ -79,9 +57,8 @@ certificateVerifyChain_ (x:xs) = do
 			_  -> do
 				validChain <- certificateVerifyAgainst x (head xs)
 				if validChain
-					then certificateVerifyChain_ xs
+					then certificateVerifyChain_ store xs
 					else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other")
-#endif
 
 -- | verify a certificates chain using the system certificates available.
 --
@@ -97,8 +74,8 @@ certificateVerifyChain_ (x:xs) = do
 --
 -- TODO: verify validity, check revocation list if any, add optional user output to know
 -- the rejection reason.
-certificateVerifyChain :: [X509] -> IO CertificateUsage
+certificateVerifyChain :: CertificateStore -> [X509] -> IO CertificateUsage
-certificateVerifyChain = certificateVerifyChain_ . reorderList
+certificateVerifyChain store = certificateVerifyChain_ store . reorderList
 	where
 		reorderList []     = []
 		reorderList (x:xs) =
@@ -158,7 +135,7 @@ rsaVerify h hdesc pk a b = either (Left . show) (Right) $ RSA.verify h hdesc pk
 certificateVerifyDomain :: String -> [X509] -> CertificateUsage
 certificateVerifyDomain _      []                  = CertificateUsageReject (CertificateRejectOther "empty list")
 certificateVerifyDomain fqhn (X509 cert _ _ _ _:_) =
-	let names = maybe [] ((:[]) . snd) (lookup oidCommonName $ certSubjectDN cert)
+	let names = maybe [] ((:[]) . snd) (lookup oidCommonName $ getDistinguishedElements $ certSubjectDN cert)
 	         ++ maybe [] (maybe [] toAltName . extensionGet) (certExtensions cert) in
 	orUsage $ map (matchDomain . splitDot) names
 	where

extra/Tests/Certificate.hs

@@ -12,7 +12,7 @@ import Data.Time.Clock (secondsToDiffTime)
 readableChar :: Gen Char
 readableChar = elements (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'])
 
-arbitraryDN = return []
+arbitraryDN = return $ X509Cert.DistinguishedName []
 
 arbitraryTime = do
 	year   <- choose (1951, 2050)

extra/tls-extra.cabal

@@ -44,8 +44,6 @@ Library
                      Network.TLS.Extra.Thread
                      Network.TLS.Extra.File
   ghc-options:       -Wall -fno-warn-missing-signatures
-  if os(windows)
-    cpp-options:     -DNOCERTVERIFY
   if os(linux) && flag(fastaes) && (arch(i386) || arch(x86_64))
     cpp-options:     -DCIPHER_AES
     Build-Depends:   cipher-aes >= 0.1 && < 0.2
@@ -61,8 +59,6 @@ executable           Tests
                    , cprng-aes >= 0.2.3
   else
     Buildable:       False
-  if os(windows)
-    cpp-options:     -DNOCERTVERIFY
   if os(linux) && flag(fastaes)
     cpp-options:     -DCIPHER_AES
     Build-Depends:   cipher-aes >= 0.1 && < 0.2