-- |
-- 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
showList :: [CertKeyUsage] -> ShowS
$cshowList :: [CertKeyUsage] -> ShowS
show :: CertKeyUsage -> String
$cshow :: CertKeyUsage -> String
showsPrec :: Int -> CertKeyUsage -> ShowS
$cshowsPrec :: Int -> CertKeyUsage -> ShowS
Show, CertKeyUsage -> CertKeyUsage -> Bool
(CertKeyUsage -> CertKeyUsage -> Bool)
-> (CertKeyUsage -> CertKeyUsage -> Bool) -> Eq CertKeyUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertKeyUsage -> CertKeyUsage -> Bool
$c/= :: CertKeyUsage -> CertKeyUsage -> Bool
== :: CertKeyUsage -> CertKeyUsage -> Bool
$c== :: 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
showList :: [Certificate] -> ShowS
$cshowList :: [Certificate] -> ShowS
show :: Certificate -> String
$cshow :: Certificate -> String
showsPrec :: Int -> Certificate -> ShowS
$cshowsPrec :: Int -> Certificate -> ShowS
Show,Certificate -> Certificate -> Bool
(Certificate -> Certificate -> Bool)
-> (Certificate -> Certificate -> Bool) -> Eq Certificate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Certificate -> Certificate -> Bool
$c/= :: Certificate -> Certificate -> Bool
== :: Certificate -> Certificate -> Bool
$c== :: 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 (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 (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
    ASN1
n <- ParseASN1 ASN1
getNext
    case ASN1
n of
        IntVal Integer
v -> Integer -> ParseASN1 Integer
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 (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 (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)
-}
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 (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 (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 (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 (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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseASN1 Extensions
forall a. ASN1Object a => ParseASN1 a
getObject

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     = Extensions -> ASN1S
forall a. ASN1Object a => a -> ASN1S
toASN1 (Certificate -> Extensions
certExtensions Certificate
cert) []
        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