Hello community, here is the log from the commit of package ghc-x509-validation for openSUSE:Factory checked in at 2017-08-31 21:01:54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-x509-validation (Old) and /work/SRC/openSUSE:Factory/.ghc-x509-validation.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-x509-validation" Thu Aug 31 21:01:54 2017 rev:8 rq:513543 version:1.6.8 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-x509-validation/ghc-x509-validation.changes 2016-11-05 21:27:11.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-x509-validation.new/ghc-x509-validation.changes 2017-08-31 21:01:55.537369905 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:04:39 UTC 2017 - psimons@suse.com + +- Update to version 1.6.8. + +------------------------------------------------------------------- Old: ---- x509-validation-1.6.5.tar.gz New: ---- x509-validation-1.6.8.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-x509-validation.spec ++++++ --- /var/tmp/diff_new_pack.UMiqgi/_old 2017-08-31 21:01:56.873182220 +0200 +++ /var/tmp/diff_new_pack.UMiqgi/_new 2017-08-31 21:01:56.897178848 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-x509-validation # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,8 +17,9 @@ %global pkg_name x509-validation +%bcond_with tests Name: ghc-%{pkg_name} -Version: 1.6.5 +Version: 1.6.8 Release: 0 Summary: X.509 Certificate and CRL validation License: BSD-3-Clause @@ -41,6 +42,10 @@ BuildRequires: ghc-x509-devel BuildRequires: ghc-x509-store-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build +%if %{with tests} +BuildRequires: ghc-tasty-devel +BuildRequires: ghc-tasty-hunit-devel +%endif %description X.509 Certificate and CRL validation. @@ -66,6 +71,9 @@ %install %ghc_lib_install +%check +%cabal_test + %post devel %ghc_pkg_recache ++++++ x509-validation-1.6.5.tar.gz -> x509-validation-1.6.8.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/Data/X509/Validation/Signature.hs new/x509-validation-1.6.8/Data/X509/Validation/Signature.hs --- old/x509-validation-1.6.5/Data/X509/Validation/Signature.hs 2016-09-15 22:15:59.000000000 +0200 +++ new/x509-validation-1.6.8/Data/X509/Validation/Signature.hs 2017-06-26 18:12:09.000000000 +0200 @@ -15,12 +15,12 @@ ) where import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import qualified Crypto.PubKey.RSA.PSS as PSS import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.ECC.Prim as ECC import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Crypto.Hash -import Crypto.Number.Basic (numBits) import Crypto.Number.Serialize (os2ip) import Data.ByteString (ByteString) @@ -70,6 +70,19 @@ -> ByteString -- ^ Signature to verify -> SignatureVerification verifySignature (SignatureALG_Unknown _) _ _ _ = SignatureFailed SignatureUnimplemented +verifySignature (SignatureALG hashALG PubKeyALG_RSAPSS) pubkey cdata signature = case verifyF pubkey of + Nothing -> SignatureFailed SignatureUnimplemented + Just f -> if f cdata signature + then SignaturePass + else SignatureFailed SignatureInvalid + where + verifyF (PubKeyRSA key) + | hashALG == HashSHA256 = Just $ PSS.verify (PSS.defaultPSSParams SHA256) key + | hashALG == HashSHA384 = Just $ PSS.verify (PSS.defaultPSSParams SHA384) key + | hashALG == HashSHA512 = Just $ PSS.verify (PSS.defaultPSSParams SHA512) key + | hashALG == HashSHA224 = Just $ PSS.verify (PSS.defaultPSSParams SHA224) key + | otherwise = Nothing + verifyF _ = Nothing verifySignature (SignatureALG hashALG pubkeyALG) pubkey cdata signature | pubkeyToAlg pubkey == pubkeyALG = case verifyF pubkey of Nothing -> SignatureFailed SignatureUnimplemented @@ -80,9 +93,9 @@ where verifyF (PubKeyRSA key) = Just $ rsaVerify hashALG key verifyF (PubKeyDSA key) - | hashALG == HashSHA1 = Just $ \a b -> case dsaToSignature a of - Nothing -> False - Just dsaSig -> DSA.verify SHA1 key dsaSig b + | hashALG == HashSHA1 = Just $ dsaVerify SHA1 key + | hashALG == HashSHA224 = Just $ dsaVerify SHA224 key + | hashALG == HashSHA256 = Just $ dsaVerify SHA256 key | otherwise = Nothing verifyF (PubKeyEC key) = verifyECDSA hashALG key verifyF _ = Nothing @@ -98,6 +111,11 @@ _ -> Nothing + dsaVerify hsh key b a = + case dsaToSignature a of + Nothing -> False + Just dsaSig -> DSA.verify hsh key dsaSig b + rsaVerify HashMD2 = RSA.verify (Just MD2) rsaVerify HashMD5 = RSA.verify (Just MD5) rsaVerify HashSHA1 = RSA.verify (Just SHA1) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/Data/X509/Validation.hs new/x509-validation-1.6.8/Data/X509/Validation.hs --- old/x509-validation-1.6.5/Data/X509/Validation.hs 2016-10-03 09:36:01.000000000 +0200 +++ new/x509-validation-1.6.8/Data/X509/Validation.hs 2017-06-26 18:12:09.000000000 +0200 @@ -45,7 +45,11 @@ import Data.Maybe import Data.List --- | Possible reason of certificate and chain failure +-- | Possible reason of certificate and chain failure. +-- +-- The values 'InvalidName' and 'InvalidWildcard' are internal-only and are +-- never returned by the validation functions. 'NameMismatch' is returned +-- instead. data FailedReason = UnknownCriticalExtension -- ^ certificate contains an unknown critical extension | Expired -- ^ validity ends before checking time @@ -118,10 +122,12 @@ -- BEWARE, it's easy to change behavior leading to compromised security. data ValidationHooks = ValidationHooks { - -- | check the the issuer 'DistinguishedName' match the subject 'DistinguishedName' - -- of a certificate. + -- | check whether a given issuer 'DistinguishedName' matches the subject + -- 'DistinguishedName' of a candidate issuer certificate. hookMatchSubjectIssuer :: DistinguishedName -> Certificate -> Bool - -- | validate that the parametrized time valide with the certificate in argument + -- | check whether the certificate in the second argument is valid at the + -- time provided in the first argument. Return an empty list for success + -- or else one or more failure reasons. , hookValidateTime :: DateTime -> Certificate -> [FailedReason] -- | validate the certificate leaf name with the DNS named used to connect , hookValidateName :: HostName -> Certificate -> [FailedReason] @@ -326,8 +332,13 @@ unAltName _ = Nothing -- | Validate that the fqhn is matched by at least one name in the certificate. --- The name can be either one of the alternative names if the SubjectAltName --- extension is present or the common name. +-- If the subjectAltname extension is present, then the certificate commonName +-- is ignored, and only the DNS names, if any, in the subjectAltName are +-- considered. Otherwise, the commonName from the subjectDN is used. +-- +-- Note that DNS names in the subjectAltName are in IDNA A-label form. If the +-- destination hostname is a UTF-8 name, it must be provided to the TLS context +-- in (non-transitional) IDNA2008 A-label form. validateCertificateName :: HostName -> Certificate -> [FailedReason] validateCertificateName fqhn cert | not $ null altNames = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/Tests/Certificate.hs new/x509-validation-1.6.8/Tests/Certificate.hs --- old/x509-validation-1.6.5/Tests/Certificate.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/x509-validation-1.6.8/Tests/Certificate.hs 2017-07-22 08:57:25.000000000 +0200 @@ -0,0 +1,304 @@ +{-# LANGUAGE GADTs #-} +-- | Types and functions used to build test certificates. +module Certificate + ( + -- * Hash algorithms + hashMD2 + , hashMD5 + , hashSHA1 + , hashSHA224 + , hashSHA256 + , hashSHA384 + , hashSHA512 + -- * Key and signature utilities + , Alg(..) + , Keys + , generateKeys + -- * Certificate utilities + , Pair(..) + , mkDn + , mkExtension + , leafStdExts + -- * Certificate creation functions + , Auth(..) + , mkCertificate + , mkCA + , mkLeaf + ) where + +import Control.Applicative + +import Crypto.Hash.Algorithms +import Crypto.Number.Generate +import Crypto.Number.Serialize + +import qualified Crypto.PubKey.DSA as DSA +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Crypto.PubKey.ECC.Prim as ECC +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import qualified Crypto.PubKey.RSA.PSS as PSS + +import qualified Data.ByteString as B + +import Data.ASN1.BinaryEncoding (DER(..)) +import Data.ASN1.Encoding +import Data.ASN1.Types +import Data.Maybe (catMaybes) +import Data.String (fromString) +import Data.X509 + +import Data.Hourglass + + +-- Crypto utilities -- + +-- | Hash algorithms supported in certificates. +-- +-- This relates the typed hash algorithm @hash@ to the 'HashALG' value. +data GHash hash = GHash { getHashALG :: HashALG, getHashAlgorithm :: hash } + +hashMD2 :: GHash MD2 +hashMD5 :: GHash MD5 +hashSHA1 :: GHash SHA1 +hashSHA224 :: GHash SHA224 +hashSHA256 :: GHash SHA256 +hashSHA384 :: GHash SHA384 +hashSHA512 :: GHash SHA512 + +hashMD2 = GHash HashMD2 MD2 +hashMD5 = GHash HashMD5 MD5 +hashSHA1 = GHash HashSHA1 SHA1 +hashSHA224 = GHash HashSHA224 SHA224 +hashSHA256 = GHash HashSHA256 SHA256 +hashSHA384 = GHash HashSHA384 SHA384 +hashSHA512 = GHash HashSHA512 SHA512 + +-- | Signature and hash algorithms instantiated with parameters. +data Alg pub priv where + AlgRSA :: (HashAlgorithm hash, RSA.HashAlgorithmASN1 hash) + => Int + -> GHash hash + -> Alg RSA.PublicKey RSA.PrivateKey + + AlgRSAPSS :: HashAlgorithm hash + => Int + -> PSS.PSSParams hash B.ByteString B.ByteString + -> GHash hash + -> Alg RSA.PublicKey RSA.PrivateKey + + AlgDSA :: HashAlgorithm hash + => DSA.Params + -> GHash hash + -> Alg DSA.PublicKey DSA.PrivateKey + + AlgEC :: HashAlgorithm hash + => ECC.CurveName + -> GHash hash + -> Alg ECDSA.PublicKey ECDSA.PrivateKey + +-- | Types of public and private keys used by a signature algorithm. +type Keys pub priv = (Alg pub priv, pub, priv) + +-- | Generates random keys for a signature algorithm. +generateKeys :: Alg pub priv -> IO (Keys pub priv) +generateKeys alg@(AlgRSA bits _) = generateRSAKeys alg bits +generateKeys alg@(AlgRSAPSS bits _ _) = generateRSAKeys alg bits +generateKeys alg@(AlgDSA params _) = do + x <- DSA.generatePrivate params + let y = DSA.calculatePublic params x + return (alg, DSA.PublicKey params y, DSA.PrivateKey params x) +generateKeys alg@(AlgEC name _) = do + d <- generateBetween 1 (n - 1) + let p = ECC.pointBaseMul curve d + return (alg, ECDSA.PublicKey curve p, ECDSA.PrivateKey curve d) + where + curve = ECC.getCurveByName name + n = ECC.ecc_n . ECC.common_curve $ curve + +generateRSAKeys :: Alg RSA.PublicKey RSA.PrivateKey + -> Int + -> IO (Alg RSA.PublicKey RSA.PrivateKey, RSA.PublicKey, RSA.PrivateKey) +generateRSAKeys alg bits = addAlg <$> RSA.generate size e + where + addAlg (pub, priv) = (alg, pub, priv) + size = bits `div` 8 + e = 3 + +getPubKey :: Alg pub priv -> pub -> PubKey +getPubKey (AlgRSA _ _) key = PubKeyRSA key +getPubKey (AlgRSAPSS _ _ _) key = PubKeyRSA key +getPubKey (AlgDSA _ _) key = PubKeyDSA key +getPubKey (AlgEC name _) key = PubKeyEC (PubKeyEC_Named name pub) + where + ECC.Point x y = ECDSA.public_q key + pub = SerializedPoint bs + bs = B.cons 4 (i2ospOf_ bytes x `B.append` i2ospOf_ bytes y) + bits = ECC.curveSizeBits (ECC.getCurveByName name) + bytes = (bits + 7) `div` 8 + +getSignatureALG :: Alg pub priv -> SignatureALG +getSignatureALG (AlgRSA _ hash) = SignatureALG (getHashALG hash) PubKeyALG_RSA +getSignatureALG (AlgRSAPSS _ _ hash) = SignatureALG (getHashALG hash) PubKeyALG_RSAPSS +getSignatureALG (AlgDSA _ hash) = SignatureALG (getHashALG hash) PubKeyALG_DSA +getSignatureALG (AlgEC _ hash) = SignatureALG (getHashALG hash) PubKeyALG_EC + +doSign :: Alg pub priv -> priv -> B.ByteString -> IO B.ByteString +doSign (AlgRSA _ hash) key msg = do + result <- RSA.signSafer (Just $ getHashAlgorithm hash) key msg + case result of + Left err -> error ("doSign(AlgRSA): " ++ show err) + Right sigBits -> return sigBits +doSign (AlgRSAPSS _ params _) key msg = do + result <- PSS.signSafer params key msg + case result of + Left err -> error ("doSign(AlgRSAPSS): " ++ show err) + Right sigBits -> return sigBits +doSign (AlgDSA _ hash) key msg = do + sig <- DSA.sign key (getHashAlgorithm hash) msg + return $ encodeASN1' DER + [ Start Sequence + , IntVal (DSA.sign_r sig) + , IntVal (DSA.sign_s sig) + , End Sequence + ] +doSign (AlgEC _ hash) key msg = do + sig <- ECDSA.sign key (getHashAlgorithm hash) msg + return $ encodeASN1' DER + [ Start Sequence + , IntVal (ECDSA.sign_r sig) + , IntVal (ECDSA.sign_s sig) + , End Sequence + ] + + +-- Certificate utilities -- + +-- | Holds together a certificate and its private key for convenience. +-- +-- Contains also the crypto algorithm that both are issued from. This is +-- useful when signing another certificate. +data Pair pub priv = Pair + { pairAlg :: Alg pub priv + , pairSignedCert :: SignedCertificate + , pairKey :: priv + } + +-- | Builds a DN with a single component. +mkDn :: String -> DistinguishedName +mkDn cn = DistinguishedName [(getObjectID DnCommonName, fromString cn)] + +-- | Used to build a certificate extension. +mkExtension :: Extension a => Bool -> a -> ExtensionRaw +mkExtension crit ext = ExtensionRaw (extOID ext) crit (extEncodeBs ext) + +-- | Default extensions in leaf certificates. +leafStdExts :: [ExtensionRaw] +leafStdExts = [ku, eku] + where + ku = mkExtension False $ ExtKeyUsage + [ KeyUsage_digitalSignature , KeyUsage_keyEncipherment ] + eku = mkExtension False $ ExtExtendedKeyUsage + [ KeyUsagePurpose_ServerAuth , KeyUsagePurpose_ClientAuth ] + + +-- Authority signing a certificate -- +-- +-- When the certificate is self-signed, issuer and subject are the same. So +-- they have identical signature algorithms. The purpose of the GADT is to +-- hold this constraint only in the self-signed case. + +-- | Authority signing a certificate, itself or another certificate. +data Auth pubI privI pubS privS where + Self :: (pubI ~ pubS, privI ~ privS) => Auth pubI privI pubS privS + CA :: Pair pubI privI -> Auth pubI privI pubS privS + +foldAuth :: a + -> (Pair pubI privI -> a) + -> Auth pubI privI pubS privS + -> a +foldAuth x _ Self = x -- no constraint used +foldAuth _ f (CA p) = f p + +foldAuthPriv :: privS + -> (Pair pubI privI -> privI) + -> Auth pubI privI pubS privS + -> privI +foldAuthPriv x _ Self = x -- uses constraint privI ~ privS +foldAuthPriv _ f (CA p) = f p + +foldAuthPubPriv :: k pubS privS + -> (Pair pubI privI -> k pubI privI) + -> Auth pubI privI pubS privS + -> k pubI privI +foldAuthPubPriv x _ Self = x -- uses both constraints +foldAuthPubPriv _ f (CA p) = f p + + +-- Certificate creation functions -- + +-- | Builds a certificate using the supplied keys and signs it with an +-- authority (itself or another certificate). +mkCertificate :: Int -- ^ Certificate version + -> Integer -- ^ Serial number + -> DistinguishedName -- ^ Subject DN + -> (DateTime, DateTime) -- ^ Certificate validity period + -> [ExtensionRaw] -- ^ Extensions to include + -> Auth pubI privI pubS privS -- ^ Authority signing the new certificate + -> Keys pubS privS -- ^ Keys for the new certificate + -> IO (Pair pubS privS) -- ^ The new certificate/key pair +mkCertificate version serial dn validity exts auth (algS, pubKey, privKey) = do + signedCert <- objectToSignedExactF signatureFunction cert + return Pair { pairAlg = algS + , pairSignedCert = signedCert + , pairKey = privKey + } + + where + pairCert = signedObject . getSigned . pairSignedCert + + cert = Certificate + { certVersion = version + , certSerial = serial + , certSignatureAlg = signAlgI + , certIssuerDN = issuerDN + , certValidity = validity + , certSubjectDN = dn + , certPubKey = getPubKey algS pubKey + , certExtensions = extensions + } + + signingKey = foldAuthPriv privKey pairKey auth + algI = foldAuthPubPriv algS pairAlg auth + + signAlgI = getSignatureALG algI + issuerDN = foldAuth dn (certSubjectDN . pairCert) auth + extensions = Extensions (if null exts then Nothing else Just exts) + + signatureFunction objRaw = do + sigBits <- doSign algI signingKey objRaw + return (sigBits, signAlgI) + +-- | Builds a CA certificate using the supplied keys and signs it with an +-- authority (itself or another certificate). +mkCA :: Integer -- ^ Serial number + -> String -- ^ Common name + -> (DateTime, DateTime) -- ^ CA validity period + -> Maybe ExtBasicConstraints -- ^ CA basic constraints + -> Maybe ExtKeyUsage -- ^ CA key usage + -> Auth pubI privI pubS privS -- ^ Authority signing the new certificate + -> Keys pubS privS -- ^ Keys for the new certificate + -> IO (Pair pubS privS) -- ^ The new CA certificate/key pair +mkCA serial cn validity bc ku = + let exts = catMaybes [ mkExtension True <$> bc, mkExtension False <$> ku ] + in mkCertificate 2 serial (mkDn cn) validity exts + +-- | Builds a leaf certificate using the supplied keys and signs it with an +-- authority (itself or another certificate). +mkLeaf :: String -- ^ Common name + -> (DateTime, DateTime) -- ^ Certificate validity period + -> Auth pubI privI pubS privS -- ^ Authority signing the new certificate + -> Keys pubS privS -- ^ Keys for the new certificate + -> IO (Pair pubS privS) -- ^ The new leaf certificate/key pair +mkLeaf cn validity = mkCertificate 2 100 (mkDn cn) validity leafStdExts diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/Tests/Tests.hs new/x509-validation-1.6.8/Tests/Tests.hs --- old/x509-validation-1.6.5/Tests/Tests.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/x509-validation-1.6.8/Tests/Tests.hs 2017-06-26 18:12:09.000000000 +0200 @@ -0,0 +1,595 @@ +-- | Validation test suite. +module Main (main) where + +import Control.Applicative +import Control.Monad (unless) + +import Crypto.Hash.Algorithms + +import qualified Crypto.PubKey.DSA as DSA +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Crypto.PubKey.RSA.PSS as PSS + +import Data.Default.Class +import Data.Monoid +import Data.String (fromString) +import Data.X509 +import Data.X509.CertificateStore +import Data.X509.Validation + +import Data.Hourglass +import System.Hourglass + +import Test.Tasty +import Test.Tasty.HUnit + +import Certificate + + +-- Runtime data, dynamically generated and shared by all test cases -- + +data RData pub priv = RData + { rootStore :: CertificateStore + , past :: (DateTime, DateTime) + , present :: (DateTime, DateTime) + , future :: (DateTime, DateTime) + , pastDate :: DateTime + , presentDate :: DateTime + , futureDate :: DateTime + , root :: Pair pub priv + , intermediate :: Pair pub priv + , intermediate0 :: Pair pub priv + , intermediatePast :: Pair pub priv + , intermediateFuture :: Pair pub priv + , keys1 :: Keys pub priv + , keys2 :: Keys pub priv + , keys3 :: Keys pub priv + } + +mkDateTime :: Date -> DateTime +mkDateTime d = DateTime d (TimeOfDay 0 0 0 0) + +mkStore :: [Pair pub priv] -> CertificateStore +mkStore ps = makeCertificateStore (map pairSignedCert ps) + +initData :: Alg pub priv -> IO (RData pub priv) +initData alg = do + today <- timeGetDate <$> timeCurrent + + let m3 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = -3 } + let m2 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = -2 } + let m1 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = -1 } + let n1 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = 1 } + let n2 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = 2 } + let n3 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = 3 } + + -- two-year validity periods in past, present and future + let vPast = (m3, m1) -- Year-3 .. Year-1 + let vPresent = (m1, n1) -- Year-1 .. Year+1 + let vFuture = (n1, n3) -- Year+1 .. Year+3 + + -- CA basic constraints and key usage extensions + let bc = Just $ ExtBasicConstraints True Nothing + let bc0 = Just $ ExtBasicConstraints True (Just 0) + let ku = Nothing + + -- Root CAs in past, present and future. Need distinct DNs because the + -- certificate store contains all 3 simultaneously. + rootPast <- generateKeys alg >>= mkCA 1 "RootCA - R1" vPast bc ku Self + rootPresent <- generateKeys alg >>= mkCA 2 "RootCA - R2" vPresent bc ku Self + rootFuture <- generateKeys alg >>= mkCA 3 "RootCA - R3" vFuture bc ku Self + + -- Intermediate CAs in past, present and future. Also includes a CA with + -- a depth constraint. + pIntermediateP <- generateKeys alg >>= mkCA 11 "IntermediateCA" vPast bc ku (CA rootPast) + pIntermediate <- generateKeys alg >>= mkCA 12 "IntermediateCA" vPresent bc ku (CA rootPresent) + pIntermediate0 <- generateKeys alg >>= mkCA 12 "IntermediateCA" vPresent bc0 ku (CA rootPresent) + pIntermediateF <- generateKeys alg >>= mkCA 13 "IntermediateCA" vFuture bc ku (CA rootFuture) + + -- Additional keys to be reused in test cases. This removes the cost of + -- generating individual keys. A key should be used only once per case. + k1 <- generateKeys alg + k2 <- generateKeys alg + k3 <- generateKeys alg + + return RData + { rootStore = mkStore [ rootPast, rootPresent, rootFuture ] + , past = vPast + , present = vPresent + , future = vFuture + , pastDate = m2 -- Year-2 + , presentDate = mkDateTime today + , futureDate = n2 -- Year+2 + , root = rootPresent + , intermediate = pIntermediate + , intermediate0 = pIntermediate0 + , intermediatePast = pIntermediateP + , intermediateFuture = pIntermediateF + , keys1 = k1 + , keys2 = k2 + , keys3 = k3 + } + +freeData :: RData pub priv -> IO () +freeData _ = return () + + +-- Test utilities -- + +-- | Asserts order-insensitive equality for lists. This also ignores +-- duplicate elements. +assertEqualList :: (Eq a, Show a) => String -- ^ The message prefix + -> [a] -- ^ The expected value + -> [a] -- ^ The actual value + -> Assertion +assertEqualList preface expected actual = + unless (actual `same` expected) (assertFailure msg) + where + a `same` b = all (`elem` b) a && all (`elem` a) b + msg = (if null preface then "" else preface ++ "\n") ++ + " expected: " ++ show expected ++ "\n but got: " ++ show actual + +-- | Asserts the validation result of a certificate chain. +assertValidationResult :: RData pub priv -- ^ Common test resources (CA store) + -> ValidationChecks -- ^ Checks to do + -> HostName -- ^ Connection identification + -> [Pair pub priv] -- ^ Certificate chain to validate + -> [FailedReason] -- ^ Expected validation result + -> Assertion +assertValidationResult rd checks hostname ps expected = do + actual <- validate HashSHA256 defaultHooks checks store def ident chain + assertEqualList "Unexpected validation result" expected actual + where + store = rootStore rd + ident = (hostname, fromString ":443") + chain = CertificateChain (map pairSignedCert ps) + +-- | Simplified access to test resource from 'withResource'. +testWithRes :: IO r -> TestName -> (r -> Assertion) -> TestTree +testWithRes res caseName f = testCase caseName (res >>= f) + + +-- Test cases -- + +-- | Tests a leaf certificate signed by an intermediate CA, but using a chain +-- where the intermediate CA may use a different key. This tests the signature +-- of the leaf certificate provided both CAs have the same subject DN. +testSignature :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> (RData pub priv -> Pair pub priv) -- ^ CA to use for signature + -> (RData pub priv -> Pair pub priv) -- ^ CA to use for validation + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testSignature res caseName f g expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "signature" (present rd) (CA $ f rd) (keys1 rd) + assertValidationResult rd defaultChecks "signature" [pair, g rd] expected + +-- | Tests an empty certificate chain. +testEmpty :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testEmpty res caseName expected = testWithRes res caseName $ \rd -> + assertValidationResult rd defaultChecks "empty" [] expected + +-- | Tests a certificate chain where the intermediate CA is missing. +testIncompleteChain :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testIncompleteChain res caseName expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "incomplete" (present rd) (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd defaultChecks "incomplete" [pair] expected + +-- | Tests a self-signed certificate. +testSelfSigned :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testSelfSigned res caseName expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "self-signed" (present rd) Self (keys1 rd) + assertValidationResult rd defaultChecks "self-signed" [pair] expected + +-- | Tests key usage of intermediate CA, with or without 'checkCAConstraints'. +testCAKeyUsage :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkCAConstraints' + -> ExtKeyUsageFlag -- ^ Intermediate CA key usage + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testCAKeyUsage res caseName check flag expected = testWithRes res caseName $ \rd -> do + ca <- mkCA 20 "KeyUsageCA" (present rd) bc ku (CA $ root rd) (keys1 rd) + pair <- mkLeaf "ca-key-usage" (present rd) (CA ca) (keys2 rd) + assertValidationResult rd checks "ca-key-usage" [pair, ca] expected + where + checks = defaultChecks { checkCAConstraints = check } + bc = Just (ExtBasicConstraints True Nothing) + ku = Just (ExtKeyUsage [flag]) + +-- | Tests CA flag of intermediate CA, with or without 'checkCAConstraints'. +testNotCA :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkCAConstraints' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testNotCA res caseName check expected = testWithRes res caseName $ \rd -> do + ca <- mkCA 20 "NotCA" (present rd) bc Nothing (CA $ root rd) (keys1 rd) + pair <- mkLeaf "not-ca" (present rd) (CA ca) (keys2 rd) + assertValidationResult rd checks "not-ca" [pair, ca] expected + where + checks = defaultChecks { checkCAConstraints = check } + bc = Just (ExtBasicConstraints False Nothing) + +-- | Tests an intermediate CA without basic constraints, with or without +-- 'checkCAConstraints'. +testNoBasic :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkCAConstraints' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testNoBasic res caseName check expected = testWithRes res caseName $ \rd -> do + ca <- mkCA 20 "NoBC" (present rd) bc Nothing (CA $ root rd) (keys1 rd) + pair <- mkLeaf "no-bc" (present rd) (CA ca) (keys2 rd) + assertValidationResult rd checks "no-bc" [pair, ca] expected + where + checks = defaultChecks { checkCAConstraints = check } + bc = Nothing + +-- | Tests basic constraints depth, with or without 'checkCAConstraints'. +testBadDepth :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkCAConstraints' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testBadDepth res caseName check expected = testWithRes res caseName $ \rd -> do + -- a new CA signed by intermediate0 should fail because of the depth limit + ca <- mkCA 20 "TooDeep" (present rd) bc Nothing (CA $ intermediate0 rd) (keys1 rd) + pair <- mkLeaf "bad-depth" (present rd) (CA ca) (keys2 rd) + assertValidationResult rd checks "bad-depth" [pair, ca, intermediate0 rd] expected + where + checks = defaultChecks { checkCAConstraints = check } + bc = Just (ExtBasicConstraints True Nothing) + +-- | Tests a non-V3 leaf certificate, with or without 'checkLeafV3'. +testLeafNotV3 :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkLeafV3' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testLeafNotV3 res caseName check expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 1 100 dn (present rd) leafStdExts (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks "leaf-not-v3" [pair, intermediate rd] expected + where + checks = defaultChecks { checkLeafV3 = check } + dn = mkDn "leaf-not-v3" + +-- | Tests a certificate chain containing a non-related certificate, with or +-- without 'checkStrictOrdering'. +testStrictOrdering :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkStrictOrdering' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testStrictOrdering res caseName check expected = testWithRes res caseName $ \rd -> do + ca <- mkCA 20 "CA" (present rd) bc Nothing (CA $ intermediate rd) (keys1 rd) + extra <- mkCA 21 "Extra" (present rd) bc Nothing (CA $ intermediate rd) (keys2 rd) + pair <- mkLeaf "strict-ordering" (present rd) (CA ca) (keys3 rd) + assertValidationResult rd checks "strict-ordering" [pair, ca, extra, intermediate rd] expected + where + checks = defaultChecks { checkStrictOrdering = check } + bc = Just (ExtBasicConstraints True Nothing) + +-- | Tests validity of leaf certificate. +testLeafDates :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkTimeValidity' + -> (RData pub priv -> (DateTime, DateTime)) -- ^ Validity period to use + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testLeafDates res caseName check f expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "leaf-dates" (f rd) (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks "leaf-dates" [pair, intermediate rd] expected + where + checks = defaultChecks { checkTimeValidity = check } + +-- | Tests validity of intermediate CA. +testIntermediateDates :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkTimeValidity' + -> (RData pub priv -> Pair pub priv) -- ^ Intermediate CA to use + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testIntermediateDates res caseName check f expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "intermediate-dates" (present rd) (CA $ f rd) (keys1 rd) + assertValidationResult rd checks "intermediate-dates" [pair, f rd] expected + where + checks = defaultChecks { checkTimeValidity = check } + +-- | Tests validity of leaf certificate and intermediate CA, +-- using 'checkAtTime'. +testTimeshift :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> (RData pub priv -> (DateTime, DateTime)) -- ^ Leaf validity period + -> (RData pub priv -> Pair pub priv) -- ^ Intermediate CA to use + -> (RData pub priv -> DateTime) -- ^ Value for 'checkAtTime' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testTimeshift res caseName f g h expected = testWithRes res caseName $ \rd -> do + let checks = defaultChecks { checkAtTime = Just $ h rd } + pair <- mkLeaf "timeshift" (f rd) (CA $ g rd) (keys1 rd) + assertValidationResult rd checks "timeshift" [pair, g rd] expected + +-- | Tests an empty DistinguishedName. +testNoCommonName :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testNoCommonName res caseName expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 2 100 dn (present rd) leafStdExts (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd defaultChecks "no-cn" [pair, intermediate rd] expected + where + dn = DistinguishedName [] + +-- | Tests certificate CommonName against expected hostname, with or without +-- 'checkFQHN'. +testCommonName :: IO (RData pub priv) -- ^ Common test resources + -> String -- ^ Certificate CommonName + -> HostName -- ^ Connection identification + -> Bool -- ^ Value for 'checkFQHN' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testCommonName res cn hostname check expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf cn (present rd) (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks hostname [pair, intermediate rd] expected + where + caseName = if null hostname then "empty" else hostname + checks = defaultChecks { checkFQHN = check } + +-- | Tests certificate SubjectAltName against expected hostname, with or +-- without 'checkFQHN'. +testSubjectAltName :: IO (RData pub priv) -- ^ Common test resources + -> String -- ^ Certificate SubjectAltName + -> HostName -- ^ Connection identification + -> Bool -- ^ Value for 'checkFQHN' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testSubjectAltName res san hostname check expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 2 100 dn (present rd) (ext:leafStdExts) (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks hostname [pair, intermediate rd] expected + where + caseName = if null hostname then "empty" else hostname + checks = defaultChecks { checkFQHN = check } + dn = mkDn "cn-not-used" -- this CN value is to be tested too + -- (to make sure CN is *not* considered when a + -- SubjectAltName exists) + ext = mkExtension False $ + -- wraps test value with other values + ExtSubjectAltName [ AltNameDNS "dummy1" + , AltNameRFC822 "test@example.com" + , AltNameDNS san + , AltNameDNS "dummy2" + ] + +-- | Tests 'checkLeafKeyUsage'. +testLeafKeyUsage :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [ExtKeyUsageFlag] -- ^ Certificate flags + -> [ExtKeyUsageFlag] -- ^ Flags required for validation + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testLeafKeyUsage res caseName cFlags vFlags expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 2 100 dn (present rd) exts (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks "key-usage" [pair, intermediate rd] expected + where + checks = defaultChecks { checkLeafKeyUsage = vFlags } + dn = mkDn "key-usage" + exts = if null cFlags then [] else [mkExtension False (ExtKeyUsage cFlags)] + +-- | Tests 'checkLeafKeyPurpose'. +testLeafKeyPurpose :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [ExtKeyUsagePurpose] -- ^ Certificate flags + -> [ExtKeyUsagePurpose] -- ^ Flags required for validation + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testLeafKeyPurpose res caseName cFlags vFlags expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 2 100 dn (present rd) exts (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks "key-purpose" [pair, intermediate rd] expected + where + checks = defaultChecks { checkLeafKeyPurpose = vFlags } + dn = mkDn "key-purpose" + exts = if null cFlags then [] else [mkExtension False (ExtExtendedKeyUsage cFlags)] + +-- | Tests validation with multiple failure reasons in exhaustive mode. +testExhaustive :: IO (RData pub priv) -- ^ Common test resources + -> String -- ^ Certificate CommonName + -> HostName -- ^ Connection identification + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testExhaustive res cn hostname expected = testWithRes res caseName $ \rd -> do + -- build an expired self-signed certificate with an invalid signature: + -- the certificate is actually signed by a clone using a different key + p1 <- mkLeaf cn (past rd) Self (keys1 rd) + p2 <- mkLeaf cn (past rd) (CA p1) (keys2 rd) + assertValidationResult rd checks hostname [p2] expected + where + caseName = if null hostname then "empty" else hostname + checks = defaultChecks { checkExhaustive = True } + + +-- | All validation test cases. +treeWithAlg :: TestName -> Alg pub priv -> TestTree +treeWithAlg groupName alg = withResource (initData alg) freeData $ \res -> + testGroup groupName + [ testGroup "signature" + [ testSignature res "valid" intermediate intermediate [] + , testSignature res "invalid" intermediate intermediate0 [InvalidSignature SignatureInvalid] + ] + , testGroup "chain" + [ testEmpty res "empty" [EmptyChain] + , testIncompleteChain res "incomplete" [UnknownCA] + , testSelfSigned res "self-signed" [SelfSigned] + , testGroup "leaf-not-v3" + [ testLeafNotV3 res "v3-disallowed" True [LeafNotV3] + , testLeafNotV3 res "v3-allowed" False [] + ] + , testGroup "strict-ordering" + [ testStrictOrdering res "enabled" True [UnknownCA] + , testStrictOrdering res "disabled" False [] + ] + ] + , testGroup "ca-constraints" + [ testGroup "enabled" + [ testCAKeyUsage res "cert-sign" True KeyUsage_keyCertSign [] + , testCAKeyUsage res "crl-sign" True KeyUsage_cRLSign [NotAllowedToSign] + , testNotCA res "not-ca" True [NotAnAuthority] + , testNoBasic res "no-basic" True [NotAnAuthority] + , testBadDepth res "bad-depth" True [AuthorityTooDeep] + ] + , testGroup "disabled" + [ testCAKeyUsage res "cert-sign" False KeyUsage_keyCertSign [] + , testCAKeyUsage res "crl-sign" False KeyUsage_cRLSign [] + , testNotCA res "not-ca" False [] + , testNoBasic res "no-basic" False [] + , testBadDepth res "bad-depth" False [] + ] + ] + , testGroup "dates" + [ testGroup "leaf" + [ testGroup "enabled" + [ testLeafDates res "past" True past [Expired] + , testLeafDates res "present" True present [] + , testLeafDates res "future" True future [InFuture] + ] + , testGroup "disabled" + [ testLeafDates res "past" False past [] + , testLeafDates res "present" False present [] + , testLeafDates res "future" False future [] + ] + ] + , testGroup "intermediate" + [ testGroup "enabled" + [ testIntermediateDates res "past" True intermediatePast [Expired] + , testIntermediateDates res "present" True intermediate [] + , testIntermediateDates res "future" True intermediateFuture [InFuture] + ] + , testGroup "disabled" + [ testIntermediateDates res "past" False intermediatePast [] + , testIntermediateDates res "present" False intermediate [] + , testIntermediateDates res "future" False intermediateFuture [] + ] + ] + , testGroup "timeshift" + [ testGroup "at-past" + [ testTimeshift res "past" past intermediatePast pastDate [] + , testTimeshift res "present" present intermediate pastDate [InFuture] + , testTimeshift res "future" future intermediateFuture pastDate [InFuture] + ] + , testGroup "at-present" + [ testTimeshift res "past" past intermediatePast presentDate [Expired] + , testTimeshift res "present" present intermediate presentDate [] + , testTimeshift res "future" future intermediateFuture presentDate [InFuture] + ] + , testGroup "in-future" + [ testTimeshift res "past" past intermediatePast futureDate [Expired] + , testTimeshift res "present" present intermediate futureDate [Expired] + , testTimeshift res "future" future intermediateFuture futureDate [] + ] + ] + ] + , testGroup "CommonName" + [ testNoCommonName res "no-common-name" [NoCommonName] + , testGroup "simple" + [ testCommonName res "www.example.com" "www.example.com" True [] + , testCommonName res "www.example.com" "www2.example.com" True [NameMismatch "www2.example.com"] + , testCommonName res "www.example.com" "WWW.EXAMPLE.COM" True [] + , testCommonName res "www.example.com" "www.EXAMPLE.COM" True [] + , testCommonName res "www.example.com" "WWW.example.com" True [] + , testCommonName res "www..example.com" "www..example.com" True [NameMismatch "www..example.com"] -- InvalidName "www..example.com" + , testCommonName res "" "" True [NameMismatch ""] -- InvalidName "" + ] + , testGroup "wildcard" + [ testCommonName res "*.example.com" "example.com" True [NameMismatch "example.com"] + , testCommonName res "*.example.com" "www.example.com" True [] + , testCommonName res "*.example.com" "www.EXAMPLE.com" True [] + , testCommonName res "*.example.com" "www2.example.com" True [] + , testCommonName res "*.example.com" "www.m.example.com" True [NameMismatch "www.m.example.com"] + , testCommonName res "*" "single" True [NameMismatch "single"] -- InvalidWildcard + ] + , testGroup "disabled" + [ testCommonName res "www.example.com" "www.example.com" False [] + , testCommonName res "www.example.com" "www2.example.com" False [] + , testCommonName res "www.example.com" "WWW.EXAMPLE.COM" False [] + , testCommonName res "www.example.com" "www.EXAMPLE.COM" False [] + , testCommonName res "www.example.com" "WWW.example.com" False [] + , testCommonName res "www..example.com" "www..example.com" False [] + , testCommonName res "" "" False [] + ] + ] + , testGroup "SubjectAltName" + [ testGroup "simple" + [ testSubjectAltName res "www.example.com" "www.example.com" True [] + , testSubjectAltName res "www.example.com" "www2.example.com" True [NameMismatch "www2.example.com"] + , testSubjectAltName res "www.example.com" "WWW.EXAMPLE.COM" True [] + , testSubjectAltName res "www.example.com" "www.EXAMPLE.COM" True [] + , testSubjectAltName res "www.example.com" "WWW.example.com" True [] + , testSubjectAltName res "www..example.com" "www..example.com" True [NameMismatch "www..example.com"] -- InvalidName "www..example.com" + , testSubjectAltName res "" "" True [NameMismatch ""] -- InvalidName "" + ] + , testGroup "wildcard" + [ testSubjectAltName res "*.example.com" "example.com" True [NameMismatch "example.com"] + , testSubjectAltName res "*.example.com" "www.example.com" True [] + , testSubjectAltName res "*.example.com" "www.EXAMPLE.com" True [] + , testSubjectAltName res "*.example.com" "www2.example.com" True [] + , testSubjectAltName res "*.example.com" "www.m.example.com" True [NameMismatch "www.m.example.com"] + , testSubjectAltName res "*" "single" True [NameMismatch "single"] -- InvalidWildcard + ] + , testSubjectAltName res "www.example.com" "cn-not-used" True [NameMismatch "cn-not-used"] + , testGroup "disabled" + [ testSubjectAltName res "www.example.com" "www.example.com" False [] + , testSubjectAltName res "www.example.com" "www2.example.com" False [] + , testSubjectAltName res "www.example.com" "WWW.EXAMPLE.COM" False [] + , testSubjectAltName res "www.example.com" "www.EXAMPLE.COM" False [] + , testSubjectAltName res "www.example.com" "WWW.example.com" False [] + , testSubjectAltName res "www..example.com" "www..example.com" False [] + , testSubjectAltName res "" "" False [] + ] + ] + , testGroup "key-usage" + [ testLeafKeyUsage res "none" [] [u2, u3] [] + , testLeafKeyUsage res "valid" [u1, u2, u3] [u2, u3] [] + , testLeafKeyUsage res "invalid" [u1, u3] [u2, u3] [LeafKeyUsageNotAllowed] + ] + , testGroup "key-purpose" + [ testLeafKeyPurpose res "none" [] [p2, p3] [] + , testLeafKeyPurpose res "valid" [p1, p2, p3] [p2, p3] [] + , testLeafKeyPurpose res "invalid" [p1, p3] [p2, p3] [LeafKeyPurposeNotAllowed] + ] + , testExhaustive res "exhaustive2" "exhaustive" + [ SelfSigned + , Expired + , InvalidSignature SignatureInvalid + , NameMismatch "exhaustive" + ] + ] + where + (u1, u2, u3) = (KeyUsage_keyEncipherment, KeyUsage_dataEncipherment, KeyUsage_keyAgreement) + (p1, p2, p3) = (KeyUsagePurpose_ClientAuth, KeyUsagePurpose_CodeSigning, KeyUsagePurpose_EmailProtection) + +-- | Runs the test suite. +main :: IO () +main = defaultMain $ testGroup "Validation" + [ treeWithAlg "RSA" (AlgRSA 2048 hashSHA256) + , treeWithAlg "RSAPSS" (AlgRSAPSS 2048 pssParams hashSHA224) + , treeWithAlg "DSA" (AlgDSA dsaParams hashSHA1) + , treeWithAlg "ECDSA" (AlgEC curveName hashSHA512) + ] + where + pssParams = PSS.defaultPSSParams SHA224 + -- DSA parameters were generated using 'openssl dsaparam -C 2048' + dsaParams = DSA.Params + { DSA.params_p = 0x9994B9B1FC22EC3A5F607B5130D314F35FC8D387015A6D8FA2B56D3CC1F13FE330A631DBC765CEFFD6986BDEB8512580BBAD93D56EE7A8997DB9C65C29313FBC5077DB6F1E9D9E6D3499F997F09C8CF8ECC9E5F38DC34C3D656CFDF463893DDF9E246E223D7E5C4E86F54426DDA5DE112FCEDBFB5B6D6F7C76ED190EA1A7761CA561E8E5803F9D616DAFF25E2CCD4011A6D78D5CE8ED28CC2D865C7EC01508BA96FBD1F8BB5E517B6A5208A90AC2D3DCAE50281C02510B86C16D449465CD4B3754FD91AA19031282122A25C68292F033091FCB9DEBDE0D220F81F7EE4AB6581D24BE48204AF3DA52BDB944DA53B76148055395B30954735DC911574D360C953B + , DSA.params_g = 0x10E51AEA37880C5E52DD477ED599D55050C47012D038B9E4B3199C9DE9A5B873B1ABC8B954F26AFEA6C028BCE1783CFE19A88C64E4ED6BFD638802A78457A5C25ABEA98BE9C6EF18A95504C324315EABE7C1EA50E754591E3EFD3D33D4AE47F82F8978ABC871C135133767ACC60683F065430C749C43893D73596B12D5835A78778D0140B2F63B32A5658308DD5BA6BBC49CF6692929FA6A966419404F9A2C216860E3F339EDDB49AD32C294BDB4C9C6BB0D1CC7B691C65968C3A0A5106291CD3810147C8A16B4BFE22968AD9D3890733F4AA9ACD8687A5B981653A4B1824004639956E8C1EDAF31A8224191E8ABD645D2901F5B164B4B93F98039A6EAEC6088 + , DSA.params_q = 0xE1FDFADD32F46B5035EEB3DB81F9974FBCA69BE2223E62FCA8C77989B2AACDF7 + } + curveName = ECC.SEC_p384r1 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/x509-validation.cabal new/x509-validation-1.6.8/x509-validation.cabal --- old/x509-validation-1.6.5/x509-validation.cabal 2016-10-03 09:47:58.000000000 +0200 +++ new/x509-validation-1.6.8/x509-validation.cabal 2017-07-22 08:58:06.000000000 +0200 @@ -1,5 +1,5 @@ Name: x509-validation -Version: 1.6.5 +version: 1.6.8 Description: X.509 Certificate and CRL validation License: BSD3 License-file: LICENSE @@ -11,9 +11,10 @@ Category: Data stability: experimental Homepage: http://github.com/vincenthz/hs-certificate -Cabal-Version: >=1.6 +Cabal-Version: >= 1.10 Library + Default-Language: Haskell2010 Build-Depends: base >= 3 && < 5 , bytestring , memory @@ -25,8 +26,8 @@ , pem >= 0.1 && < 0.3 , asn1-types >= 0.3 && < 0.4 , asn1-encoding >= 0.9 && < 0.10 - , x509 >= 1.6.2 && < 1.7 - , x509-store >= 1.6 && < 1.7 + , x509 >= 1.6.5 + , x509-store >= 1.6 , cryptonite >= 0.8 Exposed-modules: Data.X509.Validation Other-modules: Data.X509.Validation.Signature @@ -35,6 +36,26 @@ Data.X509.Validation.Types ghc-options: -Wall +Test-Suite test-x509-validation + Default-Language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: Tests + Main-is: Tests.hs + Other-modules: Certificate + Build-Depends: base >= 3 && < 5 + , bytestring + , data-default-class + , tasty + , tasty-hunit + , hourglass + , asn1-types + , asn1-encoding + , x509 >= 1.7.1 + , x509-store + , x509-validation + , cryptonite + ghc-options: -Wall + source-repository head type: git location: git://github.com/vincenthz/hs-certificate