1-- |
2-- Module      : Data.X509.Cert
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- X.509 Certificate types and functions
9--
10{-# LANGUAGE FlexibleContexts #-}
11
12module Data.X509.Cert (Certificate(..)) where
13
14import Data.ASN1.Types
15import Control.Applicative ((<$>), (<*>))
16import Data.X509.Internal
17import Data.X509.PublicKey
18import Data.X509.AlgorithmIdentifier
19import Data.X509.DistinguishedName
20import Data.X509.ExtensionRaw
21import Data.Hourglass
22
23data CertKeyUsage =
24          CertKeyUsageDigitalSignature
25        | CertKeyUsageNonRepudiation
26        | CertKeyUsageKeyEncipherment
27        | CertKeyUsageDataEncipherment
28        | CertKeyUsageKeyAgreement
29        | CertKeyUsageKeyCertSign
30        | CertKeyUsageCRLSign
31        | CertKeyUsageEncipherOnly
32        | CertKeyUsageDecipherOnly
33        deriving (Show, Eq)
34
35-- | X.509 Certificate type.
36--
37-- This type doesn't include the signature, it's describe in the RFC
38-- as tbsCertificate.
39data Certificate = Certificate
40        { certVersion      :: Int                    -- ^ Version
41        , certSerial       :: Integer                -- ^ Serial number
42        , certSignatureAlg :: SignatureALG           -- ^ Signature algorithm
43        , certIssuerDN     :: DistinguishedName      -- ^ Issuer DN
44        , certValidity     :: (DateTime, DateTime)   -- ^ Validity period (UTC)
45        , certSubjectDN    :: DistinguishedName      -- ^ Subject DN
46        , certPubKey       :: PubKey                 -- ^ Public key
47        , certExtensions   :: Extensions             -- ^ Extensions
48        } deriving (Show,Eq)
49
50instance ASN1Object Certificate where
51    toASN1   certificate = \xs -> encodeCertificateHeader certificate ++ xs
52    fromASN1 s           = runParseASN1State parseCertificate s
53
54parseCertHeaderVersion :: ParseASN1 Int
55parseCertHeaderVersion =
56    maybe 0 id <$> onNextContainerMaybe (Container Context 0) (getNext >>= getVer)
57  where getVer (IntVal v) = return $ fromIntegral v
58        getVer _          = throwParseError "unexpected type for version"
59
60parseCertHeaderSerial :: ParseASN1 Integer
61parseCertHeaderSerial = do
62    n <- getNext
63    case n of
64        IntVal v -> return v
65        _        -> throwParseError ("missing serial" ++ show n)
66
67parseCertHeaderValidity :: ParseASN1 (DateTime, DateTime)
68parseCertHeaderValidity = getNextContainer Sequence >>= toTimeBound
69  where toTimeBound [ ASN1Time _ t1 _, ASN1Time _ t2 _ ] = return (t1,t2)
70        toTimeBound _                                    = throwParseError "bad validity format"
71
72{- | parse header structure of a x509 certificate. the structure is the following:
73        Version
74        Serial Number
75        Algorithm ID
76        Issuer
77        Validity
78                Not Before
79                Not After
80        Subject
81        Subject Public Key Info
82                Public Key Algorithm
83                Subject Public Key
84        Issuer Unique Identifier (Optional)  (>= 2)
85        Subject Unique Identifier (Optional) (>= 2)
86        Extensions (Optional)   (>= v3)
87-}
88parseCertificate :: ParseASN1 Certificate
89parseCertificate =
90    Certificate <$> parseCertHeaderVersion
91                <*> parseCertHeaderSerial
92                <*> getObject
93                <*> getObject
94                <*> parseCertHeaderValidity
95                <*> getObject
96                <*> getObject
97                <*> getObject
98
99encodeCertificateHeader :: Certificate -> [ASN1]
100encodeCertificateHeader cert =
101    eVer ++ eSerial ++ eAlgId ++ eIssuer ++ eValidity ++ eSubject ++ epkinfo ++ eexts
102  where eVer      = asn1Container (Container Context 0) [IntVal (fromIntegral $ certVersion cert)]
103        eSerial   = [IntVal $ certSerial cert]
104        eAlgId    = toASN1 (certSignatureAlg cert) []
105        eIssuer   = toASN1 (certIssuerDN cert) []
106        (t1, t2)  = certValidity cert
107        eValidity = asn1Container Sequence [ASN1Time (timeType t1) t1 (Just (TimezoneOffset 0))
108                                           ,ASN1Time (timeType t2) t2 (Just (TimezoneOffset 0))]
109        eSubject  = toASN1 (certSubjectDN cert) []
110        epkinfo   = toASN1 (certPubKey cert) []
111        eexts     = toASN1 (certExtensions cert) []
112        timeType t =
113            if t >= timeConvert (Date 2050 January 1)
114            then TimeGeneralized
115            else TimeUTC
116