crypton-x509-validation 1.6.14 → 1.10.1
raw patch · 7 files changed
Files
- ChangeLog.md +39/−0
- Data/X509/Validation.hs +310/−29
- Data/X509/Validation/Internal.hs +43/−0
- Data/X509/Validation/Signature.hs +45/−4
- Tests/Certificate.hs +26/−2
- Tests/Tests.hs +549/−5
- crypton-x509-validation.cabal +66/−60
+ ChangeLog.md view
@@ -0,0 +1,39 @@+# ChangeLog for crypton-x509-validation++## 1.10.1++* Fix name constraint bypasses: constraints are accumulated per RFC+ 5280, apply to the leaf even if self-issued and to the CN used as a+ host name, dNSName matching is case-insensitive, and iPAddress,+ rfc822Name, URI and directoryName constraints are enforced.+* Undecodable NameConstraints, BasicConstraints, KeyUsage,+ ExtendedKeyUsage and SubjectAltName extensions fail validation+ instead of being ignored.+* Reject degenerate DSA parameters and oversized RSA keys before+ verifying signatures.+* Limit the chain depth to 20 CA certificates.++## 1.10.0++* Verify ML-DSA signatures+ [#35](https://github.com/kazu-yamamoto/crypton-certificate/pull/35)+* Follow the breaking change in `crypton-x509` 1.10.0+ [#35](https://github.com/kazu-yamamoto/crypton-certificate/pull/35)++## 1.9.1++* Implementing the X509 name constrains extension.+ [#30](https://github.com/kazu-yamamoto/crypton-certificate/pull/30)++## 1.9.0++* Using "ram" instead of "memory"+ [#29](https://github.com/kazu-yamamoto/crypton-certificate/pull/29)++## 1.8.0++* Depend on package `time-hourglass`, rather than `hourglass`. Date and+ time-related types and classes are now those from the former package.+ [#18](https://github.com/kazu-yamamoto/crypton-certificate/pull/18)+* Depend on package `crypton-asn1-types >= 0.4.1` rather than `asn1-types`.+ ASN.1-related types and classes are now those from the former package.
Data/X509/Validation.hs view
@@ -41,11 +41,12 @@ import Control.Monad (when) import Data.ASN1.Types import Data.Bits-import Data.ByteString (unpack)+import Data.ByteString (ByteString, unpack)+import qualified Data.ByteString as B import Data.Char (toLower) import Data.Default import Data.Hourglass-import Data.IP (IPv4, IPv6, toIPv4, toIPv6)+import Data.IP (IPv4, IPv6, fromIPv4, fromIPv6b, toIPv4, toIPv6) import Data.List import Data.Maybe import Data.Word (Word8)@@ -53,10 +54,11 @@ import Data.X509.CertificateStore import Data.X509.Validation.Cache import Data.X509.Validation.Fingerprint+import Data.X509.Validation.Internal (safeCharacterToString) import Data.X509.Validation.Signature import Data.X509.Validation.Types-import System.Hourglass import Text.Read (readMaybe)+import Time.System -- | Possible reason of certificate and chain failure. --@@ -65,7 +67,7 @@ -- instead. data FailedReason = -- | certificate contains an unknown critical extension- UnknownCriticalExtension+ UnknownCriticalExtension OID | -- | validity ends before checking time Expired | -- | validity starts after checking time@@ -272,18 +274,33 @@ -- ^ the return failed reasons (empty list is no failure) validatePure _ _ _ _ _ (CertificateChain []) = [EmptyChain] validatePure validationTime hooks checks store (fqhn, _) (CertificateChain (top : rchain)) =- hookFilterReason hooks (doLeafChecks |> doCheckChain 0 top rchain)+ hookFilterReason+ hooks+ (doLeafChecks |> doCheckChain 0 top rchain |> doCheckNameConst top rchain) where+ isExhaustive :: Bool isExhaustive = checkExhaustive checks++ (|>) :: [FailedReason] -> [FailedReason] -> [FailedReason] a |> b = exhaustive isExhaustive a b - doLeafChecks = doNameCheck top ++ doV3Check topCert ++ doKeyUsageCheck topCert+ doLeafChecks :: [FailedReason]+ doLeafChecks =+ doNameCheck top+ ++ doV3Check topCert+ ++ doKeyUsageCheck topCert where topCert = getCertificate top doCheckChain :: Int -> SignedCertificate -> [SignedCertificate] -> [FailedReason]- doCheckChain level current chain =+ doCheckChain level current chain+ | level > maxChainDepth = [AuthorityTooDeep]+ | otherwise = doCheckChain' level current chain++ doCheckChain'+ :: Int -> SignedCertificate -> [SignedCertificate] -> [FailedReason]+ doCheckChain' level current chain = doCheckCertificate (getCertificate current) -- check if we have a trusted certificate in the store belonging to this issuer. |> ( case findCertificate (certIssuerDN cert) store of@@ -300,9 +317,14 @@ |> doCheckChain (level + 1) issuer remaining ) where+ cert :: Certificate cert = getCertificate current -- in a strict ordering check the next certificate has to be the issuer. -- otherwise we dynamically reorder the chain to have the necessary certificate+ findIssuer+ :: DistinguishedName+ -> [SignedCertificate]+ -> Maybe (SignedCertificate, [SignedCertificate]) findIssuer issuerDN chain | checkStrictOrdering checks = case chain of@@ -311,8 +333,10 @@ | matchSubjectIdentifier issuerDN (getCertificate c) -> Just (c, cs) | otherwise -> Nothing | otherwise =- (\x -> (x, filter (/= x) chain))- `fmap` find (matchSubjectIdentifier issuerDN . getCertificate) chain+ case break (matchSubjectIdentifier issuerDN . getCertificate) chain of+ (before, x : after) -> Just (x, before ++ after)+ _ -> Nothing+ matchSubjectIdentifier :: DistinguishedName -> Certificate -> Bool matchSubjectIdentifier = hookMatchSubjectIssuer hooks -- we check here that the certificate is allowed to be a certificate@@ -330,11 +354,13 @@ ++ (if allowedDepth then [] else [AuthorityTooDeep]) where extensions = certExtensions cert- allowedSign = case extensionGet extensions of- Just (ExtKeyUsage flags) -> KeyUsage_keyCertSign `elem` flags+ -- an extension that cannot be decoded is not treated as absent+ allowedSign = case extensionGetE extensions of+ Just (Right (ExtKeyUsage flags)) -> KeyUsage_keyCertSign `elem` flags+ Just (Left _) -> False Nothing -> True- (allowedCA, pathLen) = case extensionGet extensions of- Just (ExtBasicConstraints True pl) -> (True, pl)+ (allowedCA, pathLen) = case extensionGetE extensions of+ Just (Right (ExtBasicConstraints True pl)) -> (True, pl) _ -> (False, Nothing) allowedDepth = case pathLen of Nothing -> True@@ -342,16 +368,19 @@ | fromIntegral pl >= level -> True | otherwise -> False + doNameCheck :: SignedCertificate -> [FailedReason] doNameCheck cert | not (checkFQHN checks) = [] | otherwise = (hookValidateName hooks) fqhn (getCertificate cert) + doV3Check :: Certificate -> [FailedReason] doV3Check cert | checkLeafV3 checks = case certVersion cert of 2 {- confusingly it means X509.V3 -} -> [] _ -> [LeafNotV3] | otherwise = [] + doKeyUsageCheck :: Certificate -> [FailedReason] doKeyUsageCheck cert = compareListIfExistAndNotNull mflags@@ -362,35 +391,107 @@ (checkLeafKeyPurpose checks) LeafKeyPurposeNotAllowed where- mflags = case extensionGet $ certExtensions cert of- Just (ExtKeyUsage keyflags) -> Just keyflags+ mflags = case extensionGetE $ certExtensions cert of+ Just (Right (ExtKeyUsage keyflags)) -> Just (Right keyflags)+ Just (Left e) -> Just (Left e) Nothing -> Nothing- mpurposes = case extensionGet $ certExtensions cert of- Just (ExtExtendedKeyUsage keyPurposes) -> Just keyPurposes+ mpurposes = case extensionGetE $ certExtensions cert of+ Just (Right (ExtExtendedKeyUsage keyPurposes)) -> Just (Right keyPurposes)+ Just (Left e) -> Just (Left e) Nothing -> Nothing -- compare a list of things to an expected list. the expected list -- need to be a subset of the list (if not Nothing), and is not will- -- return [err]+ -- return [err]. An undecodable extension always fails. compareListIfExistAndNotNull Nothing _ _ = []- compareListIfExistAndNotNull (Just list) expected err+ compareListIfExistAndNotNull (Just (Left _)) _ err = [err]+ compareListIfExistAndNotNull (Just (Right list)) expected err | null expected = [] | intersect expected list == expected = [] | otherwise = [err] + doCheckCertificate :: Certificate -> [FailedReason] doCheckCertificate cert = exhaustiveList (checkExhaustive checks) [ (checkTimeValidity checks, hookValidateTime hooks validationTime cert)+ , (True, doCriticalExtensionSweep cert) ]- isSelfSigned :: Certificate -> Bool- isSelfSigned cert = certSubjectDN cert == certIssuerDN cert- -- check signature of 'signedCert' against the 'signingCert'+ checkSignature+ :: SignedCertificate -> SignedCertificate -> [FailedReason] checkSignature signedCert signingCert = case verifySignedSignature signedCert (certPubKey $ getCertificate signingCert) of SignaturePass -> [] SignatureFailed r -> [InvalidSignature r] + -- Failures to build the chain are reported by 'doCheckChain'.+ doCheckNameConst :: SignedCertificate -> [SignedCertificate] -> [FailedReason]+ doCheckNameConst current0 chain0 = case loop (0 :: Int) current0 chain0 [] of+ Left errs -> errs+ Right ts -> checkNameConstraints ts+ where+ loop level current chain acc+ | level > maxChainDepth = Left []+ | otherwise = case findCertificate issuer store of+ Just anchor -> Right $ getNameConstSpec (getCertificate anchor) False : spec : acc+ Nothing+ | null chain -> Left []+ | otherwise -> case findIssuer issuer chain of+ Nothing -> Left []+ Just (issuer', remaining) -> loop (level + 1) issuer' remaining (spec : acc)+ where+ cert = getCertificate current+ issuer = certIssuerDN cert+ isLeaf = level == 0+ spec = getNameConstSpec cert (isLeaf && checkFQHN checks)++isSelfSigned :: Certificate -> Bool+isSelfSigned cert = certSubjectDN cert == certIssuerDN cert++-- | The maximum number of CA certificates followed from the leaf.+maxChainDepth :: Int+maxChainDepth = 20++data NameConstSpec = NameConstSpec+ { ncNames :: Either String [AltName]+ -- ^ names subject to name constraints+ , ncExt :: Either String (Maybe ExtNameConstraints)+ , ncSelfIssued :: Bool+ }++-- | The second argument tells whether the CN is used as a host name.+getNameConstSpec :: Certificate -> Bool -> NameConstSpec+getNameConstSpec cert useCN =+ NameConstSpec+ { ncNames = names+ , ncExt = maybe (Right Nothing) (fmap Just) $ extensionGetE exts+ , ncSelfIssued = isSelfSigned cert+ }+ where+ exts = certExtensions cert+ subjDN = certSubjectDN cert+ subj = [AltNameDN subjDN | not (null (getDistinguishedElements subjDN))]+ -- RFC 5280: without SAN, emailAddress in the subject is an rfc822Name+ emails =+ [ AltNameRFC822 e+ | (oid, v) <- getDistinguishedElements subjDN+ , oid == [1, 2, 840, 113549, 1, 9, 1]+ , Just e <- [safeCharacterToString v]+ ]+ cn+ | useCN = case getNames cert of+ Right (Just name, []) -> [maybe (AltNameDNS name) ipToAltName (parseIPAddress name)]+ _ -> []+ | otherwise = []+ names = case extensionGetE exts of+ Nothing -> Right (subj ++ emails ++ cn)+ Just (Right (ExtSubjectAltName alts)) -> Right (subj ++ alts ++ cn)+ Just (Left e) -> Left e++ipToAltName :: IPAddress -> AltName+ipToAltName (IPv4Address ip) = AltNameIP $ B.pack $ map fromIntegral $ fromIPv4 ip+ipToAltName (IPv6Address ip) = AltNameIP $ B.pack $ map fromIntegral $ fromIPv6b ip+ -- | Validate that the current time is between validity bounds validateTime :: DateTime -> Certificate -> [FailedReason] validateTime currentTime cert@@ -400,11 +501,14 @@ where (before, after) = certValidity cert -getNames :: Certificate -> (Maybe String, [String])-getNames cert = (commonName >>= asn1CharacterToString, altNames)+-- | 'Left' if the SAN extension is present but cannot be decoded.+getNames :: Certificate -> Either String (Maybe String, [String])+getNames cert = case extensionGetE $ certExtensions cert of+ Just (Left e) -> Left e+ Just (Right san) -> Right (commonName, toAltName san)+ Nothing -> Right (commonName, []) where- commonName = getDnElement DnCommonName $ certSubjectDN cert- altNames = maybe [] toAltName $ extensionGet $ certExtensions cert+ commonName = getDnElement DnCommonName (certSubjectDN cert) >>= safeCharacterToString toAltName (ExtSubjectAltName names) = catMaybes $ map unAltName names where unAltName (AltNameDNS s) = Just s@@ -452,11 +556,19 @@ -- subjectAltName are considered. Otherwise, the commonName from the subjectDN -- is used. --+-- If the subjectAltName extension cannot be decoded, the name never matches.+-- -- 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+validateCertificateName fqhn cert = case getNames cert of+ Left _ -> [NameMismatch fqhn]+ Right names -> validateNames fqhn cert names++validateNames+ :: HostName -> Certificate -> (Maybe String, [String]) -> [FailedReason]+validateNames fqhn cert (commonName, altNames) | not $ null altNames = case parseIPAddress fqhn of Nothing -> findMatch [] $ map matchDomain altNames@@ -469,8 +581,6 @@ Nothing -> [NoCommonName] Just cn -> findMatch [] $ [matchDomain cn] where- (commonName, altNames) = getNames cert- findMatch :: [FailedReason] -> [[FailedReason]] -> [FailedReason] findMatch _ [] = [NameMismatch fqhn] findMatch _ ([] : _) = []@@ -523,3 +633,174 @@ exhaustiveList isExhaustive ((performCheck, c) : cs) | performCheck = exhaustive isExhaustive c (exhaustiveList isExhaustive cs) | otherwise = exhaustiveList isExhaustive cs++-- | Name constraints accumulated along the chain (RFC 5280 6.1):+-- a name must be in a permitted subtree of every level that has one+-- and must not be in any excluded subtree.+data NameConstState = NameConstState [[GeneralSubtree]] [GeneralSubtree]++-- | The first element is the trust anchor and the last is the leaf.+checkNameConstraints :: [NameConstSpec] -> [FailedReason]+checkNameConstraints [] = []+checkNameConstraints (anchor : specs0) =+ either id (\st -> loop st specs0) $ addNameConst (NameConstState [] []) anchor+ where+ loop _ [] = []+ loop st (spec : specs) =+ check ++ case specs of+ [] -> []+ _ -> either id (\st' -> loop st' specs) $ addNameConst st spec+ where+ -- self-issued intermediates are exempt but the leaf is not+ check+ | ncSelfIssued spec && not (null specs) = []+ | otherwise = validateNames' st (ncNames spec)++addNameConst+ :: NameConstState -> NameConstSpec -> Either [FailedReason] NameConstState+addNameConst st@(NameConstState permitted excluded) spec = case ncExt spec of+ Left e -> Left [InvalidName $ "NameConstraints: " ++ e]+ Right Nothing -> Right st+ Right (Just (ExtNameConstraints p e)) ->+ Right $ NameConstState ([p | not (null p)] ++ permitted) (e ++ excluded)++validateNames' :: NameConstState -> Either String [AltName] -> [FailedReason]+validateNames' (NameConstState [] []) _ = []+validateNames' _ (Left e) = [InvalidName $ "SubjectAltName: " ++ e]+validateNames' (NameConstState permitted excluded) (Right altNames) =+ concatMap inc altNames ++ concatMap exc altNames+ where+ inc a+ | all (nsMatch a) permitted = []+ | otherwise = [InvalidName $ show a]+ exc a+ | nsNotMatch a excluded = []+ | otherwise = [InvalidName $ show a]++data NameMatch = NotApplicable | Matched | NotMatched | Unsupported+ deriving (Eq)++-- | A permitted subtree list is satisfied if the name is in one of them+-- or if none of them is of the same type as the name.+nsMatch :: AltName -> [GeneralSubtree] -> Bool+nsMatch a gs = any (== Matched) rs || all (== NotApplicable) rs+ where+ rs = map (matchSubtree False a) gs++nsNotMatch :: AltName -> [GeneralSubtree] -> Bool+nsNotMatch a = all ((`elem` [NotApplicable, NotMatched]) . matchSubtree True a)++-- | The first argument tells whether the subtree is an excluded one.+-- Unsupported forms count as matched when excluded and as not matched+-- when permitted.+matchSubtree :: Bool -> AltName -> GeneralSubtree -> NameMatch+matchSubtree isExcluded name (GeneralSubtree base _ _) = case (name, base) of+ (AltNameDNS n, AltNameDNS c) ->+ toMatch $ dnsInSubtree n c || (isExcluded && wildcardCovers n c)+ (AltNameDN n, AltNameDN c) -> toMatch $ dnInSubtree n c+ (AltNameIP n, AltNameIP c) -> ipInSubtree n c+ (AltNameRFC822 n, AltNameRFC822 c) -> maybe Unsupported toMatch $ emailInSubtree n c+ (AltNameURI n, AltNameURI c) -> maybe Unsupported (toMatch . (`hostInSubtree` c)) $ uriHost n+ (AltNameXMPP _, AltNameXMPP _) -> Unsupported+ (AltNameDNSSRV _, AltNameDNSSRV _) -> Unsupported+ _ -> NotApplicable+ where+ toMatch b = if b then Matched else NotMatched++-- | "example.com" covers itself and its subdomains, ".example.com" only+-- its subdomains. Compared case-insensitively.+dnsInSubtree :: String -> String -> Bool+dnsInSubtree n c+ | null c' = True+ | "." `isPrefixOf` c' = c' `isSuffixOf` n'+ | otherwise = n' == c' || ('.' : c') `isSuffixOf` n'+ where+ n' = map toLower n+ c' = map toLower c++-- | Whether a wildcard name such as "*.example.com" may stand for a name+-- in the subtree, e.g. "www.example.com".+wildcardCovers :: String -> String -> Bool+wildcardCovers n c = case stripPrefix "*." (map toLower n) of+ Just rest ->+ let c' = map toLower c+ label = take (length c' - length rest - 1) c'+ in not (null label)+ && '.' `notElem` label+ && ('.' : rest) `isSuffixOf` c'+ Nothing -> False++hostInSubtree :: String -> String -> Bool+hostInSubtree h c+ | "." `isPrefixOf` c' = c' `isSuffixOf` h'+ | otherwise = h' == c'+ where+ h' = map toLower h+ c' = map toLower c++-- | "user@host" matches exactly, "host" matches all mailboxes on the host+-- and ".example.com" all mailboxes on its subdomains.+emailInSubtree :: String -> String -> Maybe Bool+emailInSubtree n c = case breakAt n of+ Just (local, host) -> Just $ case breakAt c of+ Just (cLocal, cHost) -> local == cLocal && map toLower host == map toLower cHost+ Nothing -> hostInSubtree host c+ Nothing -> Nothing+ where+ breakAt x = case break (== '@') (reverse x) of+ (rhost, '@' : rlocal) -> Just (reverse rlocal, reverse rhost)+ _ -> Nothing++-- | The host of a URI with an authority; 'Nothing' for IP literals.+uriHost :: String -> Maybe String+uriHost uri = case break (== ':') uri of+ (_, ':' : '/' : '/' : rest) ->+ let authority = takeWhile (`notElem` ("/?#" :: String)) rest+ hostport = reverse $ takeWhile (/= '@') $ reverse authority+ host = takeWhile (/= ':') hostport+ in if null host || "[" `isPrefixOf` hostport || isJust (parseIPAddress host)+ then Nothing+ else Just host+ _ -> Nothing++-- | The subtree is a prefix of the name. Attribute values are compared+-- case-insensitively with whitespace folded.+dnInSubtree :: DistinguishedName -> DistinguishedName -> Bool+dnInSubtree (DistinguishedName n) (DistinguishedName c) =+ length c <= length n && and (zipWith eq n c)+ where+ eq (o1, v1) (o2, v2) = o1 == o2 && norm v1 == norm v2+ norm v = case safeCharacterToString v of+ Just str -> Right $ unwords $ words $ map toLower str+ Nothing -> Left v++-- | An IPv4 or IPv6 address against an address with a mask.+ipInSubtree :: ByteString -> ByteString -> NameMatch+ipInSubtree n c+ | B.length c /= 8 && B.length c /= 32 = Unsupported+ | B.length n /= 4 && B.length n /= 16 = Unsupported+ | 2 * B.length n /= B.length c = NotMatched+ | otherwise =+ if and+ ( zipWith3+ (\x a m -> x .&. m == a .&. m)+ (B.unpack n)+ (B.unpack addr)+ (B.unpack mask)+ )+ then Matched+ else NotMatched+ where+ (addr, mask) = B.splitAt (B.length n) c++doCriticalExtensionSweep :: Certificate -> [FailedReason]+doCriticalExtensionSweep cert = case mexts of+ Nothing -> []+ Just exts ->+ [ UnknownCriticalExtension oid+ | ExtensionRaw oid critical _ <- exts+ , critical+ , oid `notElem` recognizedOIDs+ ]+ where+ Extensions mexts = certExtensions cert
+ Data/X509/Validation/Internal.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Data.X509.Validation.Internal+-- License : BSD-style+-- Stability : experimental+-- Portability : unknown+--+-- Guards against exceptions thrown from pure code on malformed input.+module Data.X509.Validation.Internal (+ tryPure,+ safeCharacterToString,+) where++import Control.Exception (+ SomeAsyncException,+ SomeException,+ evaluate,+ fromException,+ throwIO,+ try,+ )+import Data.ASN1.Types (ASN1CharacterString, asn1CharacterToString)+import qualified Data.List as L+import System.IO.Unsafe (unsafeDupablePerformIO)++-- | Run a forcing function and turn synchronous exceptions into 'Left'.+tryPure :: (a -> ()) -> a -> Either String a+tryPure force x = unsafeDupablePerformIO $ do+ res <- try $ evaluate $ force x+ case res of+ Right () -> return $ Right x+ Left (e :: SomeException)+ | Just (_ :: SomeAsyncException) <- fromException e -> throwIO e+ | otherwise -> return $ Left (show e)+{-# NOINLINE tryPure #-}++-- | Like 'asn1CharacterToString' but 'Nothing' on invalid encoding.+safeCharacterToString :: ASN1CharacterString -> Maybe String+safeCharacterToString cs =+ asn1CharacterToString cs >>= either (const Nothing) Just . tryPure force+ where+ force = L.foldl' (flip seq) ()
Data/X509/Validation/Signature.hs view
@@ -15,11 +15,14 @@ import Crypto.Error (CryptoFailable (..)) import Crypto.Hash+import Crypto.Number.Basic (numBits) import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.MLDSA as MLDSA+import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as RSA import qualified Crypto.PubKey.RSA.PSS as PSS @@ -29,6 +32,7 @@ import Data.ByteString (ByteString) import Data.X509 import Data.X509.EC+import Data.X509.Validation.Internal (tryPure) -- | A set of possible return from signature verification. --@@ -80,8 +84,33 @@ -> ByteString -- ^ Signature to verify -> SignatureVerification-verifySignature (SignatureALG_Unknown _) _ _ _ = SignatureFailed SignatureUnimplemented-verifySignature (SignatureALG hashALG PubKeyALG_RSAPSS) pubkey cdata signature = case verifyF pubkey of+verifySignature alg pubkey cdata signature+ | not (acceptablePubKey pubkey) = SignatureFailed SignatureInvalid+ | otherwise =+ -- degenerate keys or encodings must not throw from pure code+ either (const $ SignatureFailed SignatureInvalid) id $+ tryPure (`seq` ()) (verifySignature' alg pubkey cdata signature)++-- | Reject key parameters that are invalid or too costly to verify with.+acceptablePubKey :: PubKey -> Bool+acceptablePubKey (PubKeyRSA (RSA.PublicKey _ n e)) =+ n > 1 && numBits n <= 16384 && e > 1 && numBits e <= 64+acceptablePubKey (PubKeyDSA (DSA.PublicKey (DSA.Params p g q) y)) =+ p > 2+ && numBits p <= 8192+ && q > 1+ && q < p+ && numBits q <= 512+ && g > 1+ && g < p+ && y > 1+ && y < p+acceptablePubKey _ = True++verifySignature'+ :: SignatureALG -> PubKey -> ByteString -> ByteString -> 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@@ -95,7 +124,7 @@ | hashALG == HashSHA224 = Just $ PSS.verify (PSS.defaultPSSParams SHA224) key | otherwise = Nothing verifyF _ = Nothing-verifySignature (SignatureALG hashALG pubkeyALG) pubkey cdata signature+verifySignature' (SignatureALG hashALG pubkeyALG) pubkey cdata signature | pubkeyToAlg pubkey == pubkeyALG = case verifyF pubkey of Nothing -> SignatureFailed SignatureUnimplemented Just f ->@@ -136,18 +165,30 @@ rsaVerify HashSHA256 = RSA.verify (Just SHA256) rsaVerify HashSHA384 = RSA.verify (Just SHA384) rsaVerify HashSHA512 = RSA.verify (Just SHA512)-verifySignature (SignatureALG_IntrinsicHash pubkeyALG) pubkey cdata signature+verifySignature' (SignatureALG_IntrinsicHash pubkeyALG) pubkey cdata signature | pubkeyToAlg pubkey == pubkeyALG = doVerify pubkey | otherwise = SignatureFailed SignaturePubkeyMismatch where doVerify (PubKeyEd25519 key) = eddsa Ed25519.verify Ed25519.signature key doVerify (PubKeyEd448 key) = eddsa Ed448.verify Ed448.signature key+ doVerify (PubKeyMLDSA44 key) = mldsa key+ doVerify (PubKeyMLDSA65 key) = mldsa key+ doVerify (PubKeyMLDSA87 key) = mldsa key doVerify _ = SignatureFailed SignatureUnimplemented eddsa verify toSig key = case toSig signature of CryptoPassed sig | verify key cdata sig -> SignaturePass+ | otherwise -> SignatureFailed SignatureInvalid+ CryptoFailed _ -> SignatureFailed SignatureInvalid++ -- RFC 9881 Section 3: the empty context string.+ mldsa :: MLDSA.MLDSA p => MLDSA.VerificationKey p -> SignatureVerification+ mldsa key =+ case MLDSA.signature signature of+ CryptoPassed sig+ | MLDSA.verify key MLDSA.emptyContext cdata sig -> SignaturePass | otherwise -> SignatureFailed SignatureInvalid CryptoFailed _ -> SignatureFailed SignatureInvalid
Tests/Certificate.hs view
@@ -29,8 +29,6 @@ mkLeaf, ) where -import Control.Applicative- import Crypto.Hash.Algorithms import Crypto.Number.Serialize @@ -40,6 +38,7 @@ import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.MLDSA as MLDSA import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as RSA import qualified Crypto.PubKey.RSA.PSS as PSS@@ -51,6 +50,7 @@ import Data.ASN1.Types import Data.ByteArray (convert) import Data.Maybe (catMaybes)+import Data.Proxy (Proxy (..)) import Data.String (fromString) import Data.X509 @@ -103,6 +103,12 @@ -> Alg ECDSA.PublicKey ECDSA.PrivateKey AlgEd25519 :: Alg Ed25519.PublicKey Ed25519.SecretKey AlgEd448 :: Alg Ed448.PublicKey Ed448.SecretKey+ AlgMLDSA44+ :: Alg (MLDSA.VerificationKey MLDSA.MLDSA44) (MLDSA.SigningKey MLDSA.MLDSA44)+ AlgMLDSA65+ :: Alg (MLDSA.VerificationKey MLDSA.MLDSA65) (MLDSA.SigningKey MLDSA.MLDSA65)+ AlgMLDSA87+ :: Alg (MLDSA.VerificationKey MLDSA.MLDSA87) (MLDSA.SigningKey MLDSA.MLDSA87) -- | Types of public and private keys used by a signature algorithm. type Keys pub priv = (Alg pub priv, pub, priv)@@ -125,7 +131,16 @@ generateKeys alg@AlgEd448 = do secret <- Ed448.generateSecretKey return (alg, Ed448.toPublic secret, secret)+generateKeys alg@AlgMLDSA44 =+ withAlg alg <$> MLDSA.generateKeyPair (Proxy :: Proxy MLDSA.MLDSA44)+generateKeys alg@AlgMLDSA65 =+ withAlg alg <$> MLDSA.generateKeyPair (Proxy :: Proxy MLDSA.MLDSA65)+generateKeys alg@AlgMLDSA87 =+ withAlg alg <$> MLDSA.generateKeyPair (Proxy :: Proxy MLDSA.MLDSA87) +withAlg :: Alg pub priv -> (pub, priv) -> Keys pub priv+withAlg alg (pub, priv) = (alg, pub, priv)+ generateRSAKeys :: Alg RSA.PublicKey RSA.PrivateKey -> Int@@ -149,6 +164,9 @@ bytes = (bits + 7) `div` 8 getPubKey AlgEd25519 key = PubKeyEd25519 key getPubKey AlgEd448 key = PubKeyEd448 key+getPubKey AlgMLDSA44 key = PubKeyMLDSA44 key+getPubKey AlgMLDSA65 key = PubKeyMLDSA65 key+getPubKey AlgMLDSA87 key = PubKeyMLDSA87 key getSignatureALG :: Alg pub priv -> SignatureALG getSignatureALG (AlgRSA _ hash) = SignatureALG (getHashALG hash) PubKeyALG_RSA@@ -157,6 +175,9 @@ getSignatureALG (AlgEC _ hash) = SignatureALG (getHashALG hash) PubKeyALG_EC getSignatureALG AlgEd25519 = SignatureALG_IntrinsicHash PubKeyALG_Ed25519 getSignatureALG AlgEd448 = SignatureALG_IntrinsicHash PubKeyALG_Ed448+getSignatureALG AlgMLDSA44 = SignatureALG_IntrinsicHash PubKeyALG_MLDSA44+getSignatureALG AlgMLDSA65 = SignatureALG_IntrinsicHash PubKeyALG_MLDSA65+getSignatureALG AlgMLDSA87 = SignatureALG_IntrinsicHash PubKeyALG_MLDSA87 doSign :: Alg pub priv -> priv -> B.ByteString -> IO B.ByteString doSign (AlgRSA _ hash) key msg = do@@ -193,6 +214,9 @@ return $ convert $ Ed25519.sign key (Ed25519.toPublic key) msg doSign AlgEd448 key msg = return $ convert $ Ed448.sign key (Ed448.toPublic key) msg+doSign AlgMLDSA44 key msg = convert <$> MLDSA.sign key MLDSA.emptyContext msg+doSign AlgMLDSA65 key msg = convert <$> MLDSA.sign key MLDSA.emptyContext msg+doSign AlgMLDSA87 key msg = convert <$> MLDSA.sign key MLDSA.emptyContext msg -- Certificate utilities --
Tests/Tests.hs view
@@ -1,15 +1,20 @@ -- | 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 as RSA import qualified Crypto.PubKey.RSA.PSS as PSS +import Data.ASN1.BinaryEncoding (DER (..))+import Data.ASN1.BitArray (toBitArray)+import Data.ASN1.Encoding (encodeASN1')+import Data.ASN1.Types+ import Data.Default import Data.Monoid import Data.String (fromString)@@ -20,7 +25,7 @@ import qualified Data.ByteString as BS import Data.Hourglass-import System.Hourglass+import Time.System import Test.Tasty import Test.Tasty.HUnit@@ -621,6 +626,487 @@ caseName = if null hostname then "empty" else hostname checks = defaultChecks{checkExhaustive = True} +-- | Validates a chain against a store and checks only success or failure.+assertPassOrFail+ :: CertificateStore+ -> ValidationChecks+ -> HostName+ -> [Pair pub priv]+ -> Bool+ -> Assertion+assertPassOrFail store checks hostname ps pass = do+ actual <- validate HashSHA256 defaultHooks checks store def ident chain+ unless (null actual == pass) $+ assertFailure $+ (if pass then "expected success but got: " else "expected failure but got: ")+ ++ show actual+ where+ ident = (hostname, fromString ":443")+ chain = CertificateChain (map pairSignedCert ps)++nameConstraints :: [AltName] -> [AltName] -> ExtensionRaw+nameConstraints p e = mkExtension True $ ExtNameConstraints (map sub p) (map sub e)+ where+ sub a = GeneralSubtree a 0 Nothing++caBC :: ExtensionRaw+caBC = mkExtension True $ ExtBasicConstraints True Nothing++sanExt :: [AltName] -> ExtensionRaw+sanExt = mkExtension False . ExtSubjectAltName++-- | Tests name constraints of an intermediate CA and an optional sub-CA+-- against a leaf certificate.+testNameConstraints+ :: IO (RData pub priv)+ -> TestName+ -> [ExtensionRaw]+ -- ^ Extensions of the CA in addition to basic constraints+ -> Maybe [ExtensionRaw]+ -- ^ Extensions of the sub-CA, if any+ -> DistinguishedName+ -- ^ Leaf subject+ -> [ExtensionRaw]+ -- ^ Leaf extensions+ -> HostName+ -> Bool+ -- ^ Expected success+ -> TestTree+testNameConstraints res caseName caExts msubExts leafDN leafExts hostname pass =+ testWithRes res caseName $ \rd -> do+ ca <-+ mkCertificate+ 2+ 30+ (mkDn "NC CA")+ (present rd)+ (caBC : caExts)+ (CA $ root rd)+ (keys1 rd)+ (issuer, chain) <- case msubExts of+ Nothing -> return (ca, [ca])+ Just subExts -> do+ sub <-+ mkCertificate+ 2+ 31+ (mkDn "NC Sub CA")+ (present rd)+ (caBC : subExts)+ (CA ca)+ (keys2 rd)+ return (sub, [sub, ca])+ leaf <- mkCertificate 2 100 leafDN (present rd) leafExts (CA issuer) (keys3 rd)+ assertPassOrFail (rootStore rd) defaultChecks hostname (leaf : chain) pass++-- | A leaf whose subject equals the issuer is not exempt from the name+-- constraints of a trust anchor.+testSelfIssuedLeaf :: IO (RData pub priv) -> TestName -> TestTree+testSelfIssuedLeaf res caseName = testWithRes res caseName $ \rd -> do+ let exts = [caBC, nameConstraints [AltNameDNS "example.com"] []]+ anchor <- mkCertificate 2 40 (mkDn "NC Root") (present rd) exts Self (keys1 rd)+ leaf <-+ mkCertificate+ 2+ 41+ (mkDn "NC Root")+ (present rd)+ [sanExt [AltNameDNS "www.google.com"]]+ (CA anchor)+ (keys2 rd)+ assertPassOrFail (mkStore [anchor]) defaultChecks "www.google.com" [leaf] False++-- | Tests a chain longer than the supported depth.+testLongChain :: IO (RData pub priv) -> TestName -> Int -> Bool -> TestTree+testLongChain res caseName len pass = testWithRes res caseName $ \rd -> do+ let mk issuer i =+ mkCertificate+ 2+ (fromIntegral i)+ (mkDn ("CA" ++ show i))+ (present rd)+ [caBC]+ (CA issuer)+ (keys1 rd)+ go issuer i acc+ | i > len = return (issuer, acc)+ | otherwise = mk issuer i >>= \c -> go c (i + 1) (c : acc)+ (lastCA, cas) <- go (root rd) (1 :: Int) []+ leaf <- mkLeaf "long-chain" (present rd) (CA lastCA) (keys2 rd)+ assertPassOrFail (rootStore rd) defaultChecks "long-chain" (leaf : cas) pass++-- | Tests a CA or leaf with an extension that cannot be decoded.+testMalformedExt+ :: IO (RData pub priv)+ -> TestName+ -> Bool+ -> ExtensionRaw+ -> ValidationChecks+ -> [FailedReason]+ -> TestTree+testMalformedExt res caseName onCA ext checks expected = testWithRes res caseName $ \rd -> do+ ca <-+ mkCertificate+ 2+ 50+ (mkDn "Malformed CA")+ (present rd)+ ([ext | onCA] ++ [caBC | not (isBC ext)])+ (CA $ root rd)+ (keys1 rd)+ leaf <-+ mkCertificate+ 2+ 100+ (mkDn "malformed")+ (present rd)+ ([ext | not onCA])+ (CA ca)+ (keys2 rd)+ assertValidationResult rd checks "malformed" [leaf, ca] expected+ where+ isBC (ExtensionRaw oid _ _) = oid == [2, 5, 29, 19]++-- | Signature verification with degenerate or oversized keys fails.+testBadKeys :: TestTree+testBadKeys =+ testGroup+ "bad-keys"+ [ testCase "DSA p=0" $+ verifySignature+ (SignatureALG HashSHA256 PubKeyALG_DSA)+ (PubKeyDSA (DSA.PublicKey (DSA.Params 0 2 7) 3))+ (BS.pack [1, 2, 3])+ (encodeASN1' DER [Start Sequence, IntVal 1, IntVal 1, End Sequence])+ @?= SignatureFailed SignatureInvalid+ , testCase "huge RSA modulus" $+ verifySignature+ (SignatureALG HashSHA256 PubKeyALG_RSA)+ (PubKeyRSA (RSA.PublicKey 2049 (2 ^ (16392 :: Int) - 1) 3))+ (BS.pack [1, 2, 3])+ (BS.replicate 2049 1)+ @?= SignatureFailed SignatureInvalid+ , testCase "huge RSA exponent" $+ verifySignature+ (SignatureALG HashSHA256 PubKeyALG_RSA)+ (PubKeyRSA (RSA.PublicKey 256 (2 ^ (2048 :: Int) - 1) (2 ^ (2047 :: Int) + 1)))+ (BS.pack [1, 2, 3])+ (BS.replicate 256 1)+ @?= SignatureFailed SignatureInvalid+ , testCase "tiny RSA-PSS modulus" $+ verifySignature+ (SignatureALG HashSHA256 PubKeyALG_RSAPSS)+ (PubKeyRSA (RSA.PublicKey 1 0x7f 3))+ (BS.pack [1, 2, 3])+ (BS.pack [1])+ @?= SignatureFailed SignatureInvalid+ ]++-- | Regression tests that do not depend on the signature algorithm.+treeRegression :: TestTree+treeRegression = withResource (initData AlgEd25519) freeData $ \res ->+ testGroup+ "regression"+ [ testGroup+ "name-constraints"+ [ testNameConstraints+ res+ "permitted"+ [ncEx]+ Nothing+ leafDN+ [sanExt [dns "www.example.com"]]+ "www.example.com"+ True+ , testNameConstraints+ res+ "not permitted"+ [ncEx]+ Nothing+ leafDN+ [sanExt [dns "www.google.com"]]+ "www.google.com"+ False+ , testNameConstraints+ res+ "sub-CA with excluded only"+ [ncEx]+ (Just [nameConstraints [] [dns "foo.invalid"]])+ leafDN+ [sanExt [dns "www.google.com"]]+ "www.google.com"+ False+ , testNameConstraints+ res+ "sub-CA without constraints"+ [ncEx]+ (Just [])+ leafDN+ [sanExt [dns "www.example.com"]]+ "www.example.com"+ True+ , testNameConstraints+ res+ "sub-CA without constraints (outside)"+ [ncEx]+ (Just [])+ leafDN+ [sanExt [dns "www.google.com"]]+ "www.google.com"+ False+ , testNameConstraints+ res+ "sub-CA permitted outside"+ [ncEx]+ (Just [nameConstraints [dns "google.com"] []])+ leafDN+ [sanExt [dns "www.google.com"]]+ "www.google.com"+ False+ , testNameConstraints+ res+ "CN fallback"+ [ncEx]+ Nothing+ (mkDn "www.google.com")+ []+ "www.google.com"+ False+ , testNameConstraints+ res+ "CN fallback (permitted)"+ [ncEx]+ Nothing+ (mkDn "www.example.com")+ []+ "www.example.com"+ True+ , testNameConstraints+ res+ "excluded upper case"+ [nameConstraints [] [dns "google.com"]]+ Nothing+ leafDN+ [sanExt [dns "WWW.GOOGLE.COM"]]+ "www.google.com"+ False+ , testNameConstraints+ res+ "excluded by wildcard"+ [nameConstraints [] [dns "www.example.com"]]+ Nothing+ leafDN+ [sanExt [dns "*.example.com"]]+ "www.example.com"+ False+ , testNameConstraints+ res+ "permitted upper case"+ [nameConstraints [dns "EXAMPLE.com"] []]+ Nothing+ leafDN+ [sanExt [dns "www.example.COM"]]+ "www.example.com"+ True+ , testNameConstraints+ res+ "leading dot"+ [nameConstraints [dns ".example.com"] []]+ Nothing+ leafDN+ [sanExt [dns "www.example.com"]]+ "www.example.com"+ True+ , testNameConstraints+ res+ "leading dot (apex)"+ [nameConstraints [dns ".example.com"] []]+ Nothing+ leafDN+ [sanExt [dns "example.com"]]+ "example.com"+ False+ , testNameConstraints+ res+ "excluded IP"+ [nameConstraints [] [ip [8, 8, 8, 8, 255, 255, 255, 255]]]+ Nothing+ leafDN+ [sanExt [dns "www.example.com", ip [8, 8, 8, 8]]]+ "www.example.com"+ False+ , testNameConstraints+ res+ "permitted IP"+ [nameConstraints [ip [10, 0, 0, 0, 255, 0, 0, 0]] []]+ Nothing+ leafDN+ [sanExt [dns "x.example", ip [10, 1, 2, 3]]]+ "10.1.2.3"+ True+ , testNameConstraints+ res+ "not permitted IP"+ [nameConstraints [ip [10, 0, 0, 0, 255, 0, 0, 0]] []]+ Nothing+ leafDN+ [sanExt [dns "x.example", ip [11, 1, 2, 3]]]+ "11.1.2.3"+ False+ , testNameConstraints+ res+ "IP not constrained by DNS"+ [ncEx]+ Nothing+ leafDN+ [sanExt [dns "www.example.com", ip [8, 8, 8, 8]]]+ "8.8.8.8"+ True+ , testNameConstraints+ res+ "excluded email"+ [nameConstraints [] [AltNameRFC822 "example.org"]]+ Nothing+ leafDN+ [sanExt [dns "www.example.com", AltNameRFC822 "a@EXAMPLE.org"]]+ "www.example.com"+ False+ , testNameConstraints+ res+ "excluded URI"+ [nameConstraints [] [AltNameURI ".example.org"]]+ Nothing+ leafDN+ [sanExt [dns "www.example.com", AltNameURI "https://www.example.org/"]]+ "www.example.com"+ False+ , testNameConstraints+ res+ "permitted DN"+ [nameConstraints [AltNameDN (mkDn "leaf")] []]+ Nothing+ leafDN+ [sanExt [dns "www.example.com"]]+ "www.example.com"+ True+ , testNameConstraints+ res+ "excluded DN"+ [nameConstraints [] [AltNameDN (mkDn "LEAF")]]+ Nothing+ leafDN+ [sanExt [dns "www.example.com"]]+ "www.example.com"+ False+ , testNameConstraints+ res+ "unparsable"+ [ncRegisteredID]+ Nothing+ leafDN+ [sanExt [dns "www.google.com"]]+ "www.google.com"+ False+ , testSelfIssuedLeaf res "self-issued leaf"+ ]+ , testGroup+ "subject-alt-name"+ [ testNameConstraints+ res+ "unknown names skipped"+ []+ Nothing+ leafDN+ [sanUnknown]+ "www.example.com"+ True+ , testNameConstraints+ res+ "undecodable SAN"+ []+ Nothing+ (mkDn "www.example.com")+ [sanBroken]+ "www.example.com"+ False+ ]+ , testGroup+ "malformed-extensions"+ [ testMalformedExt+ res+ "CA key usage"+ True+ (raw [2, 5, 29, 15] [IntVal 1])+ defaultChecks+ [NotAllowedToSign]+ , testMalformedExt+ res+ "CA basic constraints"+ True+ (raw [2, 5, 29, 19] [IntVal 1])+ defaultChecks+ [NotAnAuthority]+ , testMalformedExt+ res+ "leaf key usage bit 9"+ False+ (raw [2, 5, 29, 15] [BitString (toBitArray (BS.pack [0x80, 0x40]) 6)])+ defaultChecks+ { checkLeafKeyUsage = [KeyUsage_digitalSignature]+ , checkFQHN = False+ }+ []+ , testMalformedExt+ res+ "leaf extended key usage"+ False+ (raw [2, 5, 29, 37] [Start Sequence, IntVal 1, End Sequence])+ defaultChecks+ { checkLeafKeyPurpose = [KeyUsagePurpose_ServerAuth]+ , checkFQHN = False+ }+ [LeafKeyPurposeNotAllowed]+ ]+ , testGroup+ "chain-length"+ [ testLongChain res "short" 5 True+ , testLongChain res "too long" 25 False+ ]+ , testBadKeys+ ]+ where+ dns = AltNameDNS+ ip = AltNameIP . BS.pack+ leafDN = mkDn "leaf"+ ncEx = nameConstraints [dns "example.com"] []+ raw oid asn1 = ExtensionRaw oid True (encodeASN1' DER asn1)+ ncRegisteredID =+ raw+ [2, 5, 29, 30]+ [ Start Sequence+ , Start (Container Context 0)+ , Start Sequence+ , Other Context 2 (fromString "example.com")+ , End Sequence+ , Start Sequence+ , Other Context 8 (BS.pack [0x2a, 0x03])+ , End Sequence+ , End (Container Context 0)+ , End Sequence+ ]+ sanUnknown =+ ExtensionRaw [2, 5, 29, 17] False $+ encodeASN1'+ DER+ [ Start Sequence+ , Other Context 8 (BS.pack [0x2a, 0x03])+ , Other Context 2 (fromString "www.example.com")+ , End Sequence+ ]+ sanBroken =+ ExtensionRaw [2, 5, 29, 17] False $+ encodeASN1' DER [Start Sequence, IntVal 1, End Sequence]+ -- | All validation test cases. treeWithAlg :: TestName -> Alg pub priv -> TestTree treeWithAlg groupName alg = withResource (initData alg) freeData $ \res ->@@ -863,19 +1349,73 @@ [NameMismatch "266.0.0.1"] -- 266 read in Word8 is 10 , testSubjectAltNameIP res- (BS.pack [0x20, 0x01, 0x0d, 0xb8, 0x85, 0xa3, 0, 0, 0, 0, 0x8a, 0x2e, 0x03, 0x70, 0x73, 0x34])+ ( BS.pack+ [ 0x20+ , 0x01+ , 0x0d+ , 0xb8+ , 0x85+ , 0xa3+ , 0+ , 0+ , 0+ , 0+ , 0x8a+ , 0x2e+ , 0x03+ , 0x70+ , 0x73+ , 0x34+ ]+ ) "2001:0db8:85a3:0000:0000:8a2e:0370:7334" True [] , testSubjectAltNameIP res- (BS.pack [0x20, 0x01, 0x0d, 0xb8, 0x85, 0xa3, 0, 0, 0, 0, 0x8a, 0x2e, 0x03, 0x70, 0x73, 0x34])+ ( BS.pack+ [ 0x20+ , 0x01+ , 0x0d+ , 0xb8+ , 0x85+ , 0xa3+ , 0+ , 0+ , 0+ , 0+ , 0x8a+ , 0x2e+ , 0x03+ , 0x70+ , 0x73+ , 0x34+ ]+ ) "2001:0db8:85a3::8a2e:0370:7334" True [] , testSubjectAltNameIP res- (BS.pack [0x20, 0x01, 0x0d, 0xb8, 0x85, 0xa3, 0, 0, 0, 0, 0x8a, 0x2e, 0x03, 0x70, 0x73, 0x34])+ ( BS.pack+ [ 0x20+ , 0x01+ , 0x0d+ , 0xb8+ , 0x85+ , 0xa3+ , 0+ , 0+ , 0+ , 0+ , 0x8a+ , 0x2e+ , 0x03+ , 0x70+ , 0x73+ , 0x34+ ]+ ) "2001:0db8:85a3:0:0:8a2e:0370:7334" True []@@ -944,6 +1484,10 @@ , treeWithAlg "ECDSA" (AlgEC curveName hashSHA512) , treeWithAlg "Ed25519" AlgEd25519 , treeWithAlg "Ed448" AlgEd448+ , treeWithAlg "ML-DSA-44" AlgMLDSA44+ , treeWithAlg "ML-DSA-65" AlgMLDSA65+ , treeWithAlg "ML-DSA-87" AlgMLDSA87+ , treeRegression ] where pssParams = PSS.defaultPSSParams SHA224
crypton-x509-validation.cabal view
@@ -1,63 +1,69 @@-Name: crypton-x509-validation-version: 1.6.14-Description: X.509 Certificate and CRL validation. please see README-License: BSD3-License-file: LICENSE-Copyright: Vincent Hanquez <vincent@snarc.org>-Author: Vincent Hanquez <vincent@snarc.org>-Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>-Synopsis: X.509 Certificate and CRL validation-Build-Type: Simple-Category: Data-stability: experimental-Homepage: https://github.com/kazu-yamamoto/crypton-certificate-Cabal-Version: >= 1.10+cabal-version: >=1.10+name: crypton-x509-validation+version: 1.10.1+license: BSD3+license-file: LICENSE+copyright: Vincent Hanquez <vincent@snarc.org>+maintainer: Kazu Yamamoto <kazu@iij.ad.jp>+author: Vincent Hanquez <vincent@snarc.org>+stability: experimental+homepage: https://github.com/kazu-yamamoto/crypton-certificate+synopsis: X.509 Certificate and CRL validation+description: X.509 Certificate and CRL validation. please see README+category: Data+build-type: Simple+extra-source-files: ChangeLog.md -Library- Default-Language: Haskell2010- Build-Depends: base >= 3 && < 5- , bytestring- , memory- , mtl- , containers- , hourglass- , data-default- , pem >= 0.1- , asn1-types >= 0.3 && < 0.4- , asn1-encoding >= 0.9 && < 0.10- , crypton-x509 >= 1.7.5- , crypton-x509-store >= 1.6- , crypton >= 0.24- , iproute >= 1.2.2- Exposed-modules: Data.X509.Validation- Other-modules: Data.X509.Validation.Signature- Data.X509.Validation.Fingerprint- Data.X509.Validation.Cache- Data.X509.Validation.Types- ghc-options: -Wall+source-repository head+ type: git+ location: https://github.com/kazu-yamamoto/crypton-certificate+ subdir: x509-validation -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- , memory- , data-default- , tasty- , tasty-hunit- , hourglass- , asn1-types- , asn1-encoding- , crypton-x509 >= 1.7.1- , crypton-x509-store- , crypton-x509-validation- , crypton- ghc-options: -Wall+library+ exposed-modules: Data.X509.Validation+ other-modules:+ Data.X509.Validation.Signature+ Data.X509.Validation.Fingerprint+ Data.X509.Validation.Cache+ Data.X509.Validation.Types+ Data.X509.Validation.Internal -source-repository head- type: git- location: https://github.com/kazu-yamamoto/crypton-certificate- subdir: x509-validation+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=3 && <5,+ bytestring,+ containers,+ crypton >=2.1.8 && <2.3,+ crypton-asn1-types >=0.4.1 && <0.5,+ crypton-asn1-encoding >=0.10.0 && <0.11,+ crypton-pem >=0.2.4 && <0.4,+ crypton-x509 >=1.10.1 && <1.11,+ crypton-x509-store >=1.10 && <1.11,+ data-default,+ iproute >=1.2.2,+ mtl,+ ram,+ time-hourglass++test-suite test-x509-validation+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ hs-source-dirs: Tests+ other-modules: Certificate+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=3 && <5,+ bytestring,+ crypton,+ crypton-asn1-encoding,+ crypton-asn1-types,+ crypton-x509,+ crypton-x509-store,+ crypton-x509-validation,+ data-default,+ ram,+ tasty,+ tasty-hunit,+ time-hourglass