    -- |
    -- Module      : Data.X509.Cert
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- X.509 Certificate types and functions
    --
    {-# LANGUAGE FlexibleContexts #-}

    module Data.X509.Cert (Certificate(..)) where

    import Data.ASN1.Types
    import Control.Applicative ((<$>), (<*>))
    import Data.X509.Internal
    import Data.X509.PublicKey
    import Data.X509.AlgorithmIdentifier
    import Data.X509.DistinguishedName
    import Data.X509.ExtensionRaw
    import Data.Hourglass

    data CertKeyUsage =
              CertKeyUsageDigitalSignature
            | CertKeyUsageNonRepudiation
            | CertKeyUsageKeyEncipherment
            | CertKeyUsageDataEncipherment
            | CertKeyUsageKeyAgreement
            | CertKeyUsageKeyCertSign
            | CertKeyUsageCRLSign
            | CertKeyUsageEncipherOnly
            | CertKeyUsageDecipherOnly
            deriving (Int -> CertKeyUsage -> ShowS
    [CertKeyUsage] -> ShowS
    CertKeyUsage -> String
    (Int -> CertKeyUsage -> ShowS)
    -> (CertKeyUsage -> String)
    -> ([CertKeyUsage] -> ShowS)
    -> Show CertKeyUsage
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CertKeyUsage -> ShowS
    showsPrec :: Int -> CertKeyUsage -> ShowS
    $cshow :: CertKeyUsage -> String
    show :: CertKeyUsage -> String
    $cshowList :: [CertKeyUsage] -> ShowS
    showList :: [CertKeyUsage] -> ShowS
    Show, CertKeyUsage -> CertKeyUsage -> Bool
    (CertKeyUsage -> CertKeyUsage -> Bool)
    -> (CertKeyUsage -> CertKeyUsage -> Bool) -> Eq CertKeyUsage
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CertKeyUsage -> CertKeyUsage -> Bool
    == :: CertKeyUsage -> CertKeyUsage -> Bool
    $c/= :: CertKeyUsage -> CertKeyUsage -> Bool
    /= :: CertKeyUsage -> CertKeyUsage -> Bool
    Eq)

    -- | X.509 Certificate type.
    --
    -- This type doesn't include the signature, it's describe in the RFC
    -- as tbsCertificate.
    data Certificate = Certificate
            { Certificate -> Int
    certVersion      :: Int                    -- ^ Version
            , Certificate -> Integer
    certSerial       :: Integer                -- ^ Serial number
            , Certificate -> SignatureALG
    certSignatureAlg :: SignatureALG           -- ^ Signature algorithm
            , Certificate -> DistinguishedName
    certIssuerDN     :: DistinguishedName      -- ^ Issuer DN
            , Certificate -> (DateTime, DateTime)
    certValidity     :: (DateTime, DateTime)   -- ^ Validity period (UTC)
            , Certificate -> DistinguishedName
    certSubjectDN    :: DistinguishedName      -- ^ Subject DN
            , Certificate -> PubKey
    certPubKey       :: PubKey                 -- ^ Public key
            , Certificate -> Extensions
    certExtensions   :: Extensions             -- ^ Extensions
            } deriving (Int -> Certificate -> ShowS
    [Certificate] -> ShowS
    Certificate -> String
    (Int -> Certificate -> ShowS)
    -> (Certificate -> String)
    -> ([Certificate] -> ShowS)
    -> Show Certificate
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Certificate -> ShowS
    showsPrec :: Int -> Certificate -> ShowS
    $cshow :: Certificate -> String
    show :: Certificate -> String
    $cshowList :: [Certificate] -> ShowS
    showList :: [Certificate] -> ShowS
    Show,Certificate -> Certificate -> Bool
    (Certificate -> Certificate -> Bool)
    -> (Certificate -> Certificate -> Bool) -> Eq Certificate
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Certificate -> Certificate -> Bool
    == :: Certificate -> Certificate -> Bool
    $c/= :: Certificate -> Certificate -> Bool
    /= :: Certificate -> Certificate -> Bool
    Eq)

    instance ASN1Object Certificate where
        toASN1 :: Certificate -> ASN1S
    toASN1   Certificate
    certificate = \[ASN1]
    xs -> Certificate -> [ASN1]
    encodeCertificateHeader Certificate
    certificate [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++ [ASN1]
    xs
        fromASN1 :: [ASN1] -> Either String (Certificate, [ASN1])
    fromASN1 [ASN1]
    s           = ParseASN1 Certificate
    -> [ASN1] -> Either String (Certificate, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runParseASN1State ParseASN1 Certificate
    parseCertificate [ASN1]
    s

    parseCertHeaderVersion :: ParseASN1 Int
    parseCertHeaderVersion :: ParseASN1 Int
    parseCertHeaderVersion =
        Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 Int -> Int
    forall a. a -> a
    id (Maybe Int -> Int) -> ParseASN1 (Maybe Int) -> ParseASN1 Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ASN1ConstructionType -> ParseASN1 Int -> ParseASN1 (Maybe Int)
    forall a.
    ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
    onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
    Container ASN1Class
    Context Int
    0) (ParseASN1 ASN1
    getNext ParseASN1 ASN1 -> (ASN1 -> ParseASN1 Int) -> ParseASN1 Int
    forall a b. ParseASN1 a -> (a -> ParseASN1 b) -> ParseASN1 b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ASN1 -> ParseASN1 Int
    forall {a}. Num a => ASN1 -> ParseASN1 a
    getVer)
      where getVer :: ASN1 -> ParseASN1 a
    getVer (IntVal Integer
    v) = a -> ParseASN1 a
    forall a. a -> ParseASN1 a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> ParseASN1 a) -> a -> ParseASN1 a
    forall a b. (a -> b) -> a -> b
    $ Integer -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    v
            getVer ASN1
    _          = String -> ParseASN1 a
    forall a. String -> ParseASN1 a
    throwParseError String
    "unexpected type for version"

    parseCertHeaderSerial :: ParseASN1 Integer
    parseCertHeaderSerial :: ParseASN1 Integer
    parseCertHeaderSerial = do
        n <- ParseASN1 ASN1
    getNext
        case n of
            IntVal Integer
    v -> Integer -> ParseASN1 Integer
    forall a. a -> ParseASN1 a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    v
            ASN1
    _        -> String -> ParseASN1 Integer
    forall a. String -> ParseASN1 a
    throwParseError (String
    "missing serial" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ASN1 -> String
    forall a. Show a => a -> String
    show ASN1
    n)

    parseCertHeaderValidity :: ParseASN1 (DateTime, DateTime)
    parseCertHeaderValidity :: ParseASN1 (DateTime, DateTime)
    parseCertHeaderValidity = ASN1ConstructionType -> ParseASN1 [ASN1]
    getNextContainer ASN1ConstructionType
    Sequence ParseASN1 [ASN1]
    -> ([ASN1] -> ParseASN1 (DateTime, DateTime))
    -> ParseASN1 (DateTime, DateTime)
    forall a b. ParseASN1 a -> (a -> ParseASN1 b) -> ParseASN1 b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [ASN1] -> ParseASN1 (DateTime, DateTime)
    toTimeBound
      where toTimeBound :: [ASN1] -> ParseASN1 (DateTime, DateTime)
    toTimeBound [ ASN1Time ASN1TimeType
    _ DateTime
    t1 Maybe TimezoneOffset
    _, ASN1Time ASN1TimeType
    _ DateTime
    t2 Maybe TimezoneOffset
    _ ] = (DateTime, DateTime) -> ParseASN1 (DateTime, DateTime)
    forall a. a -> ParseASN1 a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DateTime
    t1,DateTime
    t2)
            toTimeBound [ASN1]
    _                                    = String -> ParseASN1 (DateTime, DateTime)
    forall a. String -> ParseASN1 a
    throwParseError String
    "bad validity format"

    {- | parse header structure of a x509 certificate. the structure is the following:
            Version
            Serial Number
            Algorithm ID
            Issuer
            Validity
                    Not Before
                    Not After
            Subject
            Subject Public Key Info
                    Public Key Algorithm
                    Subject Public Key
            Issuer Unique Identifier (Optional)  (>= 2)
            Subject Unique Identifier (Optional) (>= 2)
            Extensions (Optional)   (>= v3)
    -}

    parseExtensions :: ParseASN1 Extensions
    parseExtensions :: ParseASN1 Extensions
    parseExtensions = (Maybe Extensions -> Extensions)
    -> ParseASN1 (Maybe Extensions) -> ParseASN1 Extensions
    forall a b. (a -> b) -> ParseASN1 a -> ParseASN1 b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe Extensions -> Extensions
    adapt (ParseASN1 (Maybe Extensions) -> ParseASN1 Extensions)
    -> ParseASN1 (Maybe Extensions) -> ParseASN1 Extensions
    forall a b. (a -> b) -> a -> b
    $ ASN1ConstructionType
    -> ParseASN1 Extensions -> ParseASN1 (Maybe Extensions)
    forall a.
    ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
    onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
    Container ASN1Class
    Context Int
    3) (ParseASN1 Extensions -> ParseASN1 (Maybe Extensions))
    -> ParseASN1 Extensions -> ParseASN1 (Maybe Extensions)
    forall a b. (a -> b) -> a -> b
    $ ParseASN1 Extensions
    forall a. ASN1Object a => ParseASN1 a
    getObject
      where adapt :: Maybe Extensions -> Extensions
    adapt (Just Extensions
    e) = Extensions
    e
            adapt Maybe Extensions
    Nothing = Maybe [ExtensionRaw] -> Extensions
    Extensions Maybe [ExtensionRaw]
    forall a. Maybe a
    Nothing

    parseCertificate :: ParseASN1 Certificate
    parseCertificate :: ParseASN1 Certificate
    parseCertificate =
        Int
    -> Integer
    -> SignatureALG
    -> DistinguishedName
    -> (DateTime, DateTime)
    -> DistinguishedName
    -> PubKey
    -> Extensions
    -> Certificate
    Certificate (Int
     -> Integer
     -> SignatureALG
     -> DistinguishedName
     -> (DateTime, DateTime)
     -> DistinguishedName
     -> PubKey
     -> Extensions
     -> Certificate)
    -> ParseASN1 Int
    -> ParseASN1
         (Integer
          -> SignatureALG
          -> DistinguishedName
          -> (DateTime, DateTime)
          -> DistinguishedName
          -> PubKey
          -> Extensions
          -> Certificate)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParseASN1 Int
    parseCertHeaderVersion
                    ParseASN1
      (Integer
       -> SignatureALG
       -> DistinguishedName
       -> (DateTime, DateTime)
       -> DistinguishedName
       -> PubKey
       -> Extensions
       -> Certificate)
    -> ParseASN1 Integer
    -> ParseASN1
         (SignatureALG
          -> DistinguishedName
          -> (DateTime, DateTime)
          -> DistinguishedName
          -> PubKey
          -> Extensions
          -> Certificate)
    forall a b. ParseASN1 (a -> b) -> ParseASN1 a -> ParseASN1 b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 Integer
    parseCertHeaderSerial
                    ParseASN1
      (SignatureALG
       -> DistinguishedName
       -> (DateTime, DateTime)
       -> DistinguishedName
       -> PubKey
       -> Extensions
       -> Certificate)
    -> ParseASN1 SignatureALG
    -> ParseASN1
         (DistinguishedName
          -> (DateTime, DateTime)
          -> DistinguishedName
          -> PubKey
          -> Extensions
          -> Certificate)
    forall a b. ParseASN1 (a -> b) -> ParseASN1 a -> ParseASN1 b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 SignatureALG
    forall a. ASN1Object a => ParseASN1 a
    getObject
                    ParseASN1
      (DistinguishedName
       -> (DateTime, DateTime)
       -> DistinguishedName
       -> PubKey
       -> Extensions
       -> Certificate)
    -> ParseASN1 DistinguishedName
    -> ParseASN1
         ((DateTime, DateTime)
          -> DistinguishedName -> PubKey -> Extensions -> Certificate)
    forall a b. ParseASN1 (a -> b) -> ParseASN1 a -> ParseASN1 b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 DistinguishedName
    forall a. ASN1Object a => ParseASN1 a
    getObject
                    ParseASN1
      ((DateTime, DateTime)
       -> DistinguishedName -> PubKey -> Extensions -> Certificate)
    -> ParseASN1 (DateTime, DateTime)
    -> ParseASN1
         (DistinguishedName -> PubKey -> Extensions -> Certificate)
    forall a b. ParseASN1 (a -> b) -> ParseASN1 a -> ParseASN1 b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 (DateTime, DateTime)
    parseCertHeaderValidity
                    ParseASN1
      (DistinguishedName -> PubKey -> Extensions -> Certificate)
    -> ParseASN1 DistinguishedName
    -> ParseASN1 (PubKey -> Extensions -> Certificate)
    forall a b. ParseASN1 (a -> b) -> ParseASN1 a -> ParseASN1 b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 DistinguishedName
    forall a. ASN1Object a => ParseASN1 a
    getObject
                    ParseASN1 (PubKey -> Extensions -> Certificate)
    -> ParseASN1 PubKey -> ParseASN1 (Extensions -> Certificate)
    forall a b. ParseASN1 (a -> b) -> ParseASN1 a -> ParseASN1 b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 PubKey
    forall a. ASN1Object a => ParseASN1 a
    getObject
                    ParseASN1 (Extensions -> Certificate)
    -> ParseASN1 Extensions -> ParseASN1 Certificate
    forall a b. ParseASN1 (a -> b) -> ParseASN1 a -> ParseASN1 b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 Extensions
    parseExtensions

    encodeCertificateHeader :: Certificate -> [ASN1]
    encodeCertificateHeader :: Certificate -> [ASN1]
    encodeCertificateHeader Certificate
    cert =
        [ASN1]
    eVer [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++ [ASN1]
    eSerial [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++ [ASN1]
    eAlgId [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++ [ASN1]
    eIssuer [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++ [ASN1]
    eValidity [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++ [ASN1]
    eSubject [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++ [ASN1]
    epkinfo [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++ [ASN1]
    eexts
      where eVer :: [ASN1]
    eVer      = ASN1ConstructionType -> ASN1S
    asn1Container (ASN1Class -> Int -> ASN1ConstructionType
    Container ASN1Class
    Context Int
    0) [Integer -> ASN1
    IntVal (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Certificate -> Int
    certVersion Certificate
    cert)]
            eSerial :: [ASN1]
    eSerial   = [Integer -> ASN1
    IntVal (Integer -> ASN1) -> Integer -> ASN1
    forall a b. (a -> b) -> a -> b
    $ Certificate -> Integer
    certSerial Certificate
    cert]
            eAlgId :: [ASN1]
    eAlgId    = SignatureALG -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 (Certificate -> SignatureALG
    certSignatureAlg Certificate
    cert) []
            eIssuer :: [ASN1]
    eIssuer   = DistinguishedName -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 (Certificate -> DistinguishedName
    certIssuerDN Certificate
    cert) []
            (DateTime
    t1, DateTime
    t2)  = Certificate -> (DateTime, DateTime)
    certValidity Certificate
    cert
            eValidity :: [ASN1]
    eValidity = ASN1ConstructionType -> ASN1S
    asn1Container ASN1ConstructionType
    Sequence [ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1
    ASN1Time (DateTime -> ASN1TimeType
    forall {a}. (Ord a, Time a) => a -> ASN1TimeType
    timeType DateTime
    t1) DateTime
    t1 (TimezoneOffset -> Maybe TimezoneOffset
    forall a. a -> Maybe a
    Just (Int -> TimezoneOffset
    TimezoneOffset Int
    0))
                                               ,ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1
    ASN1Time (DateTime -> ASN1TimeType
    forall {a}. (Ord a, Time a) => a -> ASN1TimeType
    timeType DateTime
    t2) DateTime
    t2 (TimezoneOffset -> Maybe TimezoneOffset
    forall a. a -> Maybe a
    Just (Int -> TimezoneOffset
    TimezoneOffset Int
    0))]
            eSubject :: [ASN1]
    eSubject  = DistinguishedName -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 (Certificate -> DistinguishedName
    certSubjectDN Certificate
    cert) []
            epkinfo :: [ASN1]
    epkinfo   = PubKey -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 (Certificate -> PubKey
    certPubKey Certificate
    cert) []
            eexts :: [ASN1]
    eexts     = case Certificate -> Extensions
    certExtensions Certificate
    cert of
                          Extensions Maybe [ExtensionRaw]
    Nothing -> []
                          Extensions
    exts -> ASN1ConstructionType -> ASN1S
    asn1Container (ASN1Class -> Int -> ASN1ConstructionType
    Container ASN1Class
    Context Int
    3) ASN1S -> ASN1S
    forall a b. (a -> b) -> a -> b
    $ Extensions -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 Extensions
    exts []
            timeType :: a -> ASN1TimeType
    timeType a
    t =
                if a
    t a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Date -> a
    forall t1 t2. (Timeable t1, Time t2) => t1 -> t2
    timeConvert (Int -> Month -> Int -> Date
    Date Int
    2050 Month
    January Int
    1)
                then ASN1TimeType
    TimeGeneralized
                else ASN1TimeType
    TimeUTC