    -- |
    -- Module      : Network.TLS.X509
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- X509 helpers
    --
    module Network.TLS.X509
        ( CertificateChain(..)
        , Certificate(..)
        , SignedCertificate
        , getCertificate
        , isNullCertificateChain
        , getCertificateChainLeaf
        , CertificateRejectReason(..)
        , CertificateUsage(..)
        , CertificateStore
        , ValidationCache
        , exceptionValidationCache
        , validateDefault
        , FailedReason
        , ServiceID
        , wrapCertificateChecks
        ) where

    import Data.X509
    import Data.X509.Validation
    import Data.X509.CertificateStore

    isNullCertificateChain :: CertificateChain -> Bool
    isNullCertificateChain (CertificateChain l) = null l

    getCertificateChainLeaf :: CertificateChain -> SignedExact Certificate
    getCertificateChainLeaf (CertificateChain [])    = error "empty certificate chain"
    getCertificateChainLeaf (CertificateChain (x:_)) = x

    -- | Certificate and Chain rejection reason
    data CertificateRejectReason =
              CertificateRejectExpired
            | CertificateRejectRevoked
            | CertificateRejectUnknownCA
            | CertificateRejectOther String
            deriving (Show,Eq)

    -- | Certificate Usage callback possible returns values.
    data CertificateUsage =
              CertificateUsageAccept                         -- ^ usage of certificate accepted
            | CertificateUsageReject CertificateRejectReason -- ^ usage of certificate rejected
            deriving (Show,Eq)

    wrapCertificateChecks :: [FailedReason] -> CertificateUsage
    wrapCertificateChecks [] = CertificateUsageAccept
    wrapCertificateChecks l
        | Expired `elem` l   = CertificateUsageReject $ CertificateRejectExpired
        | InFuture `elem` l  = CertificateUsageReject $ CertificateRejectExpired
        | UnknownCA `elem` l = CertificateUsageReject $ CertificateRejectUnknownCA
        | otherwise          = CertificateUsageReject $ CertificateRejectOther (show l)