-- |
-- Module      : Crypto.Store.CMS.Signed
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
--
{-# 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

-- | Encapsulated content.
type EncapsulatedContent = ByteString

-- | Information related to a signer of a 'Crypto.Store.CMS.SignedData'.  An
-- element contains the signature material that was produced.
data SignerInfo = SignerInfo
    { SignerInfo -> SignerIdentifier
siSignerId :: SignerIdentifier
      -- ^ Identifier of the signer certificate
    , SignerInfo -> DigestAlgorithm
siDigestAlgorithm :: DigestAlgorithm
      -- ^ Digest algorithm used for the signature
    , SignerInfo -> [Attribute]
siSignedAttrs :: [Attribute]
      -- ^ Optional signed attributes
    , SignerInfo -> SignatureAlg
siSignatureAlg :: SignatureAlg
      -- ^ Algorithm used for signature
    , SignerInfo -> SignatureValue
siSignature :: SignatureValue
      -- ^ The signature value
    , SignerInfo -> [Attribute]
siUnsignedAttrs :: [Attribute]
      -- ^ Optional unsigned attributes
    }
    deriving (Int -> SignerInfo -> ShowS
[SignerInfo] -> ShowS
SignerInfo -> String
(Int -> SignerInfo -> ShowS)
-> (SignerInfo -> String)
-> ([SignerInfo] -> ShowS)
-> Show SignerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignerInfo -> ShowS
showsPrec :: Int -> SignerInfo -> ShowS
$cshow :: SignerInfo -> String
show :: SignerInfo -> String
$cshowList :: [SignerInfo] -> ShowS
showList :: [SignerInfo] -> ShowS
Show,SignerInfo -> SignerInfo -> Bool
(SignerInfo -> SignerInfo -> Bool)
-> (SignerInfo -> SignerInfo -> Bool) -> Eq SignerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignerInfo -> SignerInfo -> Bool
== :: SignerInfo -> SignerInfo -> Bool
$c/= :: SignerInfo -> SignerInfo -> Bool
/= :: SignerInfo -> SignerInfo -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e SignerInfo where
    asn1s :: SignerInfo -> ASN1Stream e
asn1s SignerInfo{[Attribute]
SignatureValue
SignatureAlg
DigestAlgorithm
SignerIdentifier
siSignerId :: SignerInfo -> SignerIdentifier
siDigestAlgorithm :: SignerInfo -> DigestAlgorithm
siSignedAttrs :: SignerInfo -> [Attribute]
siSignatureAlg :: SignerInfo -> SignatureAlg
siSignature :: SignerInfo -> SignatureValue
siUnsignedAttrs :: SignerInfo -> [Attribute]
siSignerId :: SignerIdentifier
siDigestAlgorithm :: DigestAlgorithm
siSignedAttrs :: [Attribute]
siSignatureAlg :: SignatureAlg
siSignature :: SignatureValue
siUnsignedAttrs :: [Attribute]
..} =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
ver ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
sid ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
dig ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
sa ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
alg ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
sig ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ua)
      where
        ver :: ASN1Stream e
ver = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (SignerIdentifier -> Integer
getVersion SignerIdentifier
siSignerId)
        sid :: ASN1Stream e
sid = SignerIdentifier -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s SignerIdentifier
siSignerId
        dig :: ASN1Stream e
dig = ASN1ConstructionType -> DigestAlgorithm -> ASN1Stream e
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
siDigestAlgorithm
        sa :: ASN1Stream e
sa  = ASN1ConstructionType -> [Attribute] -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) [Attribute]
siSignedAttrs
        alg :: ASN1Stream e
alg = ASN1ConstructionType -> SignatureAlg -> ASN1Stream e
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence SignatureAlg
siSignatureAlg
        sig :: ASN1Stream e
sig = SignatureValue -> ASN1Stream e
forall e. ASN1Elem e => SignatureValue -> ASN1Stream e
gOctetString SignatureValue
siSignature
        ua :: ASN1Stream e
ua  = ASN1ConstructionType -> [Attribute] -> ASN1Stream e
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 = ASN1ConstructionType
-> ParseASN1 e SignerInfo -> ParseASN1 e SignerInfo
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e SignerInfo -> ParseASN1 e SignerInfo)
-> ParseASN1 e SignerInfo -> ParseASN1 e SignerInfo
forall a b. (a -> b) -> a -> b
$ do
        IntVal Integer
v <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        Bool -> ParseASN1 e () -> ParseASN1 e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1 Bool -> Bool -> Bool
&& Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
3) (ParseASN1 e () -> ParseASN1 e ())
-> ParseASN1 e () -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$
            String -> ParseASN1 e ()
forall e a. String -> ParseASN1 e a
throwParseError (String
"SignerInfo: parsed invalid version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
v)
        SignerIdentifier
sid <- ParseASN1 e SignerIdentifier
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        DigestAlgorithm
dig <- ASN1ConstructionType -> ParseASN1 e DigestAlgorithm
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
        [Attribute]
sAttrs <- ASN1ConstructionType -> ParseASN1 e [Attribute]
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
        SignatureAlg
alg <- ASN1ConstructionType -> ParseASN1 e SignatureAlg
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
        OctetString SignatureValue
sig <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        [Attribute]
uAttrs <- ASN1ConstructionType -> ParseASN1 e [Attribute]
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
        SignerInfo -> ParseASN1 e SignerInfo
forall a. a -> ParseASN1 e a
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

-- | Return true when the signer info has version 3.
isVersion3 :: SignerInfo -> Bool
isVersion3 :: SignerInfo -> Bool
isVersion3 = (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3) (Integer -> Bool) -> (SignerInfo -> Integer) -> SignerInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignerIdentifier -> Integer
getVersion (SignerIdentifier -> Integer)
-> (SignerInfo -> SignerIdentifier) -> SignerInfo -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignerInfo -> SignerIdentifier
siSignerId

-- | Union type related to identification of the signer certificate.
data SignerIdentifier
    = SignerIASN IssuerAndSerialNumber  -- ^ Issuer and Serial Number
    | SignerSKI  ByteString             -- ^ Subject Key Identifier
    deriving (Int -> SignerIdentifier -> ShowS
[SignerIdentifier] -> ShowS
SignerIdentifier -> String
(Int -> SignerIdentifier -> ShowS)
-> (SignerIdentifier -> String)
-> ([SignerIdentifier] -> ShowS)
-> Show SignerIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignerIdentifier -> ShowS
showsPrec :: Int -> SignerIdentifier -> ShowS
$cshow :: SignerIdentifier -> String
show :: SignerIdentifier -> String
$cshowList :: [SignerIdentifier] -> ShowS
showList :: [SignerIdentifier] -> ShowS
Show,SignerIdentifier -> SignerIdentifier -> Bool
(SignerIdentifier -> SignerIdentifier -> Bool)
-> (SignerIdentifier -> SignerIdentifier -> Bool)
-> Eq SignerIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignerIdentifier -> SignerIdentifier -> Bool
== :: SignerIdentifier -> SignerIdentifier -> Bool
$c/= :: SignerIdentifier -> SignerIdentifier -> Bool
/= :: SignerIdentifier -> SignerIdentifier -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e SignerIdentifier where
    asn1s :: SignerIdentifier -> ASN1Stream e
asn1s (SignerIASN IssuerAndSerialNumber
iasn) = IssuerAndSerialNumber -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s IssuerAndSerialNumber
iasn
    asn1s (SignerSKI  SignatureValue
ski)  = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                                  (SignatureValue -> ASN1Stream e
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 ParseASN1 e SignerIdentifier
-> ParseASN1 e SignerIdentifier -> ParseASN1 e SignerIdentifier
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e SignerIdentifier
parseSKI
      where parseIASN :: ParseASN1 e SignerIdentifier
parseIASN = IssuerAndSerialNumber -> SignerIdentifier
SignerIASN (IssuerAndSerialNumber -> SignerIdentifier)
-> ParseASN1 e IssuerAndSerialNumber
-> ParseASN1 e SignerIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e IssuerAndSerialNumber
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            parseSKI :: ParseASN1 e SignerIdentifier
parseSKI  = SignatureValue -> SignerIdentifier
SignerSKI  (SignatureValue -> SignerIdentifier)
-> ParseASN1 e SignatureValue -> ParseASN1 e SignerIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                ASN1ConstructionType
-> ParseASN1 e SignatureValue -> ParseASN1 e SignatureValue
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ParseASN1 e SignatureValue
forall e. Monoid e => ParseASN1 e SignatureValue
parseOctetStringPrim

-- | Try to find a certificate with the specified identifier.
findSigner :: SignerIdentifier
           -> [SignedCertificate]
           -> Maybe (SignedCertificate, [SignedCertificate])
findSigner :: SignerIdentifier
-> [SignedCertificate]
-> Maybe (SignedCertificate, [SignedCertificate])
findSigner (SignerIASN IssuerAndSerialNumber
iasn) [SignedCertificate]
certs =
    (SignedCertificate -> Bool)
-> [SignedCertificate]
-> Maybe (SignedCertificate, [SignedCertificate])
forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
partitionHead (Certificate -> Bool
matchIASN (Certificate -> Bool)
-> (SignedCertificate -> Certificate) -> SignedCertificate -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed Certificate -> Certificate
forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject (Signed Certificate -> Certificate)
-> (SignedCertificate -> Signed Certificate)
-> SignedCertificate
-> Certificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> Signed Certificate
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) (DistinguishedName, Integer)
-> (DistinguishedName, Integer) -> Bool
forall a. Eq a => a -> a -> Bool
== (Certificate -> DistinguishedName
certIssuerDN Certificate
c, Certificate -> Integer
certSerial Certificate
c)
findSigner (SignerSKI  SignatureValue
ski) [SignedCertificate]
certs =
    (SignedCertificate -> Bool)
-> [SignedCertificate]
-> Maybe (SignedCertificate, [SignedCertificate])
forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
partitionHead (Certificate -> Bool
matchSKI(Certificate -> Bool)
-> (SignedCertificate -> Certificate) -> SignedCertificate -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed Certificate -> Certificate
forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject (Signed Certificate -> Certificate)
-> (SignedCertificate -> Signed Certificate)
-> SignedCertificate
-> Certificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> Signed Certificate
forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned) [SignedCertificate]
certs
  where
    matchSKI :: Certificate -> Bool
matchSKI Certificate
c =
        case Extensions -> Maybe ExtSubjectKeyId
forall a. Extension a => Extensions -> Maybe a
extensionGet (Certificate -> Extensions
certExtensions Certificate
c) of
            Just (ExtSubjectKeyId SignatureValue
idBs) -> SignatureValue
idBs SignatureValue -> SignatureValue -> Bool
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 (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
p [a]
l of
        (a
x : [a]
_, [a]
r) -> (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x, [a]
r)
        ([]   , [a]
_)    -> Maybe (a, [a])
forall a. Maybe a
Nothing

-- | Function able to produce a 'SignerInfo'.
type ProducerOfSI m = ContentType -> ByteString -> m (Either StoreError (SignerInfo, [CertificateChoice], [RevocationInfoChoice]))

-- | Function able to consume a 'SignerInfo'.
type ConsumerOfSI m = ContentType -> ByteString -> SignerInfo -> [CertificateChoice] -> [RevocationInfoChoice] -> m Bool

-- | Create a signer info with the specified signature algorithm and
-- credentials.
--
-- Two lists of optional attributes can be provided.  The attributes will be
-- part of message signature when provided in the first list.
--
-- When the first list of attributes is provided, even empty list, signature is
-- computed from a digest of the content.  When the list of attributes is
-- 'Nothing', no intermediate digest is used and the signature is computed from
-- the full message.
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
_ PrivKey
_ (CertificateChain []) Maybe [Attribute]
_ [Attribute]
_ ContentType
_ SignatureValue
_ =
    Either
  StoreError
  (SignerInfo, [CertificateChoice], [RevocationInfoChoice])
-> m (Either
        StoreError
        (SignerInfo, [CertificateChoice], [RevocationInfoChoice]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   StoreError
   (SignerInfo, [CertificateChoice], [RevocationInfoChoice])
 -> m (Either
         StoreError
         (SignerInfo, [CertificateChoice], [RevocationInfoChoice])))
-> Either
     StoreError
     (SignerInfo, [CertificateChoice], [RevocationInfoChoice])
-> m (Either
        StoreError
        (SignerInfo, [CertificateChoice], [RevocationInfoChoice]))
forall a b. (a -> b) -> a -> b
$ StoreError
-> Either
     StoreError
     (SignerInfo, [CertificateChoice], [RevocationInfoChoice])
forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Empty certificate chain")
certSigner SignatureAlg
alg PrivKey
priv (CertificateChain chain :: [SignedCertificate]
chain@(SignedCertificate
cert:[SignedCertificate]
_)) Maybe [Attribute]
sAttrsM [Attribute]
uAttrs ContentType
ct SignatureValue
msg =
    (SignatureValue
 -> (SignerInfo, [CertificateChoice], [RevocationInfoChoice]))
-> Either StoreError SignatureValue
-> Either
     StoreError
     (SignerInfo, [CertificateChoice], [RevocationInfoChoice])
forall a b. (a -> b) -> Either StoreError a -> Either StoreError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SignatureValue
-> (SignerInfo, [CertificateChoice], [RevocationInfoChoice])
forall {a}.
SignatureValue -> (SignerInfo, [CertificateChoice], [a])
build (Either StoreError SignatureValue
 -> Either
      StoreError
      (SignerInfo, [CertificateChoice], [RevocationInfoChoice]))
-> m (Either StoreError SignatureValue)
-> m (Either
        StoreError
        (SignerInfo, [CertificateChoice], [RevocationInfoChoice]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Either StoreError SignatureValue)
generate
  where
    md :: SignatureValue
md   = DigestAlgorithm -> SignatureValue -> SignatureValue
forall message.
ByteArrayAccess message =>
DigestAlgorithm -> message -> SignatureValue
digest DigestAlgorithm
dig SignatureValue
msg
    def :: DigestAlgorithm
def  = DigestProxy SHA256 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
Crypto.Store.CMS.Algorithms.SHA256
    obj :: Certificate
obj  = Signed Certificate -> Certificate
forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject (SignedCertificate -> Signed Certificate
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          = [Attribute] -> Bool
forall a. [a] -> Bool
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 ([Attribute] -> [Attribute]) -> [Attribute] -> [Attribute]
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  = SignatureAlg
-> PrivKey
-> PubKey
-> SignatureValue
-> m (Either StoreError SignatureValue)
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, (SignedCertificate -> CertificateChoice)
-> [SignedCertificate] -> [CertificateChoice]
forall a b. (a -> b) -> [a] -> [b]
map SignedCertificate -> CertificateChoice
CertificateCertificate [SignedCertificate]
chain, [])

-- | Verify that the signature was produced from the specified public key.
-- Ignores all certificates and CRLs contained in the signed data.
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
siSignerId :: SignerInfo -> SignerIdentifier
siDigestAlgorithm :: SignerInfo -> DigestAlgorithm
siSignedAttrs :: SignerInfo -> [Attribute]
siSignatureAlg :: SignerInfo -> SignatureAlg
siSignature :: SignerInfo -> SignatureValue
siUnsignedAttrs :: SignerInfo -> [Attribute]
siSignerId :: SignerIdentifier
siDigestAlgorithm :: DigestAlgorithm
siSignedAttrs :: [Attribute]
siSignatureAlg :: SignatureAlg
siSignature :: SignatureValue
siUnsignedAttrs :: [Attribute]
..} [CertificateChoice]
_ [RevocationInfoChoice]
_ = Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> f Bool) -> Bool -> f Bool
forall a b. (a -> b) -> a -> b
$
    Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
noAttr Bool -> Bool -> Bool
|| Bool
attrMatch)
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
mdAccept
        SignatureAlg
alg <- DigestAlgorithm -> SignatureAlg -> Maybe SignatureAlg
signatureCheckHash DigestAlgorithm
siDigestAlgorithm SignatureAlg
siSignatureAlg
        Bool -> Maybe Bool
forall a. a -> Maybe a
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    = [Attribute] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
siSignedAttrs
    mdMatch :: Bool
mdMatch   = Maybe SignatureValue
mdAttr Maybe SignatureValue -> Maybe SignatureValue -> Bool
forall a. Eq a => a -> a -> Bool
== SignatureValue -> Maybe SignatureValue
forall a. a -> Maybe a
Just (DigestAlgorithm -> SignatureValue -> SignatureValue
forall message.
ByteArrayAccess message =>
DigestAlgorithm -> message -> SignatureValue
digest DigestAlgorithm
siDigestAlgorithm SignatureValue
msg)
    attrMatch :: Bool
attrMatch = Maybe ContentType
ctAttr Maybe ContentType -> Maybe ContentType -> Bool
forall a. Eq a => a -> a -> Bool
== ContentType -> Maybe ContentType
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  = DigestAlgorithm -> Bool
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

-- | Verify that the signature is valid with one of the X.509 certificates
-- contained in the signed data, but does not validate that the certificates are
-- valid.  All transmitted certificates are implicitely trusted and all CRLs are
-- ignored.
withSignerKey :: Applicative f => ConsumerOfSI f
withSignerKey :: forall (f :: * -> *). Applicative f => ConsumerOfSI f
withSignerKey = (Maybe DateTime -> CertificateChain -> f Bool) -> ConsumerOfSI f
forall (f :: * -> *).
Applicative f =>
(Maybe DateTime -> CertificateChain -> f Bool) -> ConsumerOfSI f
withSignerCertificate (\Maybe DateTime
_ CertificateChain
_ -> Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)

-- | Verify that the signature is valid with one of the X.509 certificates
-- contained in the signed data, and verify that the signer certificate is valid
-- using the validation function supplied.  All CRLs are ignored.
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
siSignerId :: SignerInfo -> SignerIdentifier
siDigestAlgorithm :: SignerInfo -> DigestAlgorithm
siSignedAttrs :: SignerInfo -> [Attribute]
siSignatureAlg :: SignerInfo -> SignatureAlg
siSignature :: SignerInfo -> SignatureValue
siUnsignedAttrs :: SignerInfo -> [Attribute]
siSignerId :: SignerIdentifier
siDigestAlgorithm :: DigestAlgorithm
siSignedAttrs :: [Attribute]
siSignatureAlg :: SignatureAlg
siSignature :: SignatureValue
siUnsignedAttrs :: [Attribute]
..} [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    -> Bool -> f Bool
forall a. a -> f a
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 (Certificate -> PubKey) -> Certificate -> PubKey
forall a b. (a -> b) -> a -> b
$ Signed Certificate -> Certificate
forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject (Signed Certificate -> Certificate)
-> Signed Certificate -> Certificate
forall a b. (a -> b) -> a -> b
$ SignedCertificate -> Signed Certificate
forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned SignedCertificate
cert
        Bool
validSignature <- PubKey -> ConsumerOfSI Maybe
forall (f :: * -> *). Applicative f => PubKey -> ConsumerOfSI f
withPublicKey PubKey
pub ContentType
ct SignatureValue
msg SignerInfo{[Attribute]
SignatureValue
SignatureAlg
DigestAlgorithm
SignerIdentifier
siSignerId :: SignerIdentifier
siDigestAlgorithm :: DigestAlgorithm
siSignedAttrs :: [Attribute]
siSignatureAlg :: SignatureAlg
siSignature :: SignatureValue
siUnsignedAttrs :: [Attribute]
siSignerId :: SignerIdentifier
siDigestAlgorithm :: DigestAlgorithm
siSignedAttrs :: [Attribute]
siSignatureAlg :: SignatureAlg
siSignature :: SignatureValue
siUnsignedAttrs :: [Attribute]
..} [CertificateChoice]
certs [RevocationInfoChoice]
crls
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
validSignature
        CertificateChain -> Maybe CertificateChain
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (CertificateChain -> Maybe CertificateChain)
-> CertificateChain -> Maybe CertificateChain
forall a b. (a -> b) -> a -> b
$ [SignedCertificate] -> CertificateChain
CertificateChain (SignedCertificate
cert SignedCertificate -> [SignedCertificate] -> [SignedCertificate]
forall a. a -> [a] -> [a]
: [SignedCertificate]
others)

    mSigningTime :: Maybe DateTime
mSigningTime = [Attribute] -> Maybe DateTime
getSigningTimeAttr [Attribute]
siSignedAttrs

    x509Certificates :: [SignedCertificate]
x509Certificates = (CertificateChoice -> Maybe SignedCertificate)
-> [CertificateChoice] -> [SignedCertificate]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CertificateChoice -> Maybe SignedCertificate
asX509 [CertificateChoice]
certs

    asX509 :: CertificateChoice -> Maybe SignedCertificate
asX509 (CertificateCertificate SignedCertificate
c) = SignedCertificate -> Maybe SignedCertificate
forall a. a -> Maybe a
Just SignedCertificate
c
    asX509 CertificateChoice
_                          = Maybe SignedCertificate
forall a. Maybe a
Nothing

-- | Signed content information.
data SignedData content = SignedData
    { forall content. SignedData content -> [DigestAlgorithm]
sdDigestAlgorithms :: [DigestAlgorithm]      -- ^ Digest algorithms
    , forall content. SignedData content -> ContentType
sdContentType :: ContentType                 -- ^ Inner content type
    , forall content. SignedData content -> content
sdEncapsulatedContent :: content             -- ^ Encapsulated content
    , forall content. SignedData content -> [CertificateChoice]
sdCertificates :: [CertificateChoice]        -- ^ The collection of certificates
    , forall content. SignedData content -> [RevocationInfoChoice]
sdCRLs  :: [RevocationInfoChoice]            -- ^ The collection of CRLs
    , forall content. SignedData content -> [SignerInfo]
sdSignerInfos :: [SignerInfo]                -- ^ Per-signer information
    }
    deriving (Int -> SignedData content -> ShowS
[SignedData content] -> ShowS
SignedData content -> String
(Int -> SignedData content -> ShowS)
-> (SignedData content -> String)
-> ([SignedData content] -> ShowS)
-> Show (SignedData content)
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
$cshowsPrec :: forall content. Show content => Int -> SignedData content -> ShowS
showsPrec :: Int -> SignedData content -> ShowS
$cshow :: forall content. Show content => SignedData content -> String
show :: SignedData content -> String
$cshowList :: forall content. Show content => [SignedData content] -> ShowS
showList :: [SignedData content] -> ShowS
Show,SignedData content -> SignedData content -> Bool
(SignedData content -> SignedData content -> Bool)
-> (SignedData content -> SignedData content -> Bool)
-> Eq (SignedData content)
forall content.
Eq content =>
SignedData content -> SignedData content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: 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
sdDigestAlgorithms :: forall content. SignedData content -> [DigestAlgorithm]
sdContentType :: forall content. SignedData content -> ContentType
sdEncapsulatedContent :: forall content. SignedData content -> content
sdCertificates :: forall content. SignedData content -> [CertificateChoice]
sdCRLs :: forall content. SignedData content -> [RevocationInfoChoice]
sdSignerInfos :: forall content. SignedData content -> [SignerInfo]
sdDigestAlgorithms :: [DigestAlgorithm]
sdContentType :: ContentType
sdEncapsulatedContent :: Encap SignatureValue
sdCertificates :: [CertificateChoice]
sdCRLs :: [RevocationInfoChoice]
sdSignerInfos :: [SignerInfo]
..} =
        ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream ASN1P
ver ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
dig ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
ci ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
certs ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
crls ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
sis)
      where
        ver :: ASN1Stream ASN1P
ver = Integer -> ASN1Stream ASN1P
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
v
        dig :: ASN1Stream ASN1P
dig = ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Set ([DigestAlgorithm] -> ASN1Stream ASN1P
forall e. ASN1Elem e => [DigestAlgorithm] -> ASN1Stream e
digestTypesASN1S [DigestAlgorithm]
sdDigestAlgorithms)
        ci :: ASN1Stream ASN1P
ci  = ContentType -> Encap SignatureValue -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ContentType -> Encap SignatureValue -> ASN1Stream e
encapsulatedContentInfoASN1S ContentType
sdContentType Encap SignatureValue
sdEncapsulatedContent
        certs :: ASN1Stream ASN1P
certs = Int -> [CertificateChoice] -> ASN1Stream ASN1P
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  = Int -> [RevocationInfoChoice] -> ASN1Stream ASN1P
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 = ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Set ([SignerInfo] -> ASN1Stream ASN1P
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s [SignerInfo]
sdSignerInfos)

        gen :: Int -> t a -> [e] -> [e]
gen Int
tag t a
list
            | t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
list = [e] -> [e]
forall a. a -> a
id
            | Bool
otherwise = ASN1ConstructionType -> ([e] -> [e]) -> [e] -> [e]
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
tag) (t a -> [e] -> [e]
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s t a
list)

        v :: Integer
v | [CertificateChoice] -> Bool
forall a. HasChoiceOther a => a -> Bool
hasChoiceOther [CertificateChoice]
sdCertificates = Integer
5
          | [RevocationInfoChoice] -> Bool
forall a. HasChoiceOther a => a -> Bool
hasChoiceOther [RevocationInfoChoice]
sdCRLs         = Integer
5
          | (SignerInfo -> Bool) -> [SignerInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SignerInfo -> Bool
isVersion3 [SignerInfo]
sdSignerInfos  = Integer
3
          | ContentType
sdContentType ContentType -> ContentType -> Bool
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 =
        ASN1ConstructionType
-> ParseASN1 [ASN1Event] (SignedData (Encap SignatureValue))
-> ParseASN1 [ASN1Event] (SignedData (Encap SignatureValue))
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 [ASN1Event] (SignedData (Encap SignatureValue))
 -> ParseASN1 [ASN1Event] (SignedData (Encap SignatureValue)))
-> ParseASN1 [ASN1Event] (SignedData (Encap SignatureValue))
-> ParseASN1 [ASN1Event] (SignedData (Encap SignatureValue))
forall a b. (a -> b) -> a -> b
$ do
            IntVal Integer
v <- ParseASN1 [ASN1Event] ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            Bool -> ParseASN1 [ASN1Event] () -> ParseASN1 [ASN1Event] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
5) (ParseASN1 [ASN1Event] () -> ParseASN1 [ASN1Event] ())
-> ParseASN1 [ASN1Event] () -> ParseASN1 [ASN1Event] ()
forall a b. (a -> b) -> a -> b
$
                String -> ParseASN1 [ASN1Event] ()
forall e a. String -> ParseASN1 e a
throwParseError (String
"SignedData: parsed invalid version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
v)
            [DigestAlgorithm]
dig <- ASN1ConstructionType
-> ParseASN1 [ASN1Event] [DigestAlgorithm]
-> ParseASN1 [ASN1Event] [DigestAlgorithm]
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Set ParseASN1 [ASN1Event] [DigestAlgorithm]
forall e. Monoid e => ParseASN1 e [DigestAlgorithm]
parseDigestTypes
            (ContentType
ct, Encap SignatureValue
bs) <- ParseASN1 [ASN1Event] (ContentType, Encap SignatureValue)
forall e.
Monoid e =>
ParseASN1 e (ContentType, Encap SignatureValue)
parseEncapsulatedContentInfo
            [CertificateChoice]
certs <- Int -> ParseASN1 [ASN1Event] [CertificateChoice]
forall {e} {a}. ParseASN1Object e a => Int -> ParseASN1 e [a]
parseOptList Int
0
            [RevocationInfoChoice]
crls  <- Int -> ParseASN1 [ASN1Event] [RevocationInfoChoice]
forall {e} {a}. ParseASN1Object e a => Int -> ParseASN1 e [a]
parseOptList Int
1
            [SignerInfo]
sis <- ASN1ConstructionType
-> ParseASN1 [ASN1Event] [SignerInfo]
-> ParseASN1 [ASN1Event] [SignerInfo]
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Set ParseASN1 [ASN1Event] [SignerInfo]
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            SignedData (Encap SignatureValue)
-> ParseASN1 [ASN1Event] (SignedData (Encap SignatureValue))
forall a. a -> ParseASN1 [ASN1Event] a
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 =
            [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [a] -> [a]) -> ParseASN1 e (Maybe [a]) -> ParseASN1 e [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType -> ParseASN1 e [a] -> ParseASN1 e (Maybe [a])
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
tag) ParseASN1 e [a]
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse

-- | Generate ASN.1 for EncapsulatedContentInfo.
encapsulatedContentInfoASN1S :: ASN1Elem e => ContentType -> Encap EncapsulatedContent -> ASN1Stream e
encapsulatedContentInfoASN1S :: forall e.
ASN1Elem e =>
ContentType -> Encap SignatureValue -> ASN1Stream e
encapsulatedContentInfoASN1S ContentType
ct Encap SignatureValue
ec = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
cont)
  where oid :: ASN1Stream e
oid = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (ContentType -> OID
forall a. OIDable a => a -> OID
getObjectID ContentType
ct)
        cont :: ASN1Stream e
cont = ASN1ConstructionType -> Encap SignatureValue -> ASN1Stream e
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     = [e] -> [e]
forall a. a -> a
id
encapsulatedASN1S ASN1ConstructionType
ty (Attached SignatureValue
bs) = ASN1ConstructionType -> ([e] -> [e]) -> [e] -> [e]
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
ty (SignatureValue -> [e] -> [e]
forall e. ASN1Elem e => SignatureValue -> ASN1Stream e
gOctetString SignatureValue
bs)

-- | Parse EncapsulatedContentInfo from ASN.1.
parseEncapsulatedContentInfo :: Monoid e => ParseASN1 e (ContentType, Encap EncapsulatedContent)
parseEncapsulatedContentInfo :: forall e.
Monoid e =>
ParseASN1 e (ContentType, Encap SignatureValue)
parseEncapsulatedContentInfo =
    ASN1ConstructionType
-> ParseASN1 e (ContentType, Encap SignatureValue)
-> ParseASN1 e (ContentType, Encap SignatureValue)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (ContentType, Encap SignatureValue)
 -> ParseASN1 e (ContentType, Encap SignatureValue))
-> ParseASN1 e (ContentType, Encap SignatureValue)
-> ParseASN1 e (ContentType, Encap SignatureValue)
forall a b. (a -> b) -> a -> b
$ do
        OID OID
oid <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        String
-> OID
-> (ContentType -> ParseASN1 e (ContentType, Encap SignatureValue))
-> ParseASN1 e (ContentType, Encap SignatureValue)
forall a e b.
OIDNameable a =>
String -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID String
"content type" OID
oid ((ContentType -> ParseASN1 e (ContentType, Encap SignatureValue))
 -> ParseASN1 e (ContentType, Encap SignatureValue))
-> (ContentType -> ParseASN1 e (ContentType, Encap SignatureValue))
-> ParseASN1 e (ContentType, Encap SignatureValue)
forall a b. (a -> b) -> a -> b
$ \ContentType
ct ->
            ContentType
-> Maybe SignatureValue -> (ContentType, Encap SignatureValue)
forall {a} {a}. a -> Maybe a -> (a, Encap a)
wrap ContentType
ct (Maybe SignatureValue -> (ContentType, Encap SignatureValue))
-> ParseASN1 e (Maybe SignatureValue)
-> ParseASN1 e (ContentType, Encap SignatureValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType
-> ParseASN1 e SignatureValue -> ParseASN1 e (Maybe SignatureValue)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ParseASN1 e SignatureValue
forall e. Monoid e => ParseASN1 e SignatureValue
parseOctetString
  where
    wrap :: a -> Maybe a -> (a, Encap a)
wrap a
ct Maybe a
Nothing  = (a
ct, Encap a
forall a. Encap a
Detached)
    wrap a
ct (Just a
c) = (a
ct, a -> Encap a
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 = (DigestAlgorithm -> [e] -> [e]) -> [e] -> [DigestAlgorithm] -> [e]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ASN1ConstructionType -> DigestAlgorithm -> [e] -> [e]
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 = ParseASN1 e DigestAlgorithm -> ParseASN1 e [DigestAlgorithm]
forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany (ASN1ConstructionType -> ParseASN1 e DigestAlgorithm
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)