-- | 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