-- |
-- 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
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) 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 =
    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 =>
(Maybe DateTime -> CertificateChain -> f Bool) -> ConsumerOfSI f
withSignerCertificate (\Maybe DateTime
_ 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
                      => (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

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