{-# 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
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
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)
data Certificate = Certificate
{ Certificate -> Int
certVersion :: Int
, Certificate -> Integer
certSerial :: Integer
, Certificate -> SignatureALG
certSignatureAlg :: SignatureALG
, Certificate -> DistinguishedName
certIssuerDN :: DistinguishedName
, Certificate -> (DateTime, DateTime)
certValidity :: (DateTime, DateTime)
, Certificate -> DistinguishedName
certSubjectDN :: DistinguishedName
, Certificate -> PubKey
certPubKey :: PubKey
, Certificate -> Extensions
certExtensions :: Extensions
} deriving (Int -> Certificate -> ShowS
[Certificate] -> ShowS
Certificate -> String
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
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 forall a. [a] -> [a] -> [a]
++ [ASN1]
xs
fromASN1 :: [ASN1] -> Either String (Certificate, [ASN1])
fromASN1 [ASN1]
s = forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
runParseASN1State ParseASN1 Certificate
parseCertificate [ASN1]
s
parseCertHeaderVersion :: ParseASN1 Int
=
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (ParseASN1 ASN1
getNext forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. Num a => ASN1 -> ParseASN1 a
getVer)
where getVer :: ASN1 -> ParseASN1 a
getVer (IntVal Integer
v) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v
getVer ASN1
_ = forall a. String -> ParseASN1 a
throwParseError String
"unexpected type for version"
parseCertHeaderSerial :: ParseASN1 Integer
= do
ASN1
n <- ParseASN1 ASN1
getNext
case ASN1
n of
IntVal Integer
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
ASN1
_ -> forall a. String -> ParseASN1 a
throwParseError (String
"missing serial" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASN1
n)
parseCertHeaderValidity :: ParseASN1 (DateTime, DateTime)
= ASN1ConstructionType -> ParseASN1 [ASN1]
getNextContainer ASN1ConstructionType
Sequence 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
_ ] = forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime
t1,DateTime
t2)
toTimeBound [ASN1]
_ = forall a. String -> ParseASN1 a
throwParseError String
"bad validity format"
parseExtensions :: ParseASN1 Extensions
parseExtensions :: ParseASN1 Extensions
parseExtensions = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Extensions -> Extensions
adapt forall a b. (a -> b) -> a -> b
$ forall a.
ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
3) forall a b. (a -> b) -> a -> b
$ 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 forall a. Maybe a
Nothing
parseCertificate :: ParseASN1 Certificate
parseCertificate :: ParseASN1 Certificate
parseCertificate =
Int
-> Integer
-> SignatureALG
-> DistinguishedName
-> (DateTime, DateTime)
-> DistinguishedName
-> PubKey
-> Extensions
-> Certificate
Certificate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 Int
parseCertHeaderVersion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseASN1 Integer
parseCertHeaderSerial
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ASN1Object a => ParseASN1 a
getObject
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ASN1Object a => ParseASN1 a
getObject
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseASN1 (DateTime, DateTime)
parseCertHeaderValidity
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ASN1Object a => ParseASN1 a
getObject
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ASN1Object a => ParseASN1 a
getObject
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseASN1 Extensions
parseExtensions
encodeCertificateHeader :: Certificate -> [ASN1]
Certificate
cert =
[ASN1]
eVer forall a. [a] -> [a] -> [a]
++ [ASN1]
eSerial forall a. [a] -> [a] -> [a]
++ [ASN1]
eAlgId forall a. [a] -> [a] -> [a]
++ [ASN1]
eIssuer forall a. [a] -> [a] -> [a]
++ [ASN1]
eValidity forall a. [a] -> [a] -> [a]
++ [ASN1]
eSubject forall a. [a] -> [a] -> [a]
++ [ASN1]
epkinfo 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Certificate -> Int
certVersion Certificate
cert)]
eSerial :: [ASN1]
eSerial = [Integer -> ASN1
IntVal forall a b. (a -> b) -> a -> b
$ Certificate -> Integer
certSerial Certificate
cert]
eAlgId :: [ASN1]
eAlgId = forall a. ASN1Object a => a -> ASN1S
toASN1 (Certificate -> SignatureALG
certSignatureAlg Certificate
cert) []
eIssuer :: [ASN1]
eIssuer = 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 (forall {a}. (Ord a, Time a) => a -> ASN1TimeType
timeType DateTime
t1) DateTime
t1 (forall a. a -> Maybe a
Just (Int -> TimezoneOffset
TimezoneOffset Int
0))
,ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1
ASN1Time (forall {a}. (Ord a, Time a) => a -> ASN1TimeType
timeType DateTime
t2) DateTime
t2 (forall a. a -> Maybe a
Just (Int -> TimezoneOffset
TimezoneOffset Int
0))]
eSubject :: [ASN1]
eSubject = forall a. ASN1Object a => a -> ASN1S
toASN1 (Certificate -> DistinguishedName
certSubjectDN Certificate
cert) []
epkinfo :: [ASN1]
epkinfo = 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) forall a b. (a -> b) -> a -> b
$ forall a. ASN1Object a => a -> ASN1S
toASN1 Extensions
exts []
timeType :: a -> ASN1TimeType
timeType a
t =
if a
t forall a. Ord a => a -> a -> Bool
>= 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