x509-validation-1.6.3/0000755000000000000000000000000012600061401012532 5ustar0000000000000000x509-validation-1.6.3/LICENSE0000644000000000000000000000273112600061401013542 0ustar0000000000000000Copyright (c) 2010-2013 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. x509-validation-1.6.3/Setup.hs0000644000000000000000000000005612600061401014167 0ustar0000000000000000import Distribution.Simple main = defaultMain x509-validation-1.6.3/x509-validation.cabal0000644000000000000000000000275112600061401016360 0ustar0000000000000000Name: x509-validation Version: 1.6.3 Description: X.509 Certificate and CRL validation License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Synopsis: X.509 Certificate and CRL validation Build-Type: Simple Category: Data stability: experimental Homepage: http://github.com/vincenthz/hs-certificate Cabal-Version: >=1.6 Library Build-Depends: base >= 3 && < 5 , bytestring , memory , byteable , mtl , containers , hourglass , data-default-class , pem >= 0.1 && < 0.3 , asn1-types >= 0.3 && < 0.4 , asn1-encoding >= 0.9 && < 0.10 , x509 >= 1.6 && < 1.7 , x509-store >= 1.6 && < 1.7 , cryptonite >= 0.3 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: git://github.com/vincenthz/hs-certificate subdir: x509-validation x509-validation-1.6.3/Data/0000755000000000000000000000000012600061401013403 5ustar0000000000000000x509-validation-1.6.3/Data/X509/0000755000000000000000000000000012600061401014050 5ustar0000000000000000x509-validation-1.6.3/Data/X509/Validation.hs0000644000000000000000000004577712600061401016522 0ustar0000000000000000-- | -- Module : Data.X509.Validation -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- X.509 Certificate checks and validations routines -- -- Follows RFC5280 / RFC6818 -- module Data.X509.Validation ( module Data.X509.Validation.Types , Fingerprint(..) -- * Failed validation types , FailedReason(..) , SignatureFailure(..) -- * Validation configuration types , ValidationChecks(..) , ValidationHooks(..) , defaultChecks , defaultHooks -- * Validation , validate , validateDefault , getFingerprint -- * Cache , module Data.X509.Validation.Cache ) where import Control.Applicative import Control.Monad (when) import Data.Default.Class import Data.ASN1.Types import Data.X509 import Data.X509.CertificateStore import Data.X509.Validation.Signature import Data.X509.Validation.Fingerprint import Data.X509.Validation.Cache import Data.X509.Validation.Types import Data.Hourglass import System.Hourglass import Data.Maybe import Data.List -- | Possible reason of certificate and chain failure data FailedReason = UnknownCriticalExtension -- ^ certificate contains an unknown critical extension | Expired -- ^ validity ends before checking time | InFuture -- ^ validity starts after checking time | SelfSigned -- ^ certificate is self signed | UnknownCA -- ^ unknown Certificate Authority (CA) | NotAllowedToSign -- ^ certificate is not allowed to sign | NotAnAuthority -- ^ not a CA | AuthorityTooDeep -- ^ Violation of the optional Basic constraint's path length | NoCommonName -- ^ Certificate doesn't have any common name (CN) | InvalidName String -- ^ Invalid name in certificate | NameMismatch String -- ^ connection name and certificate do not match | InvalidWildcard -- ^ invalid wildcard in certificate | LeafKeyUsageNotAllowed -- ^ the requested key usage is not compatible with the leaf certificate's key usage | LeafKeyPurposeNotAllowed -- ^ the requested key purpose is not compatible with the leaf certificate's extended key usage | LeafNotV3 -- ^ Only authorized an X509.V3 certificate as leaf certificate. | EmptyChain -- ^ empty chain of certificate | CacheSaysNo String -- ^ the cache explicitely denied this certificate | InvalidSignature SignatureFailure -- ^ signature failed deriving (Show,Eq) -- | A set of checks to activate or parametrize to perform on certificates. -- -- It's recommended to use 'defaultChecks' to create the structure, -- to better cope with future changes or expansion of the structure. data ValidationChecks = ValidationChecks { -- | check time validity of every certificate in the chain. -- the make sure that current time is between each validity bounds -- in the certificate checkTimeValidity :: Bool -- | The time when the validity check happens. When set to Nothing, -- the current time will be used , checkAtTime :: Maybe DateTime -- | Check that no certificate is included that shouldn't be included. -- unfortunately despite the specification violation, a lots of -- real world server serves useless and usually old certificates -- that are not relevant to the certificate sent, in their chain. , checkStrictOrdering :: Bool -- | Check that signing certificate got the CA basic constraint. -- this is absolutely not recommended to turn it off. , checkCAConstraints :: Bool -- | Check the whole certificate chain without stopping at the first failure. -- Allow gathering a exhaustive list of failure reasons. if this is -- turn off, it's absolutely not safe to ignore a failed reason even it doesn't look serious -- (e.g. Expired) as other more serious checks would not have been performed. , checkExhaustive :: Bool -- | Check that the leaf certificate is version 3. If disable, version 2 certificate -- is authorized in leaf position and key usage cannot be checked. , checkLeafV3 :: Bool -- | Check that the leaf certificate is authorized to be used for certain usage. -- If set to empty list no check are performed, otherwise all the flags is the list -- need to exists in the key usage extension. If the extension is not present, -- the check will pass and behave as if the certificate key is not restricted to -- any specific usage. , checkLeafKeyUsage :: [ExtKeyUsageFlag] -- | Check that the leaf certificate is authorized to be used for certain purpose. -- If set to empty list no check are performed, otherwise all the flags is the list -- need to exists in the extended key usage extension if present. If the extension is not -- present, then the check will pass and behave as if the certificate is not restricted -- to any specific purpose. , checkLeafKeyPurpose :: [ExtKeyUsagePurpose] -- | Check the top certificate names matching the fully qualified hostname (FQHN). -- it's not recommended to turn this check off, if no other name checks are performed. , checkFQHN :: Bool } deriving (Show,Eq) -- | A set of hooks to manipulate the way the verification works. -- -- 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. hookMatchSubjectIssuer :: DistinguishedName -> Certificate -> Bool -- | validate that the parametrized time valide with the certificate in argument , hookValidateTime :: DateTime -> Certificate -> [FailedReason] -- | validate the certificate leaf name with the DNS named used to connect , hookValidateName :: HostName -> Certificate -> [FailedReason] -- | user filter to modify the list of failure reasons , hookFilterReason :: [FailedReason] -> [FailedReason] } -- | Default checks to perform -- -- The default checks are: -- * Each certificate time is valid -- * CA constraints is enforced for signing certificate -- * Leaf certificate is X.509 v3 -- * Check that the FQHN match defaultChecks :: ValidationChecks defaultChecks = ValidationChecks { checkTimeValidity = True , checkAtTime = Nothing , checkStrictOrdering = False , checkCAConstraints = True , checkExhaustive = False , checkLeafV3 = True , checkLeafKeyUsage = [] , checkLeafKeyPurpose = [] , checkFQHN = True } instance Default ValidationChecks where def = defaultChecks -- | Default hooks in the validation process defaultHooks :: ValidationHooks defaultHooks = ValidationHooks { hookMatchSubjectIssuer = matchSI , hookValidateTime = validateTime , hookValidateName = validateCertificateName , hookFilterReason = id } instance Default ValidationHooks where def = defaultHooks -- | Validate using the default hooks and checks and the SHA256 mechanism as hashing mechanism validateDefault :: CertificateStore -- ^ The trusted certificate store for CA -> ValidationCache -- ^ the validation cache callbacks -> ServiceID -- ^ identification of the connection -> CertificateChain -- ^ the certificate chain we want to validate -> IO [FailedReason] -- ^ the return failed reasons (empty list is no failure) validateDefault = validate HashSHA256 defaultHooks defaultChecks -- | X509 validation -- -- the function first interrogate the cache and if the validation fail, -- proper verification is done. If the verification pass, the -- add to cache callback is called. validate :: HashALG -- ^ the hash algorithm we want to use for hashing the leaf certificate -> ValidationHooks -- ^ Hooks to use -> ValidationChecks -- ^ Checks to do -> CertificateStore -- ^ The trusted certificate store for CA -> ValidationCache -- ^ the validation cache callbacks -> ServiceID -- ^ identification of the connection -> CertificateChain -- ^ the certificate chain we want to validate -> IO [FailedReason] -- ^ the return failed reasons (empty list is no failure) validate _ _ _ _ _ _ (CertificateChain []) = return [EmptyChain] validate hashAlg hooks checks store cache ident cc@(CertificateChain (top:_)) = do cacheResult <- (cacheQuery cache) ident fingerPrint (getCertificate top) case cacheResult of ValidationCachePass -> return [] ValidationCacheDenied s -> return [CacheSaysNo s] ValidationCacheUnknown -> do validationTime <- maybe (timeConvert <$> timeCurrent) return $ checkAtTime checks failedReasons <- doValidate validationTime hooks checks store ident cc when (null failedReasons) $ (cacheAdd cache) ident fingerPrint (getCertificate top) return failedReasons where fingerPrint = getFingerprint top hashAlg -- | Validate a certificate chain with explicit parameters doValidate :: DateTime -> ValidationHooks -> ValidationChecks -> CertificateStore -> ServiceID -> CertificateChain -> IO [FailedReason] doValidate _ _ _ _ _ (CertificateChain []) = return [EmptyChain] doValidate validationTime hooks checks store (fqhn,_) (CertificateChain (top:rchain)) = (hookFilterReason hooks) <$> (return doLeafChecks |> doCheckChain 0 top rchain) where isExhaustive = checkExhaustive checks a |> b = exhaustive isExhaustive a b doLeafChecks = doNameCheck top ++ doV3Check topCert ++ doKeyUsageCheck topCert where topCert = getCertificate top doCheckChain :: Int -> SignedCertificate -> [SignedCertificate] -> IO [FailedReason] doCheckChain level current chain = do r <- doCheckCertificate (getCertificate current) -- check if we have a trusted certificate in the store belonging to this issuer. return r |> (case findCertificate (certIssuerDN cert) store of Just trustedSignedCert -> return $ checkSignature current trustedSignedCert Nothing | isSelfSigned cert -> return [SelfSigned] |> return (checkSignature current current) | null chain -> return [UnknownCA] | otherwise -> case findIssuer (certIssuerDN cert) chain of Nothing -> return [UnknownCA] Just (issuer, remaining) -> return (checkCA level $ getCertificate issuer) |> return (checkSignature current issuer) |> doCheckChain (level+1) issuer remaining) where 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 issuerDN chain | checkStrictOrdering checks = case chain of [] -> error "not possible" (c:cs) | matchSubjectIdentifier issuerDN (getCertificate c) -> Just (c, cs) | otherwise -> Nothing | otherwise = (\x -> (x, filter (/= x) chain)) `fmap` find (matchSubjectIdentifier issuerDN . getCertificate) chain matchSubjectIdentifier = hookMatchSubjectIssuer hooks -- we check here that the certificate is allowed to be a certificate -- authority, by checking the BasicConstraint extension. We also check, -- if present the key usage extension for ability to cert sign. If this -- extension is not present, then according to RFC 5280, it's safe to -- assume that only cert sign (and crl sign) are allowed by this certificate. checkCA :: Int -> Certificate -> [FailedReason] checkCA level cert | not (checkCAConstraints checks) = [] | and [allowedSign,allowedCA,allowedDepth] = [] | otherwise = (if allowedSign then [] else [NotAllowedToSign]) ++ (if allowedCA then [] else [NotAnAuthority]) ++ (if allowedDepth then [] else [AuthorityTooDeep]) where extensions = certExtensions cert allowedSign = case extensionGet extensions of Just (ExtKeyUsage flags) -> KeyUsage_keyCertSign `elem` flags Nothing -> True (allowedCA,pathLen) = case extensionGet extensions of Just (ExtBasicConstraints True pl) -> (True, pl) _ -> (False, Nothing) allowedDepth = case pathLen of Nothing -> True Just pl | fromIntegral pl >= level -> True | otherwise -> False doNameCheck cert | not (checkFQHN checks) = [] | otherwise = (hookValidateName hooks) fqhn (getCertificate cert) doV3Check cert | checkLeafV3 checks = case certVersion cert of 2 {- confusingly it means X509.V3 -} -> [] _ -> [LeafNotV3] | otherwise = [] doKeyUsageCheck cert = compareListIfExistAndNotNull mflags (checkLeafKeyUsage checks) LeafKeyUsageNotAllowed ++ compareListIfExistAndNotNull mpurposes (checkLeafKeyPurpose checks) LeafKeyPurposeNotAllowed where mflags = case extensionGet $ certExtensions cert of Just (ExtKeyUsage keyflags) -> Just keyflags Nothing -> Nothing mpurposes = case extensionGet $ certExtensions cert of Just (ExtExtendedKeyUsage keyPurposes) -> Just keyPurposes 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] compareListIfExistAndNotNull Nothing _ _ = [] compareListIfExistAndNotNull (Just list) expected err | null expected = [] | intersect expected list == expected = [] | otherwise = [err] doCheckCertificate cert = exhaustiveList (checkExhaustive checks) [ (checkTimeValidity checks, return ((hookValidateTime hooks) validationTime cert)) ] isSelfSigned :: Certificate -> Bool isSelfSigned cert = certSubjectDN cert == certIssuerDN cert -- check signature of 'signedCert' against the 'signingCert' checkSignature signedCert signingCert = case verifySignedSignature signedCert (certPubKey $ getCertificate signingCert) of SignaturePass -> [] SignatureFailed r -> [InvalidSignature r] -- | Validate that the current time is between validity bounds validateTime :: DateTime -> Certificate -> [FailedReason] validateTime currentTime cert | currentTime < before = [InFuture] | currentTime > after = [Expired] | otherwise = [] where (before, after) = certValidity cert getNames :: Certificate -> (Maybe String, [String]) getNames cert = (commonName >>= asn1CharacterToString, altNames) where commonName = getDnElement DnCommonName $ certSubjectDN cert altNames = maybe [] toAltName $ extensionGet $ certExtensions cert toAltName (ExtSubjectAltName names) = catMaybes $ map unAltName names where unAltName (AltNameDNS s) = Just s 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. validateCertificateName :: HostName -> Certificate -> [FailedReason] validateCertificateName fqhn cert | not $ null altNames = findMatch [] $ map (matchDomain . splitDot) altNames | otherwise = case commonName of Nothing -> [NoCommonName] Just cn -> findMatch [] $ [matchDomain $ splitDot $ cn] where (commonName, altNames) = getNames cert findMatch :: [FailedReason] -> [[FailedReason]] -> [FailedReason] findMatch _ [] = [NameMismatch fqhn] findMatch _ ([]:_) = [] findMatch acc (_ :xs) = findMatch acc xs matchDomain :: [String] -> [FailedReason] matchDomain l | length (filter (== "") l) > 0 = [InvalidName (intercalate "." l)] | head l == "*" = wildcardMatch (reverse $ drop 1 l) | l == splitDot fqhn = [] -- success: we got a match | otherwise = [NameMismatch fqhn] -- only 1 wildcard is valid, and if multiples are present -- they won't have a wildcard meaning but will be match as normal star -- character to the fqhn and inevitably will fail. -- -- e.g. *.*.server.com will try to litteraly match the '*' subdomain of server.com -- -- Also '*' is not accepted as a valid wildcard wildcardMatch l | null l = [InvalidWildcard] -- '*' is always invalid | l == take (length l) (reverse $ splitDot fqhn) = [] -- success: we got a match | otherwise = [NameMismatch fqhn] splitDot :: String -> [String] splitDot [] = [""] splitDot x = let (y, z) = break (== '.') x in y : (if z == "" then [] else splitDot $ drop 1 z) -- | return true if the 'subject' certificate's issuer match -- the 'issuer' certificate's subject matchSI :: DistinguishedName -> Certificate -> Bool matchSI issuerDN issuer = certSubjectDN issuer == issuerDN exhaustive :: Monad m => Bool -> m [FailedReason] -> m [FailedReason] -> m [FailedReason] exhaustive isExhaustive f1 f2 = f1 >>= cont where cont l1 | null l1 = f2 | isExhaustive = f2 >>= \l2 -> return (l1 ++ l2) | otherwise = return l1 exhaustiveList :: Monad m => Bool -> [(Bool, m [FailedReason])] -> m [FailedReason] exhaustiveList _ [] = return [] exhaustiveList isExhaustive ((performCheck,c):cs) | performCheck = exhaustive isExhaustive c (exhaustiveList isExhaustive cs) | otherwise = exhaustiveList isExhaustive cs x509-validation-1.6.3/Data/X509/Validation/0000755000000000000000000000000012600061401016142 5ustar0000000000000000x509-validation-1.6.3/Data/X509/Validation/Cache.hs0000644000000000000000000001026612600061401017506 0ustar0000000000000000-- | -- Module : Data.X509.Validation.Cache -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- X.509 Validation cache -- -- Define all the types necessary for the validation cache, -- and some simples instances of cache mechanism module Data.X509.Validation.Cache ( -- * Cache for validation ValidationCacheResult(..) , ValidationCacheQueryCallback , ValidationCacheAddCallback , ValidationCache(..) -- * Simple instances of cache mechanism , exceptionValidationCache , tofuValidationCache ) where import Control.Concurrent import Data.Default.Class import Data.X509 import Data.X509.Validation.Types import Data.X509.Validation.Fingerprint -- | The result of a cache query data ValidationCacheResult = ValidationCachePass -- ^ cache allow this fingerprint to go through | ValidationCacheDenied String -- ^ cache denied this fingerprint for further validation | ValidationCacheUnknown -- ^ unknown fingerprint in cache deriving (Show,Eq) -- | Validation cache query callback type type ValidationCacheQueryCallback = ServiceID -- ^ connection's identification -> Fingerprint -- ^ fingerprint of the leaf certificate -> Certificate -- ^ leaf certificate -> IO ValidationCacheResult -- ^ return if the operation is succesful or not -- | Validation cache callback type type ValidationCacheAddCallback = ServiceID -- ^ connection's identification -> Fingerprint -- ^ fingerprint of the leaf certificate -> Certificate -- ^ leaf certificate -> IO () -- | All the callbacks needed for querying and adding to the cache. data ValidationCache = ValidationCache { cacheQuery :: ValidationCacheQueryCallback -- ^ cache querying callback , cacheAdd :: ValidationCacheAddCallback -- ^ cache adding callback } instance Default ValidationCache where def = exceptionValidationCache [] -- | create a simple constant cache that list exceptions to the certification -- validation. Typically this is use to allow self-signed certificates for -- specific use, with out-of-bounds user checks. -- -- No fingerprints will be added after the instance is created. -- -- The underlying structure for the check is kept as a list, as -- usually the exception list will be short, but when the list go above -- a dozen exceptions it's recommended to use another cache mechanism with -- a faster lookup mechanism (hashtable, map, etc). -- -- Note that only one fingerprint is allowed per ServiceID, for other use, -- another cache mechanism need to be use. exceptionValidationCache :: [(ServiceID, Fingerprint)] -> ValidationCache exceptionValidationCache fingerprints = ValidationCache (queryListCallback fingerprints) (\_ _ _ -> return ()) -- | Trust on first use (TOFU) cache with an optional list of exceptions -- -- this is similar to the exceptionCache, except that after -- each succesfull validation it does add the fingerprint -- to the database. This prevent any further modification of the -- fingerprint for the remaining tofuValidationCache :: [(ServiceID, Fingerprint)] -- ^ a list of exceptions -> IO ValidationCache tofuValidationCache fingerprints = do l <- newMVar fingerprints return $ ValidationCache (\s f c -> readMVar l >>= \list -> (queryListCallback list) s f c) (\s f _ -> modifyMVar_ l (\list -> return ((s,f) : list))) -- | a cache query function working on list. -- don't use when the list grows a lot. queryListCallback :: [(ServiceID, Fingerprint)] -> ValidationCacheQueryCallback queryListCallback list = query where query serviceID fingerprint _ = return $ case lookup serviceID list of Nothing -> ValidationCacheUnknown Just f | fingerprint == f -> ValidationCachePass | otherwise -> ValidationCacheDenied (show serviceID ++ " expected " ++ show f ++ " but got: " ++ show fingerprint) x509-validation-1.6.3/Data/X509/Validation/Fingerprint.hs0000644000000000000000000000254212600061401020770 0ustar0000000000000000-- | -- Module : Data.X509.Validation.Fingerprint -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Data.X509.Validation.Fingerprint ( Fingerprint(..) , getFingerprint ) where import Crypto.Hash import Data.X509 import Data.ASN1.Types import Data.ByteArray (convert) import Data.ByteString (ByteString) import Data.Byteable -- | Fingerprint of a certificate newtype Fingerprint = Fingerprint ByteString deriving (Show,Eq) instance Byteable Fingerprint where toBytes (Fingerprint bs) = bs -- | Get the fingerprint of the whole signed object -- using the hashing algorithm specified getFingerprint :: (Show a, Eq a, ASN1Object a) => SignedExact a -- ^ object to fingerprint -> HashALG -- ^ algorithm to compute the fingerprint -> Fingerprint -- ^ fingerprint in binary form getFingerprint sobj halg = Fingerprint $ mkHash halg $ encodeSignedObject sobj where mkHash HashMD2 = convert . hashWith MD2 mkHash HashMD5 = convert . hashWith MD5 mkHash HashSHA1 = convert . hashWith SHA1 mkHash HashSHA224 = convert . hashWith SHA224 mkHash HashSHA256 = convert . hashWith SHA256 mkHash HashSHA384 = convert . hashWith SHA384 mkHash HashSHA512 = convert . hashWith SHA512 x509-validation-1.6.3/Data/X509/Validation/Signature.hs0000644000000000000000000001556212600061401020450 0ustar0000000000000000-- | -- Module : Data.X509.Validation.Signature -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- X.509 Certificate and CRL signature verification -- module Data.X509.Validation.Signature ( verifySignedSignature , verifySignature , SignatureVerification(..) , SignatureFailure(..) ) where import qualified Crypto.PubKey.RSA.PKCS15 as RSA 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) import qualified Data.ByteString as B import Data.X509 import Data.List (find) import Data.ASN1.Types import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding -- | A set of possible return from signature verification. -- -- When SignatureFailed is return, the signature shouldn't be -- accepted. -- -- Other values are only useful to differentiate the failure -- reason, but are all equivalent to failure. -- data SignatureVerification = SignaturePass -- ^ verification succeeded | SignatureFailed SignatureFailure -- ^ verification failed deriving (Show,Eq) -- | Various failure possible during signature checking data SignatureFailure = SignatureInvalid -- ^ signature doesn't verify | SignaturePubkeyMismatch -- ^ algorithm and public key mismatch, cannot proceed | SignatureUnimplemented -- ^ unimplemented signature algorithm deriving (Show,Eq) -- | Verify a Signed object against a specified public key verifySignedSignature :: (Show a, Eq a, ASN1Object a) => SignedExact a -> PubKey -> SignatureVerification verifySignedSignature signedObj pubKey = verifySignature (signedAlg signed) pubKey (getSignedData signedObj) (signedSignature signed) where signed = getSigned signedObj -- | verify signature using parameter verifySignature :: SignatureALG -- ^ Signature algorithm used -> PubKey -- ^ Public key to use for verify -> ByteString -- ^ Certificate data that need to be verified -> ByteString -- ^ Signature to verify -> SignatureVerification verifySignature (SignatureALG_Unknown _) _ _ _ = SignatureFailed SignatureUnimplemented verifySignature (SignatureALG hashALG pubkeyALG) pubkey cdata signature | pubkeyToAlg pubkey == pubkeyALG = case verifyF pubkey of Nothing -> SignatureFailed SignatureUnimplemented Just f -> if f cdata signature then SignaturePass else SignatureFailed SignatureInvalid | otherwise = SignatureFailed SignaturePubkeyMismatch 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 | otherwise = Nothing verifyF (PubKeyEC key) = verifyECDSA hashALG key verifyF _ = Nothing dsaToSignature :: ByteString -> Maybe DSA.Signature dsaToSignature b = case decodeASN1' BER b of Left _ -> Nothing Right asn1 -> case asn1 of Start Sequence:IntVal r:IntVal s:End Sequence:_ -> Just $ DSA.Signature { DSA.sign_r = r, DSA.sign_s = s } _ -> Nothing rsaVerify HashMD2 = RSA.verify (Just MD2) rsaVerify HashMD5 = RSA.verify (Just MD5) rsaVerify HashSHA1 = RSA.verify (Just SHA1) rsaVerify HashSHA224 = RSA.verify (Just SHA224) rsaVerify HashSHA256 = RSA.verify (Just SHA256) rsaVerify HashSHA384 = RSA.verify (Just SHA384) rsaVerify HashSHA512 = RSA.verify (Just SHA512) verifyECDSA :: HashALG -> PubKeyEC -> Maybe (ByteString -> ByteString -> Bool) verifyECDSA hashALG key = case key of PubKeyEC_Named curveName pub -> verifyCurve curveName pub PubKeyEC_Prime {} -> case find matchPrimeCurve $ enumFrom $ toEnum 0 of Nothing -> Nothing Just curveName -> verifyCurve curveName (pubkeyEC_pub key) where matchPrimeCurve c = case ECC.getCurveByName c of ECC.CurveFP (ECC.CurvePrime p cc) -> ECC.ecc_a cc == pubkeyEC_a key && ECC.ecc_b cc == pubkeyEC_b key && ECC.ecc_n cc == pubkeyEC_order key && p == pubkeyEC_prime key _ -> False verifyCurve curveName pub = Just $ \msg sigBS -> case decodeASN1' BER sigBS of Left _ -> False Right [Start Sequence,IntVal r,IntVal s,End Sequence] -> case unserializePoint (ECC.getCurveByName curveName) pub of Nothing -> False Just pubkey -> (ecdsaVerify hashALG) pubkey (ECDSA.Signature r s) msg Right _ -> False unserializePoint curve (SerializedPoint bs) = case B.uncons bs of Nothing -> Nothing Just (ptFormat, input) -> case ptFormat of 4 -> if B.length bs == 2 * bytes then Nothing else let (x, y) = B.splitAt bytes input p = ECC.Point (os2ip x) (os2ip y) in if ECC.isPointValid curve p then Just $ ECDSA.PublicKey curve p else Nothing -- 2 and 3 for compressed format. _ -> Nothing where bits = numBits . ECC.ecc_n . ECC.common_curve $ curve bytes = (bits + 7) `div` 8 ecdsaVerify HashMD2 = ECDSA.verify MD2 ecdsaVerify HashMD5 = ECDSA.verify MD5 ecdsaVerify HashSHA1 = ECDSA.verify SHA1 ecdsaVerify HashSHA224 = ECDSA.verify SHA224 ecdsaVerify HashSHA256 = ECDSA.verify SHA256 ecdsaVerify HashSHA384 = ECDSA.verify SHA384 ecdsaVerify HashSHA512 = ECDSA.verify SHA512 x509-validation-1.6.3/Data/X509/Validation/Types.hs0000644000000000000000000000155612600061401017611 0ustar0000000000000000-- | -- Module : Data.X509.Validation.Types -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- X.509 Validation types module Data.X509.Validation.Types ( ServiceID , HostName ) where import Data.ByteString (ByteString) type HostName = String -- | identification of the connection consisting of the -- fully qualified host name (e.g. www.example.com) and -- an optional suffix. -- -- The suffix is not used by the validation process, but -- is used by the optional cache to identity certificate per service -- on a specific host. For example, one might have a different -- certificate on 2 differents ports (443 and 995) for the same host. -- -- for TCP connection, it's recommended to use: :port, or :service for the suffix. -- type ServiceID = (HostName, ByteString)