{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
module Crypto.Store.CMS.OriginatorInfo
( OriginatorInfo(..)
, CertificateChoice(..)
, OtherCertificateFormat(..)
, RevocationInfoChoice(..)
, OtherRevocationInfoFormat(..)
, originatorInfoASN1S
, parseOriginatorInfo
, hasChoiceOther
) where
import Control.Applicative
import Data.ASN1.Types
import Data.Maybe (fromMaybe)
import Data.Semigroup
import Data.X509
import Crypto.Store.ASN1.Generate
import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS.Util
class HasChoiceOther a where
hasChoiceOther :: a -> Bool
instance (HasChoiceOther a, Foldable f) => HasChoiceOther (f a) where
hasChoiceOther :: f a -> Bool
hasChoiceOther = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. HasChoiceOther a => a -> Bool
hasChoiceOther
data OriginatorInfo = OriginatorInfo
{ OriginatorInfo -> [CertificateChoice]
originatorCerts :: [CertificateChoice]
, OriginatorInfo -> [RevocationInfoChoice]
originatorCRLs :: [RevocationInfoChoice]
}
deriving (Int -> OriginatorInfo -> ShowS
[OriginatorInfo] -> ShowS
OriginatorInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OriginatorInfo] -> ShowS
$cshowList :: [OriginatorInfo] -> ShowS
show :: OriginatorInfo -> String
$cshow :: OriginatorInfo -> String
showsPrec :: Int -> OriginatorInfo -> ShowS
$cshowsPrec :: Int -> OriginatorInfo -> ShowS
Show,OriginatorInfo -> OriginatorInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OriginatorInfo -> OriginatorInfo -> Bool
$c/= :: OriginatorInfo -> OriginatorInfo -> Bool
== :: OriginatorInfo -> OriginatorInfo -> Bool
$c== :: OriginatorInfo -> OriginatorInfo -> Bool
Eq)
instance Semigroup OriginatorInfo where
OriginatorInfo [CertificateChoice]
a [RevocationInfoChoice]
b <> :: OriginatorInfo -> OriginatorInfo -> OriginatorInfo
<> OriginatorInfo [CertificateChoice]
c [RevocationInfoChoice]
d = [CertificateChoice] -> [RevocationInfoChoice] -> OriginatorInfo
OriginatorInfo ([CertificateChoice]
a forall a. Semigroup a => a -> a -> a
<> [CertificateChoice]
c) ([RevocationInfoChoice]
b forall a. Semigroup a => a -> a -> a
<> [RevocationInfoChoice]
d)
instance Monoid OriginatorInfo where
mempty :: OriginatorInfo
mempty = [CertificateChoice] -> [RevocationInfoChoice] -> OriginatorInfo
OriginatorInfo [] []
mappend :: OriginatorInfo -> OriginatorInfo -> OriginatorInfo
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance HasChoiceOther OriginatorInfo where
hasChoiceOther :: OriginatorInfo -> Bool
hasChoiceOther OriginatorInfo{[RevocationInfoChoice]
[CertificateChoice]
originatorCRLs :: [RevocationInfoChoice]
originatorCerts :: [CertificateChoice]
originatorCRLs :: OriginatorInfo -> [RevocationInfoChoice]
originatorCerts :: OriginatorInfo -> [CertificateChoice]
..} =
forall a. HasChoiceOther a => a -> Bool
hasChoiceOther [CertificateChoice]
originatorCerts Bool -> Bool -> Bool
|| forall a. HasChoiceOther a => a -> Bool
hasChoiceOther [RevocationInfoChoice]
originatorCRLs
instance ProduceASN1Object ASN1P OriginatorInfo where
asn1s :: OriginatorInfo -> ASN1Stream ASN1P
asn1s = ASN1ConstructionType -> OriginatorInfo -> ASN1Stream ASN1P
originatorInfoASN1S ASN1ConstructionType
Sequence
instance ParseASN1Object [ASN1Event] OriginatorInfo where
parse :: ParseASN1 [ASN1Event] OriginatorInfo
parse = ASN1ConstructionType -> ParseASN1 [ASN1Event] OriginatorInfo
parseOriginatorInfo ASN1ConstructionType
Sequence
originatorInfoASN1S :: ASN1ConstructionType -> OriginatorInfo -> ASN1PS
originatorInfoASN1S :: ASN1ConstructionType -> OriginatorInfo -> ASN1Stream ASN1P
originatorInfoASN1S ASN1ConstructionType
ty OriginatorInfo{[RevocationInfoChoice]
[CertificateChoice]
originatorCRLs :: [RevocationInfoChoice]
originatorCerts :: [CertificateChoice]
originatorCRLs :: OriginatorInfo -> [RevocationInfoChoice]
originatorCerts :: OriginatorInfo -> [CertificateChoice]
..} =
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
ty forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {e} {a}.
(Foldable t, ASN1Elem e, ProduceASN1Object e (t a)) =>
Int -> t a -> [e] -> [e]
gen Int
0 [CertificateChoice]
originatorCerts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *} {e} {a}.
(Foldable t, ASN1Elem e, ProduceASN1Object e (t a)) =>
Int -> t a -> [e] -> [e]
gen Int
1 [RevocationInfoChoice]
originatorCRLs
where
gen :: Int -> t a -> [e] -> [e]
gen Int
tag t a
list
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
list = forall a. a -> a
id
| Bool
otherwise = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
tag) (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s t a
list)
parseOriginatorInfo :: ASN1ConstructionType
-> ParseASN1 [ASN1Event] OriginatorInfo
parseOriginatorInfo :: ASN1ConstructionType -> ParseASN1 [ASN1Event] OriginatorInfo
parseOriginatorInfo ASN1ConstructionType
ty = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
ty forall a b. (a -> b) -> a -> b
$ do
[CertificateChoice]
certs <- forall {e} {a}. ParseASN1Object e a => Int -> ParseASN1 e [a]
parseOptList Int
0
[RevocationInfoChoice]
crls <- forall {e} {a}. ParseASN1Object e a => Int -> ParseASN1 e [a]
parseOptList Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return OriginatorInfo { originatorCerts :: [CertificateChoice]
originatorCerts = [CertificateChoice]
certs
, originatorCRLs :: [RevocationInfoChoice]
originatorCRLs = [RevocationInfoChoice]
crls
}
where
parseOptList :: Int -> ParseASN1 e [a]
parseOptList Int
tag =
forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
tag) forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
data CertificateChoice
= CertificateCertificate SignedCertificate
| CertificateOther OtherCertificateFormat
deriving (Int -> CertificateChoice -> ShowS
[CertificateChoice] -> ShowS
CertificateChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertificateChoice] -> ShowS
$cshowList :: [CertificateChoice] -> ShowS
show :: CertificateChoice -> String
$cshow :: CertificateChoice -> String
showsPrec :: Int -> CertificateChoice -> ShowS
$cshowsPrec :: Int -> CertificateChoice -> ShowS
Show,CertificateChoice -> CertificateChoice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificateChoice -> CertificateChoice -> Bool
$c/= :: CertificateChoice -> CertificateChoice -> Bool
== :: CertificateChoice -> CertificateChoice -> Bool
$c== :: CertificateChoice -> CertificateChoice -> Bool
Eq)
instance HasChoiceOther CertificateChoice where
hasChoiceOther :: CertificateChoice -> Bool
hasChoiceOther (CertificateOther OtherCertificateFormat
_) = Bool
True
hasChoiceOther CertificateChoice
_ = Bool
False
instance ProduceASN1Object ASN1P CertificateChoice where
asn1s :: CertificateChoice -> ASN1Stream ASN1P
asn1s (CertificateCertificate SignedCertificate
cert) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s SignedCertificate
cert
asn1s (CertificateOther OtherCertificateFormat
other) =
forall e.
ASN1Elem e =>
ASN1ConstructionType -> OtherCertificateFormat -> ASN1Stream e
otherCertificateFormatASN1PS (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
3) OtherCertificateFormat
other
instance ParseASN1Object [ASN1Event] CertificateChoice where
parse :: ParseASN1 [ASN1Event] CertificateChoice
parse = ParseASN1 [ASN1Event] CertificateChoice
parseMain forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 [ASN1Event] CertificateChoice
parseOther
where parseMain :: ParseASN1 [ASN1Event] CertificateChoice
parseMain = SignedCertificate -> CertificateChoice
CertificateCertificate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseOther :: ParseASN1 [ASN1Event] CertificateChoice
parseOther = OtherCertificateFormat -> CertificateChoice
CertificateOther forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e OtherCertificateFormat
parseOtherCertificateFormat (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
3)
data RevocationInfoChoice
= RevocationInfoCRL SignedCRL
| OtherRevocationInfoFormat
deriving (Int -> RevocationInfoChoice -> ShowS
[RevocationInfoChoice] -> ShowS
RevocationInfoChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevocationInfoChoice] -> ShowS
$cshowList :: [RevocationInfoChoice] -> ShowS
show :: RevocationInfoChoice -> String
$cshow :: RevocationInfoChoice -> String
showsPrec :: Int -> RevocationInfoChoice -> ShowS
$cshowsPrec :: Int -> RevocationInfoChoice -> ShowS
Show,RevocationInfoChoice -> RevocationInfoChoice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevocationInfoChoice -> RevocationInfoChoice -> Bool
$c/= :: RevocationInfoChoice -> RevocationInfoChoice -> Bool
== :: RevocationInfoChoice -> RevocationInfoChoice -> Bool
$c== :: RevocationInfoChoice -> RevocationInfoChoice -> Bool
Eq)
instance HasChoiceOther RevocationInfoChoice where
hasChoiceOther :: RevocationInfoChoice -> Bool
hasChoiceOther (RevocationInfoOther OtherRevocationInfoFormat
_) = Bool
True
hasChoiceOther RevocationInfoChoice
_ = Bool
False
instance ProduceASN1Object ASN1P RevocationInfoChoice where
asn1s :: RevocationInfoChoice -> ASN1Stream ASN1P
asn1s (RevocationInfoCRL SignedCRL
crl) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s SignedCRL
crl
asn1s (RevocationInfoOther OtherRevocationInfoFormat
other) =
forall e.
ASN1Elem e =>
ASN1ConstructionType -> OtherRevocationInfoFormat -> ASN1Stream e
otherRevocationInfoFormatASN1PS (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) OtherRevocationInfoFormat
other
instance ParseASN1Object [ASN1Event] RevocationInfoChoice where
parse :: ParseASN1 [ASN1Event] RevocationInfoChoice
parse = ParseASN1 [ASN1Event] RevocationInfoChoice
parseMain forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 [ASN1Event] RevocationInfoChoice
parseOther
where parseMain :: ParseASN1 [ASN1Event] RevocationInfoChoice
parseMain = SignedCRL -> RevocationInfoChoice
RevocationInfoCRL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseOther :: ParseASN1 [ASN1Event] RevocationInfoChoice
parseOther = OtherRevocationInfoFormat -> RevocationInfoChoice
RevocationInfoOther forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e OtherRevocationInfoFormat
parseOtherRevocationInfoFormat (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
data OtherCertificateFormat = OtherCertificateFormat
{ OtherCertificateFormat -> OID
otherCertFormat :: OID
, OtherCertificateFormat -> [ASN1]
otherCertValues :: [ASN1]
}
deriving (Int -> OtherCertificateFormat -> ShowS
[OtherCertificateFormat] -> ShowS
OtherCertificateFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherCertificateFormat] -> ShowS
$cshowList :: [OtherCertificateFormat] -> ShowS
show :: OtherCertificateFormat -> String
$cshow :: OtherCertificateFormat -> String
showsPrec :: Int -> OtherCertificateFormat -> ShowS
$cshowsPrec :: Int -> OtherCertificateFormat -> ShowS
Show,OtherCertificateFormat -> OtherCertificateFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherCertificateFormat -> OtherCertificateFormat -> Bool
$c/= :: OtherCertificateFormat -> OtherCertificateFormat -> Bool
== :: OtherCertificateFormat -> OtherCertificateFormat -> Bool
$c== :: OtherCertificateFormat -> OtherCertificateFormat -> Bool
Eq)
otherCertificateFormatASN1PS :: ASN1Elem e
=> ASN1ConstructionType
-> OtherCertificateFormat
-> ASN1Stream e
otherCertificateFormatASN1PS :: forall e.
ASN1Elem e =>
ASN1ConstructionType -> OtherCertificateFormat -> ASN1Stream e
otherCertificateFormatASN1PS ASN1ConstructionType
ty OtherCertificateFormat{OID
[ASN1]
otherCertValues :: [ASN1]
otherCertFormat :: OID
otherCertValues :: OtherCertificateFormat -> [ASN1]
otherCertFormat :: OtherCertificateFormat -> OID
..} =
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
ty ([e] -> [e]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
v)
where f :: [e] -> [e]
f = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID OID
otherCertFormat
v :: [e] -> [e]
v = forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
gMany [ASN1]
otherCertValues
parseOtherCertificateFormat :: Monoid e
=> ASN1ConstructionType
-> ParseASN1 e OtherCertificateFormat
parseOtherCertificateFormat :: forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e OtherCertificateFormat
parseOtherCertificateFormat ASN1ConstructionType
ty = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
ty forall a b. (a -> b) -> a -> b
$ do
OID OID
f <- forall e. Monoid e => ParseASN1 e ASN1
getNext
[ASN1]
v <- forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany forall e. Monoid e => ParseASN1 e ASN1
getNext
forall (m :: * -> *) a. Monad m => a -> m a
return OtherCertificateFormat { otherCertFormat :: OID
otherCertFormat = OID
f
, otherCertValues :: [ASN1]
otherCertValues = [ASN1]
v }
data OtherRevocationInfoFormat = OtherRevocationInfoFormat
{ OtherRevocationInfoFormat -> OID
otherRevInfoFormat :: OID
, OtherRevocationInfoFormat -> [ASN1]
otherRevInfoValues :: [ASN1]
}
deriving (Int -> OtherRevocationInfoFormat -> ShowS
[OtherRevocationInfoFormat] -> ShowS
OtherRevocationInfoFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherRevocationInfoFormat] -> ShowS
$cshowList :: [OtherRevocationInfoFormat] -> ShowS
show :: OtherRevocationInfoFormat -> String
$cshow :: OtherRevocationInfoFormat -> String
showsPrec :: Int -> OtherRevocationInfoFormat -> ShowS
$cshowsPrec :: Int -> OtherRevocationInfoFormat -> ShowS
Show,OtherRevocationInfoFormat -> OtherRevocationInfoFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherRevocationInfoFormat -> OtherRevocationInfoFormat -> Bool
$c/= :: OtherRevocationInfoFormat -> OtherRevocationInfoFormat -> Bool
== :: OtherRevocationInfoFormat -> OtherRevocationInfoFormat -> Bool
$c== :: OtherRevocationInfoFormat -> OtherRevocationInfoFormat -> Bool
Eq)
otherRevocationInfoFormatASN1PS :: ASN1Elem e
=> ASN1ConstructionType
-> OtherRevocationInfoFormat
-> ASN1Stream e
otherRevocationInfoFormatASN1PS :: forall e.
ASN1Elem e =>
ASN1ConstructionType -> OtherRevocationInfoFormat -> ASN1Stream e
otherRevocationInfoFormatASN1PS ASN1ConstructionType
ty OtherRevocationInfoFormat{OID
[ASN1]
otherRevInfoValues :: [ASN1]
otherRevInfoFormat :: OID
otherRevInfoValues :: OtherRevocationInfoFormat -> [ASN1]
otherRevInfoFormat :: OtherRevocationInfoFormat -> OID
..} =
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
ty ([e] -> [e]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
v)
where f :: [e] -> [e]
f = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID OID
otherRevInfoFormat
v :: [e] -> [e]
v = forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
gMany [ASN1]
otherRevInfoValues
parseOtherRevocationInfoFormat :: Monoid e
=> ASN1ConstructionType
-> ParseASN1 e OtherRevocationInfoFormat
parseOtherRevocationInfoFormat :: forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e OtherRevocationInfoFormat
parseOtherRevocationInfoFormat ASN1ConstructionType
ty = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
ty forall a b. (a -> b) -> a -> b
$ do
OID OID
f <- forall e. Monoid e => ParseASN1 e ASN1
getNext
[ASN1]
v <- forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany forall e. Monoid e => ParseASN1 e ASN1
getNext
forall (m :: * -> *) a. Monad m => a -> m a
return OtherRevocationInfoFormat { otherRevInfoFormat :: OID
otherRevInfoFormat = OID
f
, otherRevInfoValues :: [ASN1]
otherRevInfoValues = [ASN1]
v }