-- |
-- 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.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
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

-- | Return true when the signer info has version 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

-- | 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
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) ParseASN1 e SignatureValue
parseBS
            parseBS :: ParseASN1 e SignatureValue
parseBS = do { OctetString SignatureValue
bs <- forall e. Monoid e => ParseASN1 e ASN1
getNext; forall (m :: * -> *) a. Monad m => a -> m a
return SignatureValue
bs }

-- | 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 =
    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

-- | 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
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, [])

-- | 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
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

-- | 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 = forall (f :: * -> *).
Applicative f =>
(CertificateChain -> f Bool) -> ConsumerOfSI f
withSignerCertificate (\CertificateChain
_ -> 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
                      => (CertificateChain -> f Bool) -> ConsumerOfSI f
withSignerCertificate :: forall (f :: * -> *).
Applicative f =>
(CertificateChain -> f Bool) -> ConsumerOfSI f
withSignerCertificate 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 -> CertificateChain -> f Bool
validate 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)

    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

-- | 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
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

-- | 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 = 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)

-- | Parse EncapsulatedContentInfo from ASN.1.
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) ParseASN1 e SignatureValue
parseInner
  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)

    parseInner :: ParseASN1 e SignatureValue
parseInner = ParseASN1 e SignatureValue
parseContentSingle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e SignatureValue
parseContentChunks

    parseContentSingle :: ParseASN1 e SignatureValue
parseContentSingle = do { OctetString SignatureValue
bs <- forall e. Monoid e => ParseASN1 e ASN1
getNext; forall (m :: * -> *) a. Monad m => a -> m a
return SignatureValue
bs }
    parseContentChunks :: ParseASN1 e SignatureValue
parseContentChunks = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Universal Int
4) forall a b. (a -> b) -> a -> b
$
        [SignatureValue] -> SignatureValue
B.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany ParseASN1 e SignatureValue
parseContentSingle

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)