License | BSD-style |
---|---|
Maintainer | Vincent Hanquez <vincent@snarc.org> |
Stability | experimental |
Portability | unknown |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
X.509 Certificate checks and validations routines
Follows RFC5280 / RFC6818
Synopsis
- type ServiceID = (HostName, ByteString)
- type HostName = String
- newtype Fingerprint = Fingerprint ByteString
- data FailedReason
- = UnknownCriticalExtension
- | Expired
- | InFuture
- | SelfSigned
- | UnknownCA
- | NotAllowedToSign
- | NotAnAuthority
- | AuthorityTooDeep
- | NoCommonName
- | InvalidName String
- | NameMismatch String
- | InvalidWildcard
- | LeafKeyUsageNotAllowed
- | LeafKeyPurposeNotAllowed
- | LeafNotV3
- | EmptyChain
- | CacheSaysNo String
- | InvalidSignature SignatureFailure
- data SignatureFailure
- data ValidationChecks = ValidationChecks {}
- data ValidationHooks = ValidationHooks {
- hookMatchSubjectIssuer :: DistinguishedName -> Certificate -> Bool
- hookValidateTime :: DateTime -> Certificate -> [FailedReason]
- hookValidateName :: HostName -> Certificate -> [FailedReason]
- hookFilterReason :: [FailedReason] -> [FailedReason]
- defaultChecks :: ValidationChecks
- defaultHooks :: ValidationHooks
- validate :: HashALG -> ValidationHooks -> ValidationChecks -> CertificateStore -> ValidationCache -> ServiceID -> CertificateChain -> IO [FailedReason]
- validatePure :: DateTime -> ValidationHooks -> ValidationChecks -> CertificateStore -> ServiceID -> CertificateChain -> [FailedReason]
- validateDefault :: CertificateStore -> ValidationCache -> ServiceID -> CertificateChain -> IO [FailedReason]
- getFingerprint :: (Show a, Eq a, ASN1Object a) => SignedExact a -> HashALG -> Fingerprint
- data ValidationCacheResult
- type ValidationCacheQueryCallback = ServiceID -> Fingerprint -> Certificate -> IO ValidationCacheResult
- type ValidationCacheAddCallback = ServiceID -> Fingerprint -> Certificate -> IO ()
- data ValidationCache = ValidationCache {}
- exceptionValidationCache :: [(ServiceID, Fingerprint)] -> ValidationCache
- tofuValidationCache :: [(ServiceID, Fingerprint)] -> IO ValidationCache
- verifySignedSignature :: (Show a, Eq a, ASN1Object a) => SignedExact a -> PubKey -> SignatureVerification
- verifySignature :: SignatureALG -> PubKey -> ByteString -> ByteString -> SignatureVerification
- data SignatureVerification
- data SignatureFailure
Documentation
type ServiceID = (HostName, ByteString) Source #
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.
newtype Fingerprint Source #
Fingerprint of a certificate
Instances
Show Fingerprint Source # | |
Defined in Data.X509.Validation.Fingerprint showsPrec :: Int -> Fingerprint -> ShowS # show :: Fingerprint -> String # showList :: [Fingerprint] -> ShowS # | |
Eq Fingerprint Source # | |
Defined in Data.X509.Validation.Fingerprint (==) :: Fingerprint -> Fingerprint -> Bool # (/=) :: Fingerprint -> Fingerprint -> Bool # | |
ByteArrayAccess Fingerprint Source # | |
Defined in Data.X509.Validation.Fingerprint length :: Fingerprint -> Int # withByteArray :: Fingerprint -> (Ptr p -> IO a) -> IO a # copyByteArrayToPtr :: Fingerprint -> Ptr p -> IO () # |
Failed validation types
data FailedReason Source #
Possible reason of certificate and chain failure.
The values InvalidName
and InvalidWildcard
are internal-only and are
never returned by the validation functions. NameMismatch
is returned
instead.
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 |
Instances
Show FailedReason Source # | |
Defined in Data.X509.Validation showsPrec :: Int -> FailedReason -> ShowS # show :: FailedReason -> String # showList :: [FailedReason] -> ShowS # | |
Eq FailedReason Source # | |
Defined in Data.X509.Validation (==) :: FailedReason -> FailedReason -> Bool # (/=) :: FailedReason -> FailedReason -> Bool # |
data SignatureFailure Source #
Various failure possible during signature checking
SignatureInvalid | signature doesn't verify |
SignaturePubkeyMismatch | algorithm and public key mismatch, cannot proceed |
SignatureUnimplemented | unimplemented signature algorithm |
Instances
Show SignatureFailure Source # | |
Defined in Data.X509.Validation.Signature showsPrec :: Int -> SignatureFailure -> ShowS # show :: SignatureFailure -> String # showList :: [SignatureFailure] -> ShowS # | |
Eq SignatureFailure Source # | |
Defined in Data.X509.Validation.Signature (==) :: SignatureFailure -> SignatureFailure -> Bool # (/=) :: SignatureFailure -> SignatureFailure -> Bool # |
Validation configuration types
data ValidationChecks Source #
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.
ValidationChecks | |
|
Instances
Show ValidationChecks Source # | |
Defined in Data.X509.Validation showsPrec :: Int -> ValidationChecks -> ShowS # show :: ValidationChecks -> String # showList :: [ValidationChecks] -> ShowS # | |
Default ValidationChecks Source # | |
Defined in Data.X509.Validation def :: ValidationChecks # | |
Eq ValidationChecks Source # | |
Defined in Data.X509.Validation (==) :: ValidationChecks -> ValidationChecks -> Bool # (/=) :: ValidationChecks -> ValidationChecks -> Bool # |
data ValidationHooks Source #
A set of hooks to manipulate the way the verification works.
BEWARE, it's easy to change behavior leading to compromised security.
ValidationHooks | |
|
Instances
Default ValidationHooks Source # | |
Defined in Data.X509.Validation def :: ValidationHooks # |
defaultChecks :: ValidationChecks Source #
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
defaultHooks :: ValidationHooks Source #
Default hooks in the validation process
Validation
:: 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) |
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.
:: DateTime | The time for which to check validity for |
-> ValidationHooks | Hooks to use |
-> ValidationChecks | Checks to do |
-> CertificateStore | The trusted certificate store for CA |
-> ServiceID | Identification of the connection |
-> CertificateChain | The certificate chain we want to validate |
-> [FailedReason] | the return failed reasons (empty list is no failure) |
Validate a certificate chain with explicit pure parameters
:: 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 using the default hooks and checks and the SHA256 mechanism as hashing mechanism
:: (Show a, Eq a, ASN1Object a) | |
=> SignedExact a | object to fingerprint |
-> HashALG | algorithm to compute the fingerprint |
-> Fingerprint | fingerprint in binary form |
Get the fingerprint of the whole signed object using the hashing algorithm specified
Cache
Cache for validation
data ValidationCacheResult Source #
The result of a cache query
ValidationCachePass | cache allow this fingerprint to go through |
ValidationCacheDenied String | cache denied this fingerprint for further validation |
ValidationCacheUnknown | unknown fingerprint in cache |
Instances
Show ValidationCacheResult Source # | |
Defined in Data.X509.Validation.Cache showsPrec :: Int -> ValidationCacheResult -> ShowS # show :: ValidationCacheResult -> String # showList :: [ValidationCacheResult] -> ShowS # | |
Eq ValidationCacheResult Source # | |
Defined in Data.X509.Validation.Cache (==) :: ValidationCacheResult -> ValidationCacheResult -> Bool # (/=) :: ValidationCacheResult -> ValidationCacheResult -> Bool # |
type ValidationCacheQueryCallback Source #
= 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 query callback type
type ValidationCacheAddCallback Source #
= ServiceID | connection's identification |
-> Fingerprint | fingerprint of the leaf certificate |
-> Certificate | leaf certificate |
-> IO () |
Validation cache callback type
data ValidationCache Source #
All the callbacks needed for querying and adding to the cache.
ValidationCache | |
|
Instances
Default ValidationCache Source # | |
Defined in Data.X509.Validation.Cache def :: ValidationCache # |
Simple instances of cache mechanism
exceptionValidationCache :: [(ServiceID, Fingerprint)] -> ValidationCache Source #
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.
:: [(ServiceID, Fingerprint)] | a list of exceptions |
-> IO ValidationCache |
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
Signature verification
verifySignedSignature :: (Show a, Eq a, ASN1Object a) => SignedExact a -> PubKey -> SignatureVerification Source #
Verify a Signed object against a specified public key
:: SignatureALG | Signature algorithm used |
-> PubKey | Public key to use for verify |
-> ByteString | Certificate data that need to be verified |
-> ByteString | Signature to verify |
-> SignatureVerification |
verify signature using parameter
data SignatureVerification Source #
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.
SignaturePass | verification succeeded |
SignatureFailed SignatureFailure | verification failed |
Instances
Show SignatureVerification Source # | |
Defined in Data.X509.Validation.Signature showsPrec :: Int -> SignatureVerification -> ShowS # show :: SignatureVerification -> String # showList :: [SignatureVerification] -> ShowS # | |
Eq SignatureVerification Source # | |
Defined in Data.X509.Validation.Signature (==) :: SignatureVerification -> SignatureVerification -> Bool # (/=) :: SignatureVerification -> SignatureVerification -> Bool # |
data SignatureFailure Source #
Various failure possible during signature checking
SignatureInvalid | signature doesn't verify |
SignaturePubkeyMismatch | algorithm and public key mismatch, cannot proceed |
SignatureUnimplemented | unimplemented signature algorithm |
Instances
Show SignatureFailure Source # | |
Defined in Data.X509.Validation.Signature showsPrec :: Int -> SignatureFailure -> ShowS # show :: SignatureFailure -> String # showList :: [SignatureFailure] -> ShowS # | |
Eq SignatureFailure Source # | |
Defined in Data.X509.Validation.Signature (==) :: SignatureFailure -> SignatureFailure -> Bool # (/=) :: SignatureFailure -> SignatureFailure -> Bool # |