1-- |
2-- Module      : Network.TLS.X509
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- X509 helpers
9--
10module Network.TLS.X509
11    ( CertificateChain(..)
12    , Certificate(..)
13    , SignedCertificate
14    , getCertificate
15    , isNullCertificateChain
16    , getCertificateChainLeaf
17    , CertificateRejectReason(..)
18    , CertificateUsage(..)
19    , CertificateStore
20    , ValidationCache
21    , exceptionValidationCache
22    , validateDefault
23    , FailedReason
24    , ServiceID
25    , wrapCertificateChecks
26    , pubkeyType
27    ) where
28
29import Data.X509
30import Data.X509.Validation
31import Data.X509.CertificateStore
32
33isNullCertificateChain :: CertificateChain -> Bool
34isNullCertificateChain (CertificateChain l) = null l
35
36getCertificateChainLeaf :: CertificateChain -> SignedExact Certificate
37getCertificateChainLeaf (CertificateChain [])    = error "empty certificate chain"
38getCertificateChainLeaf (CertificateChain (x:_)) = x
39
40-- | Certificate and Chain rejection reason
41data CertificateRejectReason =
42          CertificateRejectExpired
43        | CertificateRejectRevoked
44        | CertificateRejectUnknownCA
45        | CertificateRejectAbsent
46        | CertificateRejectOther String
47        deriving (Show,Eq)
48
49-- | Certificate Usage callback possible returns values.
50data CertificateUsage =
51          CertificateUsageAccept                         -- ^ usage of certificate accepted
52        | CertificateUsageReject CertificateRejectReason -- ^ usage of certificate rejected
53        deriving (Show,Eq)
54
55wrapCertificateChecks :: [FailedReason] -> CertificateUsage
56wrapCertificateChecks [] = CertificateUsageAccept
57wrapCertificateChecks l
58    | Expired `elem` l   = CertificateUsageReject   CertificateRejectExpired
59    | InFuture `elem` l  = CertificateUsageReject   CertificateRejectExpired
60    | UnknownCA `elem` l = CertificateUsageReject   CertificateRejectUnknownCA
61    | SelfSigned `elem` l = CertificateUsageReject  CertificateRejectUnknownCA
62    | EmptyChain `elem` l = CertificateUsageReject  CertificateRejectAbsent
63    | otherwise          = CertificateUsageReject $ CertificateRejectOther (show l)
64
65pubkeyType :: PubKey -> String
66pubkeyType = show . pubkeyToAlg
67