{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
module Crypto.Store.CMS.Signed
( EncapsulatedContent
, SignedData(..)
, SignerInfo(..)
, SignerIdentifier(..)
, IssuerAndSerialNumber(..)
, ProducerOfSI
, ConsumerOfSI
, certSigner
, withPublicKey
, withSignerKey
, withSignerCertificate
, encapsulatedContentInfoASN1S
, parseEncapsulatedContentInfo
) where
import Control.Applicative
import Control.Monad
import Data.ASN1.Types
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Hourglass
import Data.List
import Data.Maybe
import Data.X509
import Crypto.Random (MonadRandom)
import Crypto.Store.ASN1.Generate
import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS.Algorithms
import Crypto.Store.CMS.AuthEnveloped
import Crypto.Store.CMS.Attribute
import Crypto.Store.CMS.Enveloped
import Crypto.Store.CMS.OriginatorInfo
import Crypto.Store.CMS.Type
import Crypto.Store.CMS.Util
import Crypto.Store.Error
type EncapsulatedContent = ByteString
data SignerInfo = SignerInfo
{ SignerInfo -> SignerIdentifier
siSignerId :: SignerIdentifier
, SignerInfo -> DigestAlgorithm
siDigestAlgorithm :: DigestAlgorithm
, SignerInfo -> [Attribute]
siSignedAttrs :: [Attribute]
, SignerInfo -> SignatureAlg
siSignatureAlg :: SignatureAlg
, SignerInfo -> SignatureValue
siSignature :: SignatureValue
, SignerInfo -> [Attribute]
siUnsignedAttrs :: [Attribute]
}
deriving (Int -> SignerInfo -> ShowS
[SignerInfo] -> ShowS
SignerInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignerInfo] -> ShowS
$cshowList :: [SignerInfo] -> ShowS
show :: SignerInfo -> String
$cshow :: SignerInfo -> String
showsPrec :: Int -> SignerInfo -> ShowS
$cshowsPrec :: Int -> SignerInfo -> ShowS
Show,SignerInfo -> SignerInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignerInfo -> SignerInfo -> Bool
$c/= :: SignerInfo -> SignerInfo -> Bool
== :: SignerInfo -> SignerInfo -> Bool
$c== :: SignerInfo -> SignerInfo -> Bool
Eq)
instance ASN1Elem e => ProduceASN1Object e SignerInfo where
asn1s :: SignerInfo -> ASN1Stream e
asn1s SignerInfo{[Attribute]
SignatureValue
SignatureAlg
DigestAlgorithm
SignerIdentifier
siUnsignedAttrs :: [Attribute]
siSignature :: SignatureValue
siSignatureAlg :: SignatureAlg
siSignedAttrs :: [Attribute]
siDigestAlgorithm :: DigestAlgorithm
siSignerId :: SignerIdentifier
siUnsignedAttrs :: SignerInfo -> [Attribute]
siSignature :: SignerInfo -> SignatureValue
siSignatureAlg :: SignerInfo -> SignatureAlg
siSignedAttrs :: SignerInfo -> [Attribute]
siDigestAlgorithm :: SignerInfo -> DigestAlgorithm
siSignerId :: SignerInfo -> SignerIdentifier
..} =
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
sid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
dig forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
sa forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
alg forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
sig forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ua)
where
ver :: ASN1Stream e
ver = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (SignerIdentifier -> Integer
getVersion SignerIdentifier
siSignerId)
sid :: ASN1Stream e
sid = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s SignerIdentifier
siSignerId
dig :: ASN1Stream e
dig = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
siDigestAlgorithm
sa :: ASN1Stream e
sa = forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) [Attribute]
siSignedAttrs
alg :: ASN1Stream e
alg = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence SignatureAlg
siSignatureAlg
sig :: ASN1Stream e
sig = forall e. ASN1Elem e => SignatureValue -> ASN1Stream e
gOctetString SignatureValue
siSignature
ua :: ASN1Stream e
ua = forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) [Attribute]
siUnsignedAttrs
instance Monoid e => ParseASN1Object e SignerInfo where
parse :: ParseASN1 e SignerInfo
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
IntVal Integer
v <- forall e. Monoid e => ParseASN1 e ASN1
getNext
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v forall a. Eq a => a -> a -> Bool
/= Integer
1 Bool -> Bool -> Bool
&& Integer
v forall a. Eq a => a -> a -> Bool
/= Integer
3) forall a b. (a -> b) -> a -> b
$
forall e a. String -> ParseASN1 e a
throwParseError (String
"SignerInfo: parsed invalid version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
v)
SignerIdentifier
sid <- forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
DigestAlgorithm
dig <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
[Attribute]
sAttrs <- forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
SignatureAlg
alg <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
OctetString SignatureValue
sig <- forall e. Monoid e => ParseASN1 e ASN1
getNext
[Attribute]
uAttrs <- forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
forall (m :: * -> *) a. Monad m => a -> m a
return SignerInfo { siSignerId :: SignerIdentifier
siSignerId = SignerIdentifier
sid
, siDigestAlgorithm :: DigestAlgorithm
siDigestAlgorithm = DigestAlgorithm
dig
, siSignedAttrs :: [Attribute]
siSignedAttrs = [Attribute]
sAttrs
, siSignatureAlg :: SignatureAlg
siSignatureAlg = SignatureAlg
alg
, siSignature :: SignatureValue
siSignature = SignatureValue
sig
, siUnsignedAttrs :: [Attribute]
siUnsignedAttrs = [Attribute]
uAttrs
}
getVersion :: SignerIdentifier -> Integer
getVersion :: SignerIdentifier -> Integer
getVersion (SignerIASN IssuerAndSerialNumber
_) = Integer
1
getVersion (SignerSKI SignatureValue
_) = Integer
3
isVersion3 :: SignerInfo -> Bool
isVersion3 :: SignerInfo -> Bool
isVersion3 = (forall a. Eq a => a -> a -> Bool
== Integer
3) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignerIdentifier -> Integer
getVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignerInfo -> SignerIdentifier
siSignerId
data SignerIdentifier
= SignerIASN IssuerAndSerialNumber
| SignerSKI ByteString
deriving (Int -> SignerIdentifier -> ShowS
[SignerIdentifier] -> ShowS
SignerIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignerIdentifier] -> ShowS
$cshowList :: [SignerIdentifier] -> ShowS
show :: SignerIdentifier -> String
$cshow :: SignerIdentifier -> String
showsPrec :: Int -> SignerIdentifier -> ShowS
$cshowsPrec :: Int -> SignerIdentifier -> ShowS
Show,SignerIdentifier -> SignerIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignerIdentifier -> SignerIdentifier -> Bool
$c/= :: SignerIdentifier -> SignerIdentifier -> Bool
== :: SignerIdentifier -> SignerIdentifier -> Bool
$c== :: SignerIdentifier -> SignerIdentifier -> Bool
Eq)
instance ASN1Elem e => ProduceASN1Object e SignerIdentifier where
asn1s :: SignerIdentifier -> ASN1Stream e
asn1s (SignerIASN IssuerAndSerialNumber
iasn) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s IssuerAndSerialNumber
iasn
asn1s (SignerSKI SignatureValue
ski) = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
(forall e. ASN1Elem e => SignatureValue -> ASN1Stream e
gOctetString SignatureValue
ski)
instance Monoid e => ParseASN1Object e SignerIdentifier where
parse :: ParseASN1 e SignerIdentifier
parse = ParseASN1 e SignerIdentifier
parseIASN forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e SignerIdentifier
parseSKI
where parseIASN :: ParseASN1 e SignerIdentifier
parseIASN = IssuerAndSerialNumber -> SignerIdentifier
SignerIASN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseSKI :: ParseASN1 e SignerIdentifier
parseSKI = SignatureValue -> SignerIdentifier
SignerSKI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) forall e. Monoid e => ParseASN1 e SignatureValue
parseOctetStringPrim
findSigner :: SignerIdentifier
-> [SignedCertificate]
-> Maybe (SignedCertificate, [SignedCertificate])
findSigner :: SignerIdentifier
-> [SignedCertificate]
-> Maybe (SignedCertificate, [SignedCertificate])
findSigner (SignerIASN IssuerAndSerialNumber
iasn) [SignedCertificate]
certs =
forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
partitionHead (Certificate -> Bool
matchIASN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned) [SignedCertificate]
certs
where
matchIASN :: Certificate -> Bool
matchIASN Certificate
c =
(IssuerAndSerialNumber -> DistinguishedName
iasnIssuer IssuerAndSerialNumber
iasn, IssuerAndSerialNumber -> Integer
iasnSerial IssuerAndSerialNumber
iasn) forall a. Eq a => a -> a -> Bool
== (Certificate -> DistinguishedName
certIssuerDN Certificate
c, Certificate -> Integer
certSerial Certificate
c)
findSigner (SignerSKI SignatureValue
ski) [SignedCertificate]
certs =
forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
partitionHead (Certificate -> Bool
matchSKIforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned) [SignedCertificate]
certs
where
matchSKI :: Certificate -> Bool
matchSKI Certificate
c =
case forall a. Extension a => Extensions -> Maybe a
extensionGet (Certificate -> Extensions
certExtensions Certificate
c) of
Just (ExtSubjectKeyId SignatureValue
idBs) -> SignatureValue
idBs forall a. Eq a => a -> a -> Bool
== SignatureValue
ski
Maybe ExtSubjectKeyId
Nothing -> Bool
False
partitionHead :: (a -> Bool) -> [a] -> Maybe (a, [a])
partitionHead :: forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
partitionHead a -> Bool
p [a]
l =
case forall a. (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
p [a]
l of
(a
x : [a]
_, [a]
r) -> forall a. a -> Maybe a
Just (a
x, [a]
r)
([] , [a]
_) -> forall a. Maybe a
Nothing
type ProducerOfSI m = ContentType -> ByteString -> m (Either StoreError (SignerInfo, [CertificateChoice], [RevocationInfoChoice]))
type ConsumerOfSI m = ContentType -> ByteString -> SignerInfo -> [CertificateChoice] -> [RevocationInfoChoice] -> m Bool
certSigner :: MonadRandom m
=> SignatureAlg
-> PrivKey
-> CertificateChain
-> Maybe [Attribute]
-> [Attribute]
-> ProducerOfSI m
certSigner :: forall (m :: * -> *).
MonadRandom m =>
SignatureAlg
-> PrivKey
-> CertificateChain
-> Maybe [Attribute]
-> [Attribute]
-> ProducerOfSI m
certSigner SignatureAlg
alg PrivKey
priv (CertificateChain [SignedCertificate]
chain) Maybe [Attribute]
sAttrsM [Attribute]
uAttrs ContentType
ct SignatureValue
msg =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}.
SignatureValue -> (SignerInfo, [CertificateChoice], [a])
build forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Either StoreError SignatureValue)
generate
where
md :: SignatureValue
md = forall message.
ByteArrayAccess message =>
DigestAlgorithm -> message -> SignatureValue
digest DigestAlgorithm
dig SignatureValue
msg
def :: DigestAlgorithm
def = forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
Crypto.Store.CMS.Algorithms.SHA256
cert :: SignedCertificate
cert = forall a. [a] -> a
head [SignedCertificate]
chain
obj :: Certificate
obj = forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject (forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned SignedCertificate
cert)
isn :: IssuerAndSerialNumber
isn = DistinguishedName -> Integer -> IssuerAndSerialNumber
IssuerAndSerialNumber (Certificate -> DistinguishedName
certIssuerDN Certificate
obj) (Certificate -> Integer
certSerial Certificate
obj)
pub :: PubKey
pub = Certificate -> PubKey
certPubKey Certificate
obj
(DigestAlgorithm
dig, SignatureAlg
alg') = Bool
-> DigestAlgorithm
-> SignatureAlg
-> (DigestAlgorithm, SignatureAlg)
signatureResolveHash Bool
noAttr DigestAlgorithm
def SignatureAlg
alg
noAttr :: Bool
noAttr = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
sAttrs
([Attribute]
sAttrs, SignatureValue
input) =
case Maybe [Attribute]
sAttrsM of
Maybe [Attribute]
Nothing -> ([], SignatureValue
msg)
Just [Attribute]
attrs ->
let l :: [Attribute]
l = ContentType -> [Attribute] -> [Attribute]
setContentTypeAttr ContentType
ct forall a b. (a -> b) -> a -> b
$ SignatureValue -> [Attribute] -> [Attribute]
setMessageDigestAttr SignatureValue
md [Attribute]
attrs
in ([Attribute]
l, [Attribute] -> SignatureValue
encodeAuthAttrs [Attribute]
l)
generate :: m (Either StoreError SignatureValue)
generate = forall (m :: * -> *).
MonadRandom m =>
SignatureAlg
-> PrivKey
-> PubKey
-> SignatureValue
-> m (Either StoreError SignatureValue)
signatureGenerate SignatureAlg
alg' PrivKey
priv PubKey
pub SignatureValue
input
build :: SignatureValue -> (SignerInfo, [CertificateChoice], [a])
build SignatureValue
sig =
let si :: SignerInfo
si = SignerInfo { siSignerId :: SignerIdentifier
siSignerId = IssuerAndSerialNumber -> SignerIdentifier
SignerIASN IssuerAndSerialNumber
isn
, siDigestAlgorithm :: DigestAlgorithm
siDigestAlgorithm = DigestAlgorithm
dig
, siSignedAttrs :: [Attribute]
siSignedAttrs = [Attribute]
sAttrs
, siSignatureAlg :: SignatureAlg
siSignatureAlg = SignatureAlg
alg
, siSignature :: SignatureValue
siSignature = SignatureValue
sig
, siUnsignedAttrs :: [Attribute]
siUnsignedAttrs = [Attribute]
uAttrs
}
in (SignerInfo
si, forall a b. (a -> b) -> [a] -> [b]
map SignedCertificate -> CertificateChoice
CertificateCertificate [SignedCertificate]
chain, [])
withPublicKey :: Applicative f => PubKey -> ConsumerOfSI f
withPublicKey :: forall (f :: * -> *). Applicative f => PubKey -> ConsumerOfSI f
withPublicKey PubKey
pub ContentType
ct SignatureValue
msg SignerInfo{[Attribute]
SignatureValue
SignatureAlg
DigestAlgorithm
SignerIdentifier
siUnsignedAttrs :: [Attribute]
siSignature :: SignatureValue
siSignatureAlg :: SignatureAlg
siSignedAttrs :: [Attribute]
siDigestAlgorithm :: DigestAlgorithm
siSignerId :: SignerIdentifier
siUnsignedAttrs :: SignerInfo -> [Attribute]
siSignature :: SignerInfo -> SignatureValue
siSignatureAlg :: SignerInfo -> SignatureAlg
siSignedAttrs :: SignerInfo -> [Attribute]
siDigestAlgorithm :: SignerInfo -> DigestAlgorithm
siSignerId :: SignerInfo -> SignerIdentifier
..} [CertificateChoice]
_ [RevocationInfoChoice]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
noAttr Bool -> Bool -> Bool
|| Bool
attrMatch)
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
mdAccept
SignatureAlg
alg <- DigestAlgorithm -> SignatureAlg -> Maybe SignatureAlg
signatureCheckHash DigestAlgorithm
siDigestAlgorithm SignatureAlg
siSignatureAlg
forall (m :: * -> *) a. Monad m => a -> m a
return (SignatureAlg -> PubKey -> SignatureValue -> SignatureValue -> Bool
signatureVerify SignatureAlg
alg PubKey
pub SignatureValue
input SignatureValue
siSignature)
where
noAttr :: Bool
noAttr = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
siSignedAttrs
mdMatch :: Bool
mdMatch = Maybe SignatureValue
mdAttr forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall message.
ByteArrayAccess message =>
DigestAlgorithm -> message -> SignatureValue
digest DigestAlgorithm
siDigestAlgorithm SignatureValue
msg)
attrMatch :: Bool
attrMatch = Maybe ContentType
ctAttr forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ContentType
ct Bool -> Bool -> Bool
&& Bool
mdMatch
mdAttr :: Maybe SignatureValue
mdAttr = [Attribute] -> Maybe SignatureValue
getMessageDigestAttr [Attribute]
siSignedAttrs
mdAccept :: Bool
mdAccept = forall params. HasStrength params => params -> Bool
securityAcceptable DigestAlgorithm
siDigestAlgorithm
ctAttr :: Maybe ContentType
ctAttr = [Attribute] -> Maybe ContentType
getContentTypeAttr [Attribute]
siSignedAttrs
input :: SignatureValue
input = if Bool
noAttr then SignatureValue
msg else [Attribute] -> SignatureValue
encodeAuthAttrs [Attribute]
siSignedAttrs
withSignerKey :: Applicative f => ConsumerOfSI f
withSignerKey :: forall (f :: * -> *). Applicative f => ConsumerOfSI f
withSignerKey = forall (f :: * -> *).
Applicative f =>
(Maybe DateTime -> CertificateChain -> f Bool) -> ConsumerOfSI f
withSignerCertificate (\Maybe DateTime
_ CertificateChain
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
withSignerCertificate :: Applicative f
=> (Maybe DateTime -> CertificateChain -> f Bool)
-> ConsumerOfSI f
withSignerCertificate :: forall (f :: * -> *).
Applicative f =>
(Maybe DateTime -> CertificateChain -> f Bool) -> ConsumerOfSI f
withSignerCertificate Maybe DateTime -> CertificateChain -> f Bool
validate ContentType
ct SignatureValue
msg SignerInfo{[Attribute]
SignatureValue
SignatureAlg
DigestAlgorithm
SignerIdentifier
siUnsignedAttrs :: [Attribute]
siSignature :: SignatureValue
siSignatureAlg :: SignatureAlg
siSignedAttrs :: [Attribute]
siDigestAlgorithm :: DigestAlgorithm
siSignerId :: SignerIdentifier
siUnsignedAttrs :: SignerInfo -> [Attribute]
siSignature :: SignerInfo -> SignatureValue
siSignatureAlg :: SignerInfo -> SignatureAlg
siSignedAttrs :: SignerInfo -> [Attribute]
siDigestAlgorithm :: SignerInfo -> DigestAlgorithm
siSignerId :: SignerInfo -> SignerIdentifier
..} [CertificateChoice]
certs [RevocationInfoChoice]
crls =
case Maybe CertificateChain
getCertificateChain of
Just CertificateChain
chain -> Maybe DateTime -> CertificateChain -> f Bool
validate Maybe DateTime
mSigningTime CertificateChain
chain
Maybe CertificateChain
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
where
getCertificateChain :: Maybe CertificateChain
getCertificateChain = do
(SignedCertificate
cert, [SignedCertificate]
others) <- SignerIdentifier
-> [SignedCertificate]
-> Maybe (SignedCertificate, [SignedCertificate])
findSigner SignerIdentifier
siSignerId [SignedCertificate]
x509Certificates
let pub :: PubKey
pub = Certificate -> PubKey
certPubKey forall a b. (a -> b) -> a -> b
$ forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject forall a b. (a -> b) -> a -> b
$ forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned SignedCertificate
cert
Bool
validSignature <- forall (f :: * -> *). Applicative f => PubKey -> ConsumerOfSI f
withPublicKey PubKey
pub ContentType
ct SignatureValue
msg SignerInfo{[Attribute]
SignatureValue
SignatureAlg
DigestAlgorithm
SignerIdentifier
siUnsignedAttrs :: [Attribute]
siSignature :: SignatureValue
siSignatureAlg :: SignatureAlg
siSignedAttrs :: [Attribute]
siDigestAlgorithm :: DigestAlgorithm
siSignerId :: SignerIdentifier
siUnsignedAttrs :: [Attribute]
siSignature :: SignatureValue
siSignatureAlg :: SignatureAlg
siSignedAttrs :: [Attribute]
siDigestAlgorithm :: DigestAlgorithm
siSignerId :: SignerIdentifier
..} [CertificateChoice]
certs [RevocationInfoChoice]
crls
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
validSignature
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [SignedCertificate] -> CertificateChain
CertificateChain (SignedCertificate
cert forall a. a -> [a] -> [a]
: [SignedCertificate]
others)
mSigningTime :: Maybe DateTime
mSigningTime = [Attribute] -> Maybe DateTime
getSigningTimeAttr [Attribute]
siSignedAttrs
x509Certificates :: [SignedCertificate]
x509Certificates = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CertificateChoice -> Maybe SignedCertificate
asX509 [CertificateChoice]
certs
asX509 :: CertificateChoice -> Maybe SignedCertificate
asX509 (CertificateCertificate SignedCertificate
c) = forall a. a -> Maybe a
Just SignedCertificate
c
asX509 CertificateChoice
_ = forall a. Maybe a
Nothing
data SignedData content = SignedData
{ forall content. SignedData content -> [DigestAlgorithm]
sdDigestAlgorithms :: [DigestAlgorithm]
, forall content. SignedData content -> ContentType
sdContentType :: ContentType
, forall content. SignedData content -> content
sdEncapsulatedContent :: content
, forall content. SignedData content -> [CertificateChoice]
sdCertificates :: [CertificateChoice]
, forall content. SignedData content -> [RevocationInfoChoice]
sdCRLs :: [RevocationInfoChoice]
, forall content. SignedData content -> [SignerInfo]
sdSignerInfos :: [SignerInfo]
}
deriving (Int -> SignedData content -> ShowS
forall content. Show content => Int -> SignedData content -> ShowS
forall content. Show content => [SignedData content] -> ShowS
forall content. Show content => SignedData content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignedData content] -> ShowS
$cshowList :: forall content. Show content => [SignedData content] -> ShowS
show :: SignedData content -> String
$cshow :: forall content. Show content => SignedData content -> String
showsPrec :: Int -> SignedData content -> ShowS
$cshowsPrec :: forall content. Show content => Int -> SignedData content -> ShowS
Show,SignedData content -> SignedData content -> Bool
forall content.
Eq content =>
SignedData content -> SignedData content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignedData content -> SignedData content -> Bool
$c/= :: forall content.
Eq content =>
SignedData content -> SignedData content -> Bool
== :: SignedData content -> SignedData content -> Bool
$c== :: forall content.
Eq content =>
SignedData content -> SignedData content -> Bool
Eq)
instance ProduceASN1Object ASN1P (SignedData (Encap EncapsulatedContent)) where
asn1s :: SignedData (Encap SignatureValue) -> ASN1Stream ASN1P
asn1s SignedData{[RevocationInfoChoice]
[CertificateChoice]
[DigestAlgorithm]
[SignerInfo]
Encap SignatureValue
ContentType
sdSignerInfos :: [SignerInfo]
sdCRLs :: [RevocationInfoChoice]
sdCertificates :: [CertificateChoice]
sdEncapsulatedContent :: Encap SignatureValue
sdContentType :: ContentType
sdDigestAlgorithms :: [DigestAlgorithm]
sdSignerInfos :: forall content. SignedData content -> [SignerInfo]
sdCRLs :: forall content. SignedData content -> [RevocationInfoChoice]
sdCertificates :: forall content. SignedData content -> [CertificateChoice]
sdEncapsulatedContent :: forall content. SignedData content -> content
sdContentType :: forall content. SignedData content -> ContentType
sdDigestAlgorithms :: forall content. SignedData content -> [DigestAlgorithm]
..} =
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream ASN1P
ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
dig forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
ci forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
certs forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
crls forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
sis)
where
ver :: ASN1Stream ASN1P
ver = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
v
dig :: ASN1Stream ASN1P
dig = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Set (forall e. ASN1Elem e => [DigestAlgorithm] -> ASN1Stream e
digestTypesASN1S [DigestAlgorithm]
sdDigestAlgorithms)
ci :: ASN1Stream ASN1P
ci = forall e.
ASN1Elem e =>
ContentType -> Encap SignatureValue -> ASN1Stream e
encapsulatedContentInfoASN1S ContentType
sdContentType Encap SignatureValue
sdEncapsulatedContent
certs :: ASN1Stream ASN1P
certs = forall {t :: * -> *} {e} {a}.
(Foldable t, ASN1Elem e, ProduceASN1Object e (t a)) =>
Int -> t a -> [e] -> [e]
gen Int
0 [CertificateChoice]
sdCertificates
crls :: ASN1Stream ASN1P
crls = forall {t :: * -> *} {e} {a}.
(Foldable t, ASN1Elem e, ProduceASN1Object e (t a)) =>
Int -> t a -> [e] -> [e]
gen Int
1 [RevocationInfoChoice]
sdCRLs
sis :: ASN1Stream ASN1P
sis = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Set (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s [SignerInfo]
sdSignerInfos)
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)
v :: Integer
v | forall a. HasChoiceOther a => a -> Bool
hasChoiceOther [CertificateChoice]
sdCertificates = Integer
5
| forall a. HasChoiceOther a => a -> Bool
hasChoiceOther [RevocationInfoChoice]
sdCRLs = Integer
5
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SignerInfo -> Bool
isVersion3 [SignerInfo]
sdSignerInfos = Integer
3
| ContentType
sdContentType forall a. Eq a => a -> a -> Bool
== ContentType
DataType = Integer
1
| Bool
otherwise = Integer
3
instance ParseASN1Object [ASN1Event] (SignedData (Encap EncapsulatedContent)) where
parse :: ParseASN1 [ASN1Event] (SignedData (Encap SignatureValue))
parse =
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
IntVal Integer
v <- forall e. Monoid e => ParseASN1 e ASN1
getNext
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v forall a. Ord a => a -> a -> Bool
> Integer
5) forall a b. (a -> b) -> a -> b
$
forall e a. String -> ParseASN1 e a
throwParseError (String
"SignedData: parsed invalid version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
v)
[DigestAlgorithm]
dig <- forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Set forall e. Monoid e => ParseASN1 e [DigestAlgorithm]
parseDigestTypes
(ContentType
ct, Encap SignatureValue
bs) <- forall e.
Monoid e =>
ParseASN1 e (ContentType, Encap SignatureValue)
parseEncapsulatedContentInfo
[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
[SignerInfo]
sis <- forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Set forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
forall (m :: * -> *) a. Monad m => a -> m a
return SignedData { sdDigestAlgorithms :: [DigestAlgorithm]
sdDigestAlgorithms = [DigestAlgorithm]
dig
, sdContentType :: ContentType
sdContentType = ContentType
ct
, sdEncapsulatedContent :: Encap SignatureValue
sdEncapsulatedContent = Encap SignatureValue
bs
, sdCertificates :: [CertificateChoice]
sdCertificates = [CertificateChoice]
certs
, sdCRLs :: [RevocationInfoChoice]
sdCRLs = [RevocationInfoChoice]
crls
, sdSignerInfos :: [SignerInfo]
sdSignerInfos = [SignerInfo]
sis
}
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
encapsulatedContentInfoASN1S :: ASN1Elem e => ContentType -> Encap EncapsulatedContent -> ASN1Stream e
encapsulatedContentInfoASN1S :: forall e.
ASN1Elem e =>
ContentType -> Encap SignatureValue -> ASN1Stream e
encapsulatedContentInfoASN1S ContentType
ct Encap SignatureValue
ec = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence ([e] -> [e]
oid forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
cont)
where oid :: [e] -> [e]
oid = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (forall a. OIDable a => a -> OID
getObjectID ContentType
ct)
cont :: [e] -> [e]
cont = forall e.
ASN1Elem e =>
ASN1ConstructionType -> Encap SignatureValue -> ASN1Stream e
encapsulatedASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) Encap SignatureValue
ec
encapsulatedASN1S :: ASN1Elem e
=> ASN1ConstructionType -> Encap B.ByteString -> ASN1Stream e
encapsulatedASN1S :: forall e.
ASN1Elem e =>
ASN1ConstructionType -> Encap SignatureValue -> ASN1Stream e
encapsulatedASN1S ASN1ConstructionType
_ Encap SignatureValue
Detached = forall a. a -> a
id
encapsulatedASN1S ASN1ConstructionType
ty (Attached SignatureValue
bs) = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
ty (forall e. ASN1Elem e => SignatureValue -> ASN1Stream e
gOctetString SignatureValue
bs)
parseEncapsulatedContentInfo :: Monoid e => ParseASN1 e (ContentType, Encap EncapsulatedContent)
parseEncapsulatedContentInfo :: forall e.
Monoid e =>
ParseASN1 e (ContentType, Encap SignatureValue)
parseEncapsulatedContentInfo =
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
OID OID
oid <- forall e. Monoid e => ParseASN1 e ASN1
getNext
forall a e b.
OIDNameable a =>
String -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID String
"content type" OID
oid forall a b. (a -> b) -> a -> b
$ \ContentType
ct ->
forall {a} {a}. a -> Maybe a -> (a, Encap a)
wrap ContentType
ct 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
0) forall e. Monoid e => ParseASN1 e SignatureValue
parseOctetString
where
wrap :: a -> Maybe a -> (a, Encap a)
wrap a
ct Maybe a
Nothing = (a
ct, forall a. Encap a
Detached)
wrap a
ct (Just a
c) = (a
ct, forall a. a -> Encap a
Attached a
c)
digestTypesASN1S :: ASN1Elem e => [DigestAlgorithm] -> ASN1Stream e
digestTypesASN1S :: forall e. ASN1Elem e => [DigestAlgorithm] -> ASN1Stream e
digestTypesASN1S [DigestAlgorithm]
list [e]
cont = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence) [e]
cont [DigestAlgorithm]
list
parseDigestTypes :: Monoid e => ParseASN1 e [DigestAlgorithm]
parseDigestTypes :: forall e. Monoid e => ParseASN1 e [DigestAlgorithm]
parseDigestTypes = forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany (forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)