1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
-- |
-- 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
, pubkeyType
) 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
| CertificateRejectAbsent
| 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
| SelfSigned `elem` l = CertificateUsageReject CertificateRejectUnknownCA
| EmptyChain `elem` l = CertificateUsageReject CertificateRejectAbsent
| otherwise = CertificateUsageReject $ CertificateRejectOther (show l)
pubkeyType :: PubKey -> String
pubkeyType = show . pubkeyToAlg
|
