-- |
-- Module      : Crypto.Store.CMS
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- Cryptographic Message Syntax
--
-- * <https://tools.ietf.org/html/rfc5652 RFC 5652>: Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc3370 RFC 3370>: Cryptographic Message Syntax (CMS) Algorithms
-- * <https://tools.ietf.org/html/rfc3560 RFC 3560>: Use of the RSAES-OAEP Key Transport Algorithm in the Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc4056 RFC 4056>: Use of the RSASSA-PSS Signature Algorithm in Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc3565 RFC 3565>: Use of the Advanced Encryption Standard (AES) Encryption Algorithm in Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc5753 RFC 5753>: Use of Elliptic Curve Cryptography (ECC) Algorithms in Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc5754 RFC 5754>: Using SHA2 Algorithms with Cryptographic Message Syntax
-- * <https://tools.ietf.org/html/rfc3211 RFC 3211>: Password-based Encryption for CMS
-- * <https://tools.ietf.org/html/rfc5083 RFC 5083>: Cryptographic Message Syntax (CMS) Authenticated-Enveloped-Data Content Type
-- * <https://tools.ietf.org/html/rfc5084 RFC 5084>: Using AES-CCM and AES-GCM Authenticated Encryption in the Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc6476 RFC 6476>: Using Message Authentication Code (MAC) Encryption in the Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc8103 RFC 8103>: Using ChaCha20-Poly1305 Authenticated Encryption in the Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc8418 RFC 8418>: Use of the Elliptic Curve Diffie-Hellman Key Agreement Algorithm with X25519 and X448 in the Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc8419 RFC 8419>: Use of Edwards-Curve Digital Signature Algorithm (EdDSA) Signatures in the Cryptographic Message Syntax (CMS)
-- * <https://tools.ietf.org/html/rfc8702 RFC 8702>: Use of the SHAKE One-Way Hash Functions in the Cryptographic Message Syntax (CMS)
{-# LANGUAGE RecordWildCards #-}
module Crypto.Store.CMS
    ( ContentType(..)
    , ContentInfo(..)
    , getContentType
    -- * Reading and writing PEM files
    , module Crypto.Store.CMS.PEM
    -- * Content encapsulation
    , Encap(..)
    , fromEncap
    , Encapsulates
    , isAttached
    , fromAttached
    , toAttachedCI
    , isDetached
    , fromDetached
    , toDetachedCI
    -- * Signed data
    , SignatureValue
    , SignatureAlg(..)
    , EncapsulatedContent
    , SignedData(..)
    , ProducerOfSI
    , ConsumerOfSI
    , signData
    , verifySignedData
    -- ** Signer information
    , SignerInfo(..)
    , SignerIdentifier(..)
    , IssuerAndSerialNumber(..)
    , certSigner
    , withPublicKey
    , withSignerKey
    , withSignerCertificate
    -- * Enveloped data
    , EncryptedKey
    , KeyEncryptionParams(..)
    , KeyTransportParams(..)
    , KeyAgreementParams(..)
    , KeyAgreementKDF(..)
    , RecipientInfo(..)
    , EnvelopedData(..)
    , ProducerOfRI
    , ConsumerOfRI
    , envelopData
    , openEnvelopedData
    -- ** Key Transport recipients
    , KTRecipientInfo(..)
    , RecipientIdentifier(..)
    , forKeyTransRecipient
    , withRecipientKeyTrans
    -- ** Key Agreement recipients
    , KARecipientInfo(..)
    , OriginatorIdentifierOrKey(..)
    , OriginatorPublicKey
    , RecipientEncryptedKey(..)
    , KeyAgreeRecipientIdentifier(..)
    , UserKeyingMaterial
    , forKeyAgreeRecipient
    , withRecipientKeyAgree
    -- ** Key Encryption Key recipients
    , KEKRecipientInfo(..)
    , KeyIdentifier(..)
    , OtherKeyAttribute(..)
    , KeyEncryptionKey
    , forKeyRecipient
    , withRecipientKey
     -- ** Password recipients
    , PasswordRecipientInfo(..)
    , forPasswordRecipient
    , withRecipientPassword
    -- * Digested data
    , DigestProxy(..)
    , DigestAlgorithm(..)
    , DigestedData(..)
    , digestData
    , digestVerify
    -- * Encrypted data
    , ContentEncryptionKey
    , ContentEncryptionCipher(..)
    , ContentEncryptionAlg(..)
    , ContentEncryptionParams
    , EncryptedContent
    , EncryptedData(..)
    , generateEncryptionParams
    , generateRC2EncryptionParams
    , getContentEncryptionAlg
    , encryptData
    , decryptData
    -- * Authenticated data
    , AuthenticationKey
    , MACAlgorithm(..)
    , MessageAuthenticationCode
    , AuthenticatedData(..)
    , generateAuthenticatedData
    , verifyAuthenticatedData
    -- * Authenticated-enveloped data
    , AuthContentEncryptionAlg(..)
    , AuthContentEncryptionParams
    , AuthEnvelopedData(..)
    , generateAuthEnc128Params
    , generateAuthEnc256Params
    , generateChaChaPoly1305Params
    , generateCCMParams
    , generateGCMParams
    , authEnvelopData
    , openAuthEnvelopedData
    -- * Key derivation
    , Salt
    , generateSalt
    , KeyDerivationFunc(..)
    , PBKDF2_PRF(..)
    -- * Secret-key algorithms
    , HasKeySize(..)
    , generateKey
    -- * RSA padding modes
    , MaskGenerationFunc(..)
    , OAEPParams(..)
    , PSSParams(..)
    -- * CMS attributes
    , Attribute(..)
    , findAttribute
    , setAttribute
    , filterAttributes
    -- * CMS standard attributes
    , getSigningTimeAttr
    , setSigningTimeAttr
    , setSigningTimeAttrCurrent
    -- * Originator information
    , OriginatorInfo(..)
    , CertificateChoice(..)
    , OtherCertificateFormat(..)
    , RevocationInfoChoice(..)
    , OtherRevocationInfoFormat(..)
    -- * ASN.1 representation
    , ASN1ObjectExact
    ) where

import Data.ASN1.BinaryEncoding
import Data.ASN1.Encoding
import Data.ByteString (ByteString)
import Data.Maybe (isJust)
import Data.List (nub)

import Crypto.Hash

import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS.Algorithms
import Crypto.Store.CMS.Attribute
import Crypto.Store.CMS.Authenticated
import Crypto.Store.CMS.AuthEnveloped
import Crypto.Store.CMS.Digested
import Crypto.Store.CMS.Encrypted
import Crypto.Store.CMS.Enveloped
import Crypto.Store.CMS.OriginatorInfo
import Crypto.Store.CMS.Info
import Crypto.Store.CMS.PEM
import Crypto.Store.CMS.Signed
import Crypto.Store.CMS.Type
import Crypto.Store.CMS.Util
import Crypto.Store.Error
import Crypto.Store.Util


-- DigestedData

-- | Add a digested-data layer on the specified content info.
digestData :: DigestAlgorithm -> ContentInfo -> DigestedData EncapsulatedContent
digestData :: DigestAlgorithm -> ContentInfo -> DigestedData EncapsulatedContent
digestData (DigestAlgorithm DigestProxy hashAlg
alg) ContentInfo
ci = DigestedData EncapsulatedContent
dd
  where dd :: DigestedData EncapsulatedContent
dd = DigestedData
                 { ddDigestAlgorithm :: DigestProxy hashAlg
ddDigestAlgorithm = DigestProxy hashAlg
alg
                 , ddContentType :: ContentType
ddContentType = ContentInfo -> ContentType
getContentType ContentInfo
ci
                 , ddEncapsulatedContent :: EncapsulatedContent
ddEncapsulatedContent = ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci
                 , ddDigest :: Digest hashAlg
ddDigest = EncapsulatedContent -> Digest hashAlg
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash (ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci)
                 }

-- | Return the inner content info but only if the digest is valid.
digestVerify :: DigestedData EncapsulatedContent -> Either StoreError ContentInfo
digestVerify :: DigestedData EncapsulatedContent -> Either StoreError ContentInfo
digestVerify DigestedData{EncapsulatedContent
Digest hashAlg
ContentType
DigestProxy hashAlg
ddDigestAlgorithm :: ()
ddContentType :: forall content. DigestedData content -> ContentType
ddEncapsulatedContent :: forall content. DigestedData content -> content
ddDigest :: ()
ddDigestAlgorithm :: DigestProxy hashAlg
ddContentType :: ContentType
ddEncapsulatedContent :: EncapsulatedContent
ddDigest :: Digest hashAlg
..}
    | Bool -> Bool
not Bool
acceptable = StoreError -> Either StoreError ContentInfo
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Digest too weak")
    | Digest hashAlg
ddDigest Digest hashAlg -> Digest hashAlg -> Bool
forall a. Eq a => a -> a -> Bool
== EncapsulatedContent -> Digest hashAlg
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash EncapsulatedContent
ddEncapsulatedContent =
        ContentType -> EncapsulatedContent -> Either StoreError ContentInfo
decapsulate ContentType
ddContentType EncapsulatedContent
ddEncapsulatedContent
    | Bool
otherwise = StoreError -> Either StoreError ContentInfo
forall a b. a -> Either a b
Left StoreError
DigestMismatch
  where acceptable :: Bool
acceptable = DigestAlgorithm -> Bool
forall params. HasStrength params => params -> Bool
securityAcceptable (DigestProxy hashAlg -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
ddDigestAlgorithm)


-- EncryptedData

-- | Add an encrypted-data layer on the specified content info.  The content is
-- encrypted with specified key and algorithm.
--
-- Some optional attributes can be added but will not be encrypted.
encryptData :: ContentEncryptionKey
            -> ContentEncryptionParams
            -> [Attribute]
            -> ContentInfo
            -> Either StoreError (EncryptedData EncryptedContent)
encryptData :: EncapsulatedContent
-> ContentEncryptionParams
-> [Attribute]
-> ContentInfo
-> Either StoreError (EncryptedData EncapsulatedContent)
encryptData EncapsulatedContent
key ContentEncryptionParams
params [Attribute]
attrs ContentInfo
ci =
    EncapsulatedContent -> EncryptedData EncapsulatedContent
forall {content}. content -> EncryptedData content
build (EncapsulatedContent -> EncryptedData EncapsulatedContent)
-> Either StoreError EncapsulatedContent
-> Either StoreError (EncryptedData EncapsulatedContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncapsulatedContent
-> ContentEncryptionParams
-> EncapsulatedContent
-> Either StoreError EncapsulatedContent
forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentEncrypt EncapsulatedContent
key ContentEncryptionParams
params (ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci)
  where
    build :: content -> EncryptedData content
build content
ec = EncryptedData
                   { edContentType :: ContentType
edContentType = ContentInfo -> ContentType
getContentType ContentInfo
ci
                   , edContentEncryptionParams :: ContentEncryptionParams
edContentEncryptionParams = ContentEncryptionParams
params
                   , edEncryptedContent :: content
edEncryptedContent = content
ec
                   , edUnprotectedAttrs :: [Attribute]
edUnprotectedAttrs = [Attribute]
attrs
                   }

-- | Decrypt an encrypted content info using the specified key.
decryptData :: ContentEncryptionKey
            -> EncryptedData EncryptedContent
            -> Either StoreError ContentInfo
decryptData :: EncapsulatedContent
-> EncryptedData EncapsulatedContent
-> Either StoreError ContentInfo
decryptData EncapsulatedContent
key EncryptedData{[Attribute]
EncapsulatedContent
ContentType
ContentEncryptionParams
edContentType :: forall content. EncryptedData content -> ContentType
edContentEncryptionParams :: forall content. EncryptedData content -> ContentEncryptionParams
edEncryptedContent :: forall content. EncryptedData content -> content
edUnprotectedAttrs :: forall content. EncryptedData content -> [Attribute]
edContentType :: ContentType
edContentEncryptionParams :: ContentEncryptionParams
edEncryptedContent :: EncapsulatedContent
edUnprotectedAttrs :: [Attribute]
..} = do
    EncapsulatedContent
decrypted <- EncapsulatedContent
-> ContentEncryptionParams
-> EncapsulatedContent
-> Either StoreError EncapsulatedContent
forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentDecrypt EncapsulatedContent
key ContentEncryptionParams
edContentEncryptionParams EncapsulatedContent
edEncryptedContent
    ContentType -> EncapsulatedContent -> Either StoreError ContentInfo
decapsulate ContentType
edContentType EncapsulatedContent
decrypted


-- EnvelopedData

-- | Add an enveloped-data layer on the specified content info.  The content is
-- encrypted with specified key and algorithm.  The key is then processed by
-- one or several 'ProducerOfRI' functions to create recipient info elements.
--
-- Some optional attributes can be added but will not be encrypted.
envelopData :: Applicative f
            => OriginatorInfo
            -> ContentEncryptionKey
            -> ContentEncryptionParams
            -> [ProducerOfRI f]
            -> [Attribute]
            -> ContentInfo
            -> f (Either StoreError (EnvelopedData EncryptedContent))
envelopData :: forall (f :: * -> *).
Applicative f =>
OriginatorInfo
-> EncapsulatedContent
-> ContentEncryptionParams
-> [ProducerOfRI f]
-> [Attribute]
-> ContentInfo
-> f (Either StoreError (EnvelopedData EncapsulatedContent))
envelopData OriginatorInfo
oinfo EncapsulatedContent
key ContentEncryptionParams
params [ProducerOfRI f]
envFns [Attribute]
attrs ContentInfo
ci =
    Either StoreError [RecipientInfo]
-> Either StoreError (EnvelopedData EncapsulatedContent)
f (Either StoreError [RecipientInfo]
 -> Either StoreError (EnvelopedData EncapsulatedContent))
-> f (Either StoreError [RecipientInfo])
-> f (Either StoreError (EnvelopedData EncapsulatedContent))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Either StoreError RecipientInfo]
-> Either StoreError [RecipientInfo]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either StoreError RecipientInfo]
 -> Either StoreError [RecipientInfo])
-> f [Either StoreError RecipientInfo]
-> f (Either StoreError [RecipientInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProducerOfRI f -> f (Either StoreError RecipientInfo))
-> [ProducerOfRI f] -> f [Either StoreError RecipientInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (ProducerOfRI f -> ProducerOfRI f
forall a b. (a -> b) -> a -> b
$ EncapsulatedContent
key) [ProducerOfRI f]
envFns)
  where
    ebs :: Either StoreError EncapsulatedContent
ebs = EncapsulatedContent
-> ContentEncryptionParams
-> EncapsulatedContent
-> Either StoreError EncapsulatedContent
forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentEncrypt EncapsulatedContent
key ContentEncryptionParams
params (ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci)
    f :: Either StoreError [RecipientInfo]
-> Either StoreError (EnvelopedData EncapsulatedContent)
f Either StoreError [RecipientInfo]
ris = EncapsulatedContent
-> [RecipientInfo] -> EnvelopedData EncapsulatedContent
forall {content}.
content -> [RecipientInfo] -> EnvelopedData content
build (EncapsulatedContent
 -> [RecipientInfo] -> EnvelopedData EncapsulatedContent)
-> Either StoreError EncapsulatedContent
-> Either
     StoreError ([RecipientInfo] -> EnvelopedData EncapsulatedContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError EncapsulatedContent
ebs Either
  StoreError ([RecipientInfo] -> EnvelopedData EncapsulatedContent)
-> Either StoreError [RecipientInfo]
-> Either StoreError (EnvelopedData EncapsulatedContent)
forall a b.
Either StoreError (a -> b)
-> Either StoreError a -> Either StoreError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either StoreError [RecipientInfo]
ris
    build :: content -> [RecipientInfo] -> EnvelopedData content
build content
bs [RecipientInfo]
ris = EnvelopedData
                       { evOriginatorInfo :: OriginatorInfo
evOriginatorInfo = OriginatorInfo
oinfo
                       , evRecipientInfos :: [RecipientInfo]
evRecipientInfos = [RecipientInfo]
ris
                       , evContentType :: ContentType
evContentType = ContentInfo -> ContentType
getContentType ContentInfo
ci
                       , evContentEncryptionParams :: ContentEncryptionParams
evContentEncryptionParams = ContentEncryptionParams
params
                       , evEncryptedContent :: content
evEncryptedContent = content
bs
                       , evUnprotectedAttrs :: [Attribute]
evUnprotectedAttrs = [Attribute]
attrs
                       }

-- | Recover an enveloped content info using the specified 'ConsumerOfRI'
-- function.
openEnvelopedData :: Monad m
                  => ConsumerOfRI m
                  -> EnvelopedData EncryptedContent
                  -> m (Either StoreError ContentInfo)
openEnvelopedData :: forall (m :: * -> *).
Monad m =>
ConsumerOfRI m
-> EnvelopedData EncapsulatedContent
-> m (Either StoreError ContentInfo)
openEnvelopedData ConsumerOfRI m
devFn EnvelopedData{[Attribute]
[RecipientInfo]
EncapsulatedContent
ContentType
OriginatorInfo
ContentEncryptionParams
evOriginatorInfo :: forall content. EnvelopedData content -> OriginatorInfo
evRecipientInfos :: forall content. EnvelopedData content -> [RecipientInfo]
evContentType :: forall content. EnvelopedData content -> ContentType
evContentEncryptionParams :: forall content. EnvelopedData content -> ContentEncryptionParams
evEncryptedContent :: forall content. EnvelopedData content -> content
evUnprotectedAttrs :: forall content. EnvelopedData content -> [Attribute]
evOriginatorInfo :: OriginatorInfo
evRecipientInfos :: [RecipientInfo]
evContentType :: ContentType
evContentEncryptionParams :: ContentEncryptionParams
evEncryptedContent :: EncapsulatedContent
evUnprotectedAttrs :: [Attribute]
..} = do
    Either StoreError EncapsulatedContent
r <- [m (Either StoreError EncapsulatedContent)]
-> m (Either StoreError EncapsulatedContent)
forall (m :: * -> *) b.
Monad m =>
[m (Either StoreError b)] -> m (Either StoreError b)
riAttempts (ConsumerOfRI m
-> [RecipientInfo] -> [m (Either StoreError EncapsulatedContent)]
forall a b. (a -> b) -> [a] -> [b]
map ((Either StoreError EncapsulatedContent
 -> Either StoreError EncapsulatedContent)
-> m (Either StoreError EncapsulatedContent)
-> m (Either StoreError EncapsulatedContent)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either StoreError EncapsulatedContent
-> (EncapsulatedContent -> Either StoreError EncapsulatedContent)
-> Either StoreError EncapsulatedContent
forall a b.
Either StoreError a
-> (a -> Either StoreError b) -> Either StoreError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EncapsulatedContent -> Either StoreError EncapsulatedContent
forall {cek}.
ByteArray cek =>
cek -> Either StoreError EncapsulatedContent
decr) (m (Either StoreError EncapsulatedContent)
 -> m (Either StoreError EncapsulatedContent))
-> ConsumerOfRI m -> ConsumerOfRI m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsumerOfRI m
devFn) [RecipientInfo]
evRecipientInfos)
    Either StoreError ContentInfo -> m (Either StoreError ContentInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError EncapsulatedContent
r Either StoreError EncapsulatedContent
-> (EncapsulatedContent -> Either StoreError ContentInfo)
-> Either StoreError ContentInfo
forall a b.
Either StoreError a
-> (a -> Either StoreError b) -> Either StoreError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ContentType -> EncapsulatedContent -> Either StoreError ContentInfo
decapsulate ContentType
ct)
  where
    ct :: ContentType
ct       = ContentType
evContentType
    params :: ContentEncryptionParams
params   = ContentEncryptionParams
evContentEncryptionParams
    decr :: cek -> Either StoreError EncapsulatedContent
decr cek
k   = cek
-> ContentEncryptionParams
-> EncapsulatedContent
-> Either StoreError EncapsulatedContent
forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentDecrypt cek
k ContentEncryptionParams
params EncapsulatedContent
evEncryptedContent


-- AuthenticatedData

-- | Key used for authentication.
type AuthenticationKey = ContentEncryptionKey

-- | Add an authenticated-data layer on the specified content info.  The content
-- is MACed with the specified key and algorithms.  The key is then processed by
-- one or several 'ProducerOfRI' functions to create recipient info elements.
--
-- Two lists of optional attributes can be provided.  The attributes will be
-- part of message authentication when provided in the first list.
generateAuthenticatedData :: Applicative f
                          => OriginatorInfo
                          -> AuthenticationKey
                          -> MACAlgorithm
                          -> Maybe DigestAlgorithm
                          -> [ProducerOfRI f]
                          -> [Attribute]
                          -> [Attribute]
                          -> ContentInfo
                          -> f (Either StoreError (AuthenticatedData EncapsulatedContent))
generateAuthenticatedData :: forall (f :: * -> *).
Applicative f =>
OriginatorInfo
-> EncapsulatedContent
-> MACAlgorithm
-> Maybe DigestAlgorithm
-> [ProducerOfRI f]
-> [Attribute]
-> [Attribute]
-> ContentInfo
-> f (Either StoreError (AuthenticatedData EncapsulatedContent))
generateAuthenticatedData OriginatorInfo
oinfo EncapsulatedContent
key MACAlgorithm
macAlg Maybe DigestAlgorithm
digAlg [ProducerOfRI f]
envFns [Attribute]
aAttrs [Attribute]
uAttrs ContentInfo
ci =
    Either StoreError [RecipientInfo]
-> Either StoreError (AuthenticatedData EncapsulatedContent)
forall {f :: * -> *}.
Functor f =>
f [RecipientInfo] -> f (AuthenticatedData EncapsulatedContent)
f (Either StoreError [RecipientInfo]
 -> Either StoreError (AuthenticatedData EncapsulatedContent))
-> f (Either StoreError [RecipientInfo])
-> f (Either StoreError (AuthenticatedData EncapsulatedContent))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Either StoreError RecipientInfo]
-> Either StoreError [RecipientInfo]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either StoreError RecipientInfo]
 -> Either StoreError [RecipientInfo])
-> f [Either StoreError RecipientInfo]
-> f (Either StoreError [RecipientInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProducerOfRI f -> f (Either StoreError RecipientInfo))
-> [ProducerOfRI f] -> f [Either StoreError RecipientInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (ProducerOfRI f -> ProducerOfRI f
forall a b. (a -> b) -> a -> b
$ EncapsulatedContent
key) [ProducerOfRI f]
envFns)
  where
    msg :: EncapsulatedContent
msg = ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci
    ct :: ContentType
ct  = ContentInfo -> ContentType
getContentType ContentInfo
ci

    ([Attribute]
aAttrs', EncapsulatedContent
input) =
        case Maybe DigestAlgorithm
digAlg of
            Maybe DigestAlgorithm
Nothing  -> ([Attribute]
aAttrs, EncapsulatedContent
msg)
            Just DigestAlgorithm
dig ->
                let md :: EncapsulatedContent
md = DigestAlgorithm -> EncapsulatedContent -> EncapsulatedContent
forall message.
ByteArrayAccess message =>
DigestAlgorithm -> message -> EncapsulatedContent
digest DigestAlgorithm
dig EncapsulatedContent
msg
                    l :: [Attribute]
l  = ContentType -> [Attribute] -> [Attribute]
setContentTypeAttr ContentType
ct ([Attribute] -> [Attribute]) -> [Attribute] -> [Attribute]
forall a b. (a -> b) -> a -> b
$ EncapsulatedContent -> [Attribute] -> [Attribute]
setMessageDigestAttr EncapsulatedContent
md [Attribute]
aAttrs
                in ([Attribute]
l, [Attribute] -> EncapsulatedContent
encodeAuthAttrs [Attribute]
l)

    ebs :: MessageAuthenticationCode
ebs   = MACAlgorithm
-> EncapsulatedContent
-> EncapsulatedContent
-> MessageAuthenticationCode
forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
macAlg EncapsulatedContent
key EncapsulatedContent
input
    f :: f [RecipientInfo] -> f (AuthenticatedData EncapsulatedContent)
f f [RecipientInfo]
ris = MessageAuthenticationCode
-> [RecipientInfo] -> AuthenticatedData EncapsulatedContent
build MessageAuthenticationCode
ebs ([RecipientInfo] -> AuthenticatedData EncapsulatedContent)
-> f [RecipientInfo] -> f (AuthenticatedData EncapsulatedContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [RecipientInfo]
ris
    build :: MessageAuthenticationCode
-> [RecipientInfo] -> AuthenticatedData EncapsulatedContent
build MessageAuthenticationCode
authTag [RecipientInfo]
ris = AuthenticatedData
                            { adOriginatorInfo :: OriginatorInfo
adOriginatorInfo = OriginatorInfo
oinfo
                            , adRecipientInfos :: [RecipientInfo]
adRecipientInfos = [RecipientInfo]
ris
                            , adMACAlgorithm :: MACAlgorithm
adMACAlgorithm = MACAlgorithm
macAlg
                            , adDigestAlgorithm :: Maybe DigestAlgorithm
adDigestAlgorithm = Maybe DigestAlgorithm
digAlg
                            , adContentType :: ContentType
adContentType = ContentInfo -> ContentType
getContentType ContentInfo
ci
                            , adEncapsulatedContent :: EncapsulatedContent
adEncapsulatedContent = ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci
                            , adAuthAttrs :: [Attribute]
adAuthAttrs = [Attribute]
aAttrs'
                            , adMAC :: MessageAuthenticationCode
adMAC = MessageAuthenticationCode
authTag
                            , adUnauthAttrs :: [Attribute]
adUnauthAttrs = [Attribute]
uAttrs
                            }

-- | Verify the integrity of an authenticated content info using the specified
-- 'ConsumerOfRI' function.  The inner content info is returned only if the MAC
-- could be verified.
verifyAuthenticatedData :: Monad m
                        => ConsumerOfRI m
                        -> AuthenticatedData EncapsulatedContent
                        -> m (Either StoreError ContentInfo)
verifyAuthenticatedData :: forall (m :: * -> *).
Monad m =>
ConsumerOfRI m
-> AuthenticatedData EncapsulatedContent
-> m (Either StoreError ContentInfo)
verifyAuthenticatedData ConsumerOfRI m
devFn AuthenticatedData{[Attribute]
[RecipientInfo]
Maybe DigestAlgorithm
EncapsulatedContent
MessageAuthenticationCode
ContentType
OriginatorInfo
MACAlgorithm
adOriginatorInfo :: forall content. AuthenticatedData content -> OriginatorInfo
adRecipientInfos :: forall content. AuthenticatedData content -> [RecipientInfo]
adMACAlgorithm :: forall content. AuthenticatedData content -> MACAlgorithm
adDigestAlgorithm :: forall content. AuthenticatedData content -> Maybe DigestAlgorithm
adContentType :: forall content. AuthenticatedData content -> ContentType
adEncapsulatedContent :: forall content. AuthenticatedData content -> content
adAuthAttrs :: forall content. AuthenticatedData content -> [Attribute]
adMAC :: forall content.
AuthenticatedData content -> MessageAuthenticationCode
adUnauthAttrs :: forall content. AuthenticatedData content -> [Attribute]
adOriginatorInfo :: OriginatorInfo
adRecipientInfos :: [RecipientInfo]
adMACAlgorithm :: MACAlgorithm
adDigestAlgorithm :: Maybe DigestAlgorithm
adContentType :: ContentType
adEncapsulatedContent :: EncapsulatedContent
adAuthAttrs :: [Attribute]
adMAC :: MessageAuthenticationCode
adUnauthAttrs :: [Attribute]
..} =
    [m (Either StoreError ContentInfo)]
-> m (Either StoreError ContentInfo)
forall (m :: * -> *) b.
Monad m =>
[m (Either StoreError b)] -> m (Either StoreError b)
riAttempts ((RecipientInfo -> m (Either StoreError ContentInfo))
-> [RecipientInfo] -> [m (Either StoreError ContentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map ((Either StoreError EncapsulatedContent
 -> Either StoreError ContentInfo)
-> m (Either StoreError EncapsulatedContent)
-> m (Either StoreError ContentInfo)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either StoreError EncapsulatedContent
-> (EncapsulatedContent -> Either StoreError ContentInfo)
-> Either StoreError ContentInfo
forall a b.
Either StoreError a
-> (a -> Either StoreError b) -> Either StoreError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EncapsulatedContent -> Either StoreError ContentInfo
forall {key}.
ByteArrayAccess key =>
key -> Either StoreError ContentInfo
unwrap) (m (Either StoreError EncapsulatedContent)
 -> m (Either StoreError ContentInfo))
-> ConsumerOfRI m
-> RecipientInfo
-> m (Either StoreError ContentInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsumerOfRI m
devFn) [RecipientInfo]
adRecipientInfos)
  where
    msg :: EncapsulatedContent
msg = EncapsulatedContent
adEncapsulatedContent
    ct :: ContentType
ct  = ContentType
adContentType

    noAttr :: Bool
noAttr    = [Attribute] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
adAuthAttrs
    mdMatch :: Bool
mdMatch   = case Maybe DigestAlgorithm
adDigestAlgorithm of
                    Maybe DigestAlgorithm
Nothing  -> Bool
False
                    Just DigestAlgorithm
dig -> Maybe EncapsulatedContent
mdAttr Maybe EncapsulatedContent -> Maybe EncapsulatedContent -> Bool
forall a. Eq a => a -> a -> Bool
== EncapsulatedContent -> Maybe EncapsulatedContent
forall a. a -> Maybe a
Just (DigestAlgorithm -> EncapsulatedContent -> EncapsulatedContent
forall message.
ByteArrayAccess message =>
DigestAlgorithm -> message -> EncapsulatedContent
digest DigestAlgorithm
dig EncapsulatedContent
msg)
    mdAccept :: Bool
mdAccept  = Bool -> (DigestAlgorithm -> Bool) -> Maybe DigestAlgorithm -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True DigestAlgorithm -> Bool
forall params. HasStrength params => params -> Bool
securityAcceptable Maybe DigestAlgorithm
adDigestAlgorithm
    macAccept :: Bool
macAccept = MACAlgorithm -> Bool
forall params. HasStrength params => params -> Bool
securityAcceptable MACAlgorithm
adMACAlgorithm
    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 EncapsulatedContent
mdAttr    = [Attribute] -> Maybe EncapsulatedContent
getMessageDigestAttr [Attribute]
adAuthAttrs
    ctAttr :: Maybe ContentType
ctAttr    = [Attribute] -> Maybe ContentType
getContentTypeAttr [Attribute]
adAuthAttrs
    input :: EncapsulatedContent
input     = if Bool
noAttr then EncapsulatedContent
msg else [Attribute] -> EncapsulatedContent
encodeAuthAttrs [Attribute]
adAuthAttrs

    unwrap :: key -> Either StoreError ContentInfo
unwrap key
k
        | Maybe DigestAlgorithm -> Bool
forall a. Maybe a -> Bool
isJust Maybe DigestAlgorithm
adDigestAlgorithm Bool -> Bool -> Bool
&& Bool
noAttr  = StoreError -> Either StoreError ContentInfo
forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Missing auth attributes")
        | Bool -> Bool
not Bool
noAttr Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
attrMatch         = StoreError -> Either StoreError ContentInfo
forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Invalid auth attributes")
        | Bool -> Bool
not Bool
mdAccept                        = StoreError -> Either StoreError ContentInfo
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Digest too weak")
        | Bool -> Bool
not Bool
macAccept                       = StoreError -> Either StoreError ContentInfo
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"MAC too weak")
        | MessageAuthenticationCode
adMAC MessageAuthenticationCode -> MessageAuthenticationCode -> Bool
forall a. Eq a => a -> a -> Bool
/= MACAlgorithm
-> key -> EncapsulatedContent -> MessageAuthenticationCode
forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
adMACAlgorithm key
k EncapsulatedContent
input = StoreError -> Either StoreError ContentInfo
forall a b. a -> Either a b
Left StoreError
BadContentMAC
        | Bool
otherwise                           = ContentType -> EncapsulatedContent -> Either StoreError ContentInfo
decapsulate ContentType
adContentType EncapsulatedContent
adEncapsulatedContent


-- AuthEnvelopedData

-- | Add an authenticated-enveloped-data layer on the specified content info.
-- The content is encrypted with specified key and algorithm.  The key is then
-- processed by one or several 'ProducerOfRI' functions to create recipient info
-- elements.
--
-- Some attributes can be added but will not be encrypted.  The attributes
-- will be part of message authentication when provided in the first list.
authEnvelopData :: Applicative f
                => OriginatorInfo
                -> ContentEncryptionKey
                -> AuthContentEncryptionParams
                -> [ProducerOfRI f]
                -> [Attribute]
                -> [Attribute]
                -> ContentInfo
                -> f (Either StoreError (AuthEnvelopedData EncryptedContent))
authEnvelopData :: forall (f :: * -> *).
Applicative f =>
OriginatorInfo
-> EncapsulatedContent
-> AuthContentEncryptionParams
-> [ProducerOfRI f]
-> [Attribute]
-> [Attribute]
-> ContentInfo
-> f (Either StoreError (AuthEnvelopedData EncapsulatedContent))
authEnvelopData OriginatorInfo
oinfo EncapsulatedContent
key AuthContentEncryptionParams
params [ProducerOfRI f]
envFns [Attribute]
aAttrs [Attribute]
uAttrs ContentInfo
ci =
    Either StoreError [RecipientInfo]
-> Either StoreError (AuthEnvelopedData EncapsulatedContent)
f (Either StoreError [RecipientInfo]
 -> Either StoreError (AuthEnvelopedData EncapsulatedContent))
-> f (Either StoreError [RecipientInfo])
-> f (Either StoreError (AuthEnvelopedData EncapsulatedContent))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Either StoreError RecipientInfo]
-> Either StoreError [RecipientInfo]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either StoreError RecipientInfo]
 -> Either StoreError [RecipientInfo])
-> f [Either StoreError RecipientInfo]
-> f (Either StoreError [RecipientInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProducerOfRI f -> f (Either StoreError RecipientInfo))
-> [ProducerOfRI f] -> f [Either StoreError RecipientInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (ProducerOfRI f -> ProducerOfRI f
forall a b. (a -> b) -> a -> b
$ EncapsulatedContent
key) [ProducerOfRI f]
envFns)
  where
    raw :: EncapsulatedContent
raw = AuthContentEncryptionParams -> EncapsulatedContent
forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object AuthContentEncryptionParams
params
    aad :: EncapsulatedContent
aad = [Attribute] -> EncapsulatedContent
encodeAuthAttrs [Attribute]
aAttrs
    ebs :: Either StoreError (MessageAuthenticationCode, EncapsulatedContent)
ebs = EncapsulatedContent
-> AuthContentEncryptionParams
-> EncapsulatedContent
-> EncapsulatedContent
-> EncapsulatedContent
-> Either
     StoreError (MessageAuthenticationCode, EncapsulatedContent)
forall cek aad ba.
(ByteArray cek, ByteArrayAccess aad, ByteArray ba) =>
cek
-> AuthContentEncryptionParams
-> ba
-> aad
-> ba
-> Either StoreError (MessageAuthenticationCode, ba)
authContentEncrypt EncapsulatedContent
key AuthContentEncryptionParams
params EncapsulatedContent
raw EncapsulatedContent
aad (ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci)
    f :: Either StoreError [RecipientInfo]
-> Either StoreError (AuthEnvelopedData EncapsulatedContent)
f Either StoreError [RecipientInfo]
ris = (MessageAuthenticationCode, EncapsulatedContent)
-> [RecipientInfo] -> AuthEnvelopedData EncapsulatedContent
forall {content}.
(MessageAuthenticationCode, content)
-> [RecipientInfo] -> AuthEnvelopedData content
build ((MessageAuthenticationCode, EncapsulatedContent)
 -> [RecipientInfo] -> AuthEnvelopedData EncapsulatedContent)
-> Either
     StoreError (MessageAuthenticationCode, EncapsulatedContent)
-> Either
     StoreError
     ([RecipientInfo] -> AuthEnvelopedData EncapsulatedContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError (MessageAuthenticationCode, EncapsulatedContent)
ebs Either
  StoreError
  ([RecipientInfo] -> AuthEnvelopedData EncapsulatedContent)
-> Either StoreError [RecipientInfo]
-> Either StoreError (AuthEnvelopedData EncapsulatedContent)
forall a b.
Either StoreError (a -> b)
-> Either StoreError a -> Either StoreError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either StoreError [RecipientInfo]
ris
    build :: (MessageAuthenticationCode, content)
-> [RecipientInfo] -> AuthEnvelopedData content
build (MessageAuthenticationCode
authTag, content
bs) [RecipientInfo]
ris = AuthEnvelopedData
                       { aeOriginatorInfo :: OriginatorInfo
aeOriginatorInfo = OriginatorInfo
oinfo
                       , aeRecipientInfos :: [RecipientInfo]
aeRecipientInfos = [RecipientInfo]
ris
                       , aeContentType :: ContentType
aeContentType = ContentInfo -> ContentType
getContentType ContentInfo
ci
                       , aeContentEncryptionParams :: ASN1ObjectExact AuthContentEncryptionParams
aeContentEncryptionParams = AuthContentEncryptionParams
-> EncapsulatedContent
-> ASN1ObjectExact AuthContentEncryptionParams
forall a. a -> EncapsulatedContent -> ASN1ObjectExact a
ASN1ObjectExact AuthContentEncryptionParams
params EncapsulatedContent
raw
                       , aeEncryptedContent :: content
aeEncryptedContent = content
bs
                       , aeAuthAttrs :: [Attribute]
aeAuthAttrs = [Attribute]
aAttrs
                       , aeMAC :: MessageAuthenticationCode
aeMAC = MessageAuthenticationCode
authTag
                       , aeUnauthAttrs :: [Attribute]
aeUnauthAttrs = [Attribute]
uAttrs
                       }

-- | Recover an authenticated-enveloped content info using the specified
-- 'ConsumerOfRI' function.
openAuthEnvelopedData :: Monad m
                      => ConsumerOfRI m
                      -> AuthEnvelopedData EncryptedContent
                      -> m (Either StoreError ContentInfo)
openAuthEnvelopedData :: forall (m :: * -> *).
Monad m =>
ConsumerOfRI m
-> AuthEnvelopedData EncapsulatedContent
-> m (Either StoreError ContentInfo)
openAuthEnvelopedData ConsumerOfRI m
devFn AuthEnvelopedData{[Attribute]
[RecipientInfo]
EncapsulatedContent
MessageAuthenticationCode
ASN1ObjectExact AuthContentEncryptionParams
ContentType
OriginatorInfo
aeOriginatorInfo :: forall content. AuthEnvelopedData content -> OriginatorInfo
aeRecipientInfos :: forall content. AuthEnvelopedData content -> [RecipientInfo]
aeContentType :: forall content. AuthEnvelopedData content -> ContentType
aeContentEncryptionParams :: forall content.
AuthEnvelopedData content
-> ASN1ObjectExact AuthContentEncryptionParams
aeEncryptedContent :: forall content. AuthEnvelopedData content -> content
aeAuthAttrs :: forall content. AuthEnvelopedData content -> [Attribute]
aeMAC :: forall content.
AuthEnvelopedData content -> MessageAuthenticationCode
aeUnauthAttrs :: forall content. AuthEnvelopedData content -> [Attribute]
aeOriginatorInfo :: OriginatorInfo
aeRecipientInfos :: [RecipientInfo]
aeContentType :: ContentType
aeContentEncryptionParams :: ASN1ObjectExact AuthContentEncryptionParams
aeEncryptedContent :: EncapsulatedContent
aeAuthAttrs :: [Attribute]
aeMAC :: MessageAuthenticationCode
aeUnauthAttrs :: [Attribute]
..} = do
    Either StoreError EncapsulatedContent
r <- [m (Either StoreError EncapsulatedContent)]
-> m (Either StoreError EncapsulatedContent)
forall (m :: * -> *) b.
Monad m =>
[m (Either StoreError b)] -> m (Either StoreError b)
riAttempts (ConsumerOfRI m
-> [RecipientInfo] -> [m (Either StoreError EncapsulatedContent)]
forall a b. (a -> b) -> [a] -> [b]
map ((Either StoreError EncapsulatedContent
 -> Either StoreError EncapsulatedContent)
-> m (Either StoreError EncapsulatedContent)
-> m (Either StoreError EncapsulatedContent)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either StoreError EncapsulatedContent
-> (EncapsulatedContent -> Either StoreError EncapsulatedContent)
-> Either StoreError EncapsulatedContent
forall a b.
Either StoreError a
-> (a -> Either StoreError b) -> Either StoreError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EncapsulatedContent -> Either StoreError EncapsulatedContent
forall {cek}.
ByteArray cek =>
cek -> Either StoreError EncapsulatedContent
decr) (m (Either StoreError EncapsulatedContent)
 -> m (Either StoreError EncapsulatedContent))
-> ConsumerOfRI m -> ConsumerOfRI m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsumerOfRI m
devFn) [RecipientInfo]
aeRecipientInfos)
    Either StoreError ContentInfo -> m (Either StoreError ContentInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError EncapsulatedContent
r Either StoreError EncapsulatedContent
-> (EncapsulatedContent -> Either StoreError ContentInfo)
-> Either StoreError ContentInfo
forall a b.
Either StoreError a
-> (a -> Either StoreError b) -> Either StoreError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ContentType -> EncapsulatedContent -> Either StoreError ContentInfo
decapsulate ContentType
ct)
  where
    ct :: ContentType
ct       = ContentType
aeContentType
    params :: AuthContentEncryptionParams
params   = ASN1ObjectExact AuthContentEncryptionParams
-> AuthContentEncryptionParams
forall a. ASN1ObjectExact a -> a
exactObject ASN1ObjectExact AuthContentEncryptionParams
aeContentEncryptionParams
    raw :: EncapsulatedContent
raw      = ASN1ObjectExact AuthContentEncryptionParams -> EncapsulatedContent
forall a. ASN1ObjectExact a -> EncapsulatedContent
exactObjectRaw ASN1ObjectExact AuthContentEncryptionParams
aeContentEncryptionParams
    aad :: EncapsulatedContent
aad      = [Attribute] -> EncapsulatedContent
encodeAuthAttrs [Attribute]
aeAuthAttrs
    decr :: cek -> Either StoreError EncapsulatedContent
decr cek
k   = cek
-> AuthContentEncryptionParams
-> EncapsulatedContent
-> EncapsulatedContent
-> EncapsulatedContent
-> MessageAuthenticationCode
-> Either StoreError EncapsulatedContent
forall cek aad ba.
(ByteArray cek, ByteArrayAccess aad, ByteArray ba) =>
cek
-> AuthContentEncryptionParams
-> ba
-> aad
-> ba
-> MessageAuthenticationCode
-> Either StoreError ba
authContentDecrypt cek
k AuthContentEncryptionParams
params EncapsulatedContent
raw EncapsulatedContent
aad EncapsulatedContent
aeEncryptedContent MessageAuthenticationCode
aeMAC


-- SignedData

-- | Add a signed-data layer on the specified content info.  The content is
-- processed by one or several 'ProducerOfSI' functions to create signer info
-- elements.
signData :: Applicative f
         => [ProducerOfSI f] -> ContentInfo -> f (Either StoreError (SignedData EncapsulatedContent))
signData :: forall (f :: * -> *).
Applicative f =>
[ProducerOfSI f]
-> ContentInfo
-> f (Either StoreError (SignedData EncapsulatedContent))
signData [ProducerOfSI f]
sigFns ContentInfo
ci =
    Either
  StoreError
  [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
-> Either StoreError (SignedData EncapsulatedContent)
f (Either
   StoreError
   [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
 -> Either StoreError (SignedData EncapsulatedContent))
-> f (Either
        StoreError
        [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])])
-> f (Either StoreError (SignedData EncapsulatedContent))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Either
   StoreError
   (SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
-> Either
     StoreError
     [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either
    StoreError
    (SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
 -> Either
      StoreError
      [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])])
-> f [Either
        StoreError
        (SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
-> f (Either
        StoreError
        [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProducerOfSI f
 -> f (Either
         StoreError
         (SignerInfo, [CertificateChoice], [RevocationInfoChoice])))
-> [ProducerOfSI f]
-> f [Either
        StoreError
        (SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\ProducerOfSI f
fn -> ProducerOfSI f
fn ContentType
ct EncapsulatedContent
msg) [ProducerOfSI f]
sigFns)
  where
    msg :: EncapsulatedContent
msg = ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci
    ct :: ContentType
ct  = ContentInfo -> ContentType
getContentType ContentInfo
ci
    f :: Either
  StoreError
  [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
-> Either StoreError (SignedData EncapsulatedContent)
f   = ([(SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
 -> SignedData EncapsulatedContent)
-> Either
     StoreError
     [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
-> Either StoreError (SignedData EncapsulatedContent)
forall a b. (a -> b) -> Either StoreError a -> Either StoreError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([SignerInfo], [[CertificateChoice]], [[RevocationInfoChoice]])
-> SignedData EncapsulatedContent
forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
([SignerInfo], t [CertificateChoice], t [RevocationInfoChoice])
-> SignedData EncapsulatedContent
build (([SignerInfo], [[CertificateChoice]], [[RevocationInfoChoice]])
 -> SignedData EncapsulatedContent)
-> ([(SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
    -> ([SignerInfo], [[CertificateChoice]], [[RevocationInfoChoice]]))
-> [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
-> SignedData EncapsulatedContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SignerInfo, [CertificateChoice], [RevocationInfoChoice])]
-> ([SignerInfo], [[CertificateChoice]], [[RevocationInfoChoice]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3)

    build :: ([SignerInfo], t [CertificateChoice], t [RevocationInfoChoice])
-> SignedData EncapsulatedContent
build ([SignerInfo]
sis, t [CertificateChoice]
certLists, t [RevocationInfoChoice]
crlLists) =
        SignedData
            { sdDigestAlgorithms :: [DigestAlgorithm]
sdDigestAlgorithms = [DigestAlgorithm] -> [DigestAlgorithm]
forall a. Eq a => [a] -> [a]
nub ((SignerInfo -> DigestAlgorithm)
-> [SignerInfo] -> [DigestAlgorithm]
forall a b. (a -> b) -> [a] -> [b]
map SignerInfo -> DigestAlgorithm
siDigestAlgorithm [SignerInfo]
sis)
            , sdContentType :: ContentType
sdContentType = ContentInfo -> ContentType
getContentType ContentInfo
ci
            , sdEncapsulatedContent :: EncapsulatedContent
sdEncapsulatedContent = ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci
            , sdCertificates :: [CertificateChoice]
sdCertificates = t [CertificateChoice] -> [CertificateChoice]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [CertificateChoice]
certLists
            , sdCRLs :: [RevocationInfoChoice]
sdCRLs = t [RevocationInfoChoice] -> [RevocationInfoChoice]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [RevocationInfoChoice]
crlLists
            , sdSignerInfos :: [SignerInfo]
sdSignerInfos = [SignerInfo]
sis
            }

-- | Verify a signed content info using the specified 'ConsumerOfSI' function.
-- Verification of at least one signer info must be successful in order to
-- return the inner content info.
verifySignedData :: Monad m
                 => ConsumerOfSI m -> SignedData EncapsulatedContent -> m (Either StoreError ContentInfo)
verifySignedData :: forall (m :: * -> *).
Monad m =>
ConsumerOfSI m
-> SignedData EncapsulatedContent
-> m (Either StoreError ContentInfo)
verifySignedData ConsumerOfSI m
verFn SignedData{[RevocationInfoChoice]
[CertificateChoice]
[DigestAlgorithm]
[SignerInfo]
EncapsulatedContent
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 :: EncapsulatedContent
sdCertificates :: [CertificateChoice]
sdCRLs :: [RevocationInfoChoice]
sdSignerInfos :: [SignerInfo]
..} =
    Bool -> Either StoreError ContentInfo
f (Bool -> Either StoreError ContentInfo)
-> m Bool -> m (Either StoreError ContentInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SignerInfo -> m Bool) -> [SignerInfo] -> m Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
siAttemps SignerInfo -> m Bool
valid [SignerInfo]
sdSignerInfos
  where
    msg :: EncapsulatedContent
msg      = EncapsulatedContent
sdEncapsulatedContent
    ct :: ContentType
ct       = ContentType
sdContentType
    valid :: SignerInfo -> m Bool
valid SignerInfo
si = ConsumerOfSI m
verFn ContentType
ct EncapsulatedContent
msg SignerInfo
si [CertificateChoice]
sdCertificates [RevocationInfoChoice]
sdCRLs
    f :: Bool -> Either StoreError ContentInfo
f Bool
bool   = if Bool
bool then ContentType -> EncapsulatedContent -> Either StoreError ContentInfo
decapsulate ContentType
sdContentType EncapsulatedContent
sdEncapsulatedContent
                       else StoreError -> Either StoreError ContentInfo
forall a b. a -> Either a b
Left StoreError
SignatureNotVerified


-- Utilities

riAttempts :: Monad m => [m (Either StoreError b)] -> m (Either StoreError b)
riAttempts :: forall (m :: * -> *) b.
Monad m =>
[m (Either StoreError b)] -> m (Either StoreError b)
riAttempts []       = Either StoreError b -> m (Either StoreError b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (StoreError -> Either StoreError b
forall a b. a -> Either a b
Left StoreError
NoRecipientInfoFound)
riAttempts [m (Either StoreError b)
single] = m (Either StoreError b)
single
riAttempts [m (Either StoreError b)]
list     = [m (Either StoreError b)] -> m (Either StoreError b)
forall (m :: * -> *) b.
Monad m =>
[m (Either StoreError b)] -> m (Either StoreError b)
loop [m (Either StoreError b)]
list
  where
    loop :: [m (Either StoreError b)] -> m (Either StoreError b)
loop []     = Either StoreError b -> m (Either StoreError b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (StoreError -> Either StoreError b
forall a b. a -> Either a b
Left StoreError
NoRecipientInfoMatched)
    loop (m (Either StoreError b)
x:[m (Either StoreError b)]
xs) = m (Either StoreError b)
x m (Either StoreError b)
-> (Either StoreError b -> m (Either StoreError b))
-> m (Either StoreError b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [m (Either StoreError b)]
-> Either StoreError b -> m (Either StoreError b)
orTail [m (Either StoreError b)]
xs

    orTail :: [m (Either StoreError b)]
-> Either StoreError b -> m (Either StoreError b)
orTail [m (Either StoreError b)]
xs (Left StoreError
_)  = [m (Either StoreError b)] -> m (Either StoreError b)
loop [m (Either StoreError b)]
xs
    orTail [m (Either StoreError b)]
_  Either StoreError b
success   = Either StoreError b -> m (Either StoreError b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either StoreError b
success

siAttemps :: Monad m => (a -> m Bool) -> [a] -> m Bool
siAttemps :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
siAttemps a -> m Bool
_ []     = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
siAttemps a -> m Bool
f (a
x:[a]
xs) = a -> m Bool
f a
x m Bool -> (Bool -> m Bool) -> m Bool
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> m Bool
orTail
  where orTail :: Bool -> m Bool
orTail Bool
bool = if Bool
bool then Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else (a -> m Bool) -> [a] -> m Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
siAttemps a -> m Bool
f [a]
xs

decode :: ParseASN1 [ASN1Event] a -> ByteString -> Either StoreError a
decode :: forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode ParseASN1 [ASN1Event] a
parser EncapsulatedContent
bs = Either StoreError [ASN1Repr]
vals Either StoreError [ASN1Repr]
-> ([ASN1Repr] -> Either StoreError a) -> Either StoreError a
forall a b.
Either StoreError a
-> (a -> Either StoreError b) -> Either StoreError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> StoreError) -> Either String a -> Either StoreError a
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft String -> StoreError
ParseFailure (Either String a -> Either StoreError a)
-> ([ASN1Repr] -> Either String a)
-> [ASN1Repr]
-> Either StoreError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseASN1 [ASN1Event] a -> [ASN1Repr] -> Either String a
forall e a.
Monoid e =>
ParseASN1 e a -> [(ASN1, e)] -> Either String a
runParseASN1_ ParseASN1 [ASN1Event] a
parser
  where vals :: Either StoreError [ASN1Repr]
vals = (ASN1Error -> StoreError)
-> Either ASN1Error [ASN1Repr] -> Either StoreError [ASN1Repr]
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft ASN1Error -> StoreError
DecodingError (BER -> EncapsulatedContent -> Either ASN1Error [ASN1Repr]
forall a.
ASN1DecodingRepr a =>
a -> EncapsulatedContent -> Either ASN1Error [ASN1Repr]
decodeASN1Repr' BER
BER EncapsulatedContent
bs)

-- | Encode the information for encapsulation in another content info.
encapsulate :: ContentInfo -> ByteString
encapsulate :: ContentInfo -> EncapsulatedContent
encapsulate (DataCI EncapsulatedContent
bs)              = EncapsulatedContent
bs
encapsulate (SignedDataCI SignedData (Encap EncapsulatedContent)
ed)        = SignedData (Encap EncapsulatedContent) -> EncapsulatedContent
forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object SignedData (Encap EncapsulatedContent)
ed
encapsulate (EnvelopedDataCI EnvelopedData (Encap EncapsulatedContent)
ed)     = EnvelopedData (Encap EncapsulatedContent) -> EncapsulatedContent
forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object EnvelopedData (Encap EncapsulatedContent)
ed
encapsulate (DigestedDataCI DigestedData (Encap EncapsulatedContent)
dd)      = DigestedData (Encap EncapsulatedContent) -> EncapsulatedContent
forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object DigestedData (Encap EncapsulatedContent)
dd
encapsulate (EncryptedDataCI EncryptedData (Encap EncapsulatedContent)
ed)     = EncryptedData (Encap EncapsulatedContent) -> EncapsulatedContent
forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object EncryptedData (Encap EncapsulatedContent)
ed
encapsulate (AuthenticatedDataCI AuthenticatedData (Encap EncapsulatedContent)
ad) = AuthenticatedData (Encap EncapsulatedContent)
-> EncapsulatedContent
forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object AuthenticatedData (Encap EncapsulatedContent)
ad
encapsulate (AuthEnvelopedDataCI AuthEnvelopedData (Encap EncapsulatedContent)
ae) = AuthEnvelopedData (Encap EncapsulatedContent)
-> EncapsulatedContent
forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object AuthEnvelopedData (Encap EncapsulatedContent)
ae

-- | Decode the information from encapsulated content.
decapsulate :: ContentType -> ByteString -> Either StoreError ContentInfo
decapsulate :: ContentType -> EncapsulatedContent -> Either StoreError ContentInfo
decapsulate ContentType
DataType EncapsulatedContent
bs              = ContentInfo -> Either StoreError ContentInfo
forall a. a -> Either StoreError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncapsulatedContent -> ContentInfo
DataCI EncapsulatedContent
bs)
decapsulate ContentType
SignedDataType EncapsulatedContent
bs        = SignedData (Encap EncapsulatedContent) -> ContentInfo
SignedDataCI (SignedData (Encap EncapsulatedContent) -> ContentInfo)
-> Either StoreError (SignedData (Encap EncapsulatedContent))
-> Either StoreError ContentInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 [ASN1Event] (SignedData (Encap EncapsulatedContent))
-> EncapsulatedContent
-> Either StoreError (SignedData (Encap EncapsulatedContent))
forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode ParseASN1 [ASN1Event] (SignedData (Encap EncapsulatedContent))
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
EnvelopedDataType EncapsulatedContent
bs     = EnvelopedData (Encap EncapsulatedContent) -> ContentInfo
EnvelopedDataCI (EnvelopedData (Encap EncapsulatedContent) -> ContentInfo)
-> Either StoreError (EnvelopedData (Encap EncapsulatedContent))
-> Either StoreError ContentInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 [ASN1Event] (EnvelopedData (Encap EncapsulatedContent))
-> EncapsulatedContent
-> Either StoreError (EnvelopedData (Encap EncapsulatedContent))
forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode ParseASN1 [ASN1Event] (EnvelopedData (Encap EncapsulatedContent))
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
DigestedDataType EncapsulatedContent
bs      = DigestedData (Encap EncapsulatedContent) -> ContentInfo
DigestedDataCI (DigestedData (Encap EncapsulatedContent) -> ContentInfo)
-> Either StoreError (DigestedData (Encap EncapsulatedContent))
-> Either StoreError ContentInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 [ASN1Event] (DigestedData (Encap EncapsulatedContent))
-> EncapsulatedContent
-> Either StoreError (DigestedData (Encap EncapsulatedContent))
forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode ParseASN1 [ASN1Event] (DigestedData (Encap EncapsulatedContent))
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
EncryptedDataType EncapsulatedContent
bs     = EncryptedData (Encap EncapsulatedContent) -> ContentInfo
EncryptedDataCI (EncryptedData (Encap EncapsulatedContent) -> ContentInfo)
-> Either StoreError (EncryptedData (Encap EncapsulatedContent))
-> Either StoreError ContentInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 [ASN1Event] (EncryptedData (Encap EncapsulatedContent))
-> EncapsulatedContent
-> Either StoreError (EncryptedData (Encap EncapsulatedContent))
forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode ParseASN1 [ASN1Event] (EncryptedData (Encap EncapsulatedContent))
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
AuthenticatedDataType EncapsulatedContent
bs = AuthenticatedData (Encap EncapsulatedContent) -> ContentInfo
AuthenticatedDataCI (AuthenticatedData (Encap EncapsulatedContent) -> ContentInfo)
-> Either
     StoreError (AuthenticatedData (Encap EncapsulatedContent))
-> Either StoreError ContentInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1
  [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent))
-> EncapsulatedContent
-> Either
     StoreError (AuthenticatedData (Encap EncapsulatedContent))
forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode ParseASN1
  [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent))
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
AuthEnvelopedDataType EncapsulatedContent
bs = AuthEnvelopedData (Encap EncapsulatedContent) -> ContentInfo
AuthEnvelopedDataCI (AuthEnvelopedData (Encap EncapsulatedContent) -> ContentInfo)
-> Either
     StoreError (AuthEnvelopedData (Encap EncapsulatedContent))
-> Either StoreError ContentInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1
  [ASN1Event] (AuthEnvelopedData (Encap EncapsulatedContent))
-> EncapsulatedContent
-> Either
     StoreError (AuthEnvelopedData (Encap EncapsulatedContent))
forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode ParseASN1
  [ASN1Event] (AuthEnvelopedData (Encap EncapsulatedContent))
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs