{-# LANGUAGE RecordWildCards #-}
module Crypto.Store.CMS
( ContentType(..)
, ContentInfo(..)
, getContentType
, module Crypto.Store.CMS.PEM
, Encap(..)
, fromEncap
, Encapsulates
, isAttached
, fromAttached
, toAttachedCI
, isDetached
, fromDetached
, toDetachedCI
, SignatureValue
, SignatureAlg(..)
, EncapsulatedContent
, SignedData(..)
, ProducerOfSI
, ConsumerOfSI
, signData
, verifySignedData
, SignerInfo(..)
, SignerIdentifier(..)
, IssuerAndSerialNumber(..)
, certSigner
, withPublicKey
, withSignerKey
, withSignerCertificate
, EncryptedKey
, KeyEncryptionParams(..)
, KeyTransportParams(..)
, KeyAgreementParams(..)
, RecipientInfo(..)
, EnvelopedData(..)
, ProducerOfRI
, ConsumerOfRI
, envelopData
, openEnvelopedData
, KTRecipientInfo(..)
, RecipientIdentifier(..)
, forKeyTransRecipient
, withRecipientKeyTrans
, KARecipientInfo(..)
, OriginatorIdentifierOrKey(..)
, OriginatorPublicKey
, RecipientEncryptedKey(..)
, KeyAgreeRecipientIdentifier(..)
, UserKeyingMaterial
, forKeyAgreeRecipient
, withRecipientKeyAgree
, KEKRecipientInfo(..)
, KeyIdentifier(..)
, OtherKeyAttribute(..)
, KeyEncryptionKey
, forKeyRecipient
, withRecipientKey
, PasswordRecipientInfo(..)
, forPasswordRecipient
, withRecipientPassword
, DigestProxy(..)
, DigestAlgorithm(..)
, DigestedData(..)
, digestData
, digestVerify
, ContentEncryptionKey
, ContentEncryptionCipher(..)
, ContentEncryptionAlg(..)
, ContentEncryptionParams
, EncryptedContent
, EncryptedData(..)
, generateEncryptionParams
, generateRC2EncryptionParams
, getContentEncryptionAlg
, encryptData
, decryptData
, AuthenticationKey
, MACAlgorithm(..)
, MessageAuthenticationCode
, AuthenticatedData(..)
, generateAuthenticatedData
, verifyAuthenticatedData
, AuthContentEncryptionAlg(..)
, AuthContentEncryptionParams
, AuthEnvelopedData(..)
, generateAuthEnc128Params
, generateAuthEnc256Params
, generateChaChaPoly1305Params
, generateCCMParams
, generateGCMParams
, authEnvelopData
, openAuthEnvelopedData
, Salt
, generateSalt
, KeyDerivationFunc(..)
, PBKDF2_PRF(..)
, HasKeySize(..)
, generateKey
, MaskGenerationFunc(..)
, OAEPParams(..)
, PSSParams(..)
, Attribute(..)
, findAttribute
, setAttribute
, filterAttributes
, OriginatorInfo(..)
, CertificateChoice(..)
, OtherCertificateFormat(..)
, RevocationInfoChoice(..)
, OtherRevocationInfoFormat(..)
, ASN1ObjectExact
) where
import Data.ASN1.BinaryEncoding
import Data.ASN1.Encoding
import Data.ByteString (ByteString)
import Data.Maybe (isJust)
import Data.List (nub, unzip3)
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
digestData :: DigestAlgorithm -> ContentInfo -> DigestedData EncapsulatedContent
digestData (DigestAlgorithm alg) ci = dd
where dd = DigestedData
{ ddDigestAlgorithm = alg
, ddContentType = getContentType ci
, ddEncapsulatedContent = encapsulate ci
, ddDigest = hash (encapsulate ci)
}
digestVerify :: DigestedData EncapsulatedContent -> Either StoreError ContentInfo
digestVerify DigestedData{..} =
if ddDigest == hash ddEncapsulatedContent
then decapsulate ddContentType ddEncapsulatedContent
else Left DigestMismatch
encryptData :: ContentEncryptionKey
-> ContentEncryptionParams
-> [Attribute]
-> ContentInfo
-> Either StoreError (EncryptedData EncryptedContent)
encryptData key params attrs ci =
build <$> contentEncrypt key params (encapsulate ci)
where
build ec = EncryptedData
{ edContentType = getContentType ci
, edContentEncryptionParams = params
, edEncryptedContent = ec
, edUnprotectedAttrs = attrs
}
decryptData :: ContentEncryptionKey
-> EncryptedData EncryptedContent
-> Either StoreError ContentInfo
decryptData key EncryptedData{..} = do
decrypted <- contentDecrypt key edContentEncryptionParams edEncryptedContent
decapsulate edContentType decrypted
envelopData :: Applicative f
=> OriginatorInfo
-> ContentEncryptionKey
-> ContentEncryptionParams
-> [ProducerOfRI f]
-> [Attribute]
-> ContentInfo
-> f (Either StoreError (EnvelopedData EncryptedContent))
envelopData oinfo key params envFns attrs ci =
f <$> (sequence <$> traverse ($ key) envFns)
where
ebs = contentEncrypt key params (encapsulate ci)
f ris = build <$> ebs <*> ris
build bs ris = EnvelopedData
{ evOriginatorInfo = oinfo
, evRecipientInfos = ris
, evContentType = getContentType ci
, evContentEncryptionParams = params
, evEncryptedContent = bs
, evUnprotectedAttrs = attrs
}
openEnvelopedData :: Monad m
=> ConsumerOfRI m
-> EnvelopedData EncryptedContent
-> m (Either StoreError ContentInfo)
openEnvelopedData devFn EnvelopedData{..} = do
r <- riAttempts (map (fmap (>>= decr) . devFn) evRecipientInfos)
return (r >>= decapsulate ct)
where
ct = evContentType
params = evContentEncryptionParams
decr k = contentDecrypt k params evEncryptedContent
type AuthenticationKey = ContentEncryptionKey
generateAuthenticatedData :: Applicative f
=> OriginatorInfo
-> AuthenticationKey
-> MACAlgorithm
-> Maybe DigestAlgorithm
-> [ProducerOfRI f]
-> [Attribute]
-> [Attribute]
-> ContentInfo
-> f (Either StoreError (AuthenticatedData EncapsulatedContent))
generateAuthenticatedData oinfo key macAlg digAlg envFns aAttrs uAttrs ci =
f <$> (sequence <$> traverse ($ key) envFns)
where
msg = encapsulate ci
ct = getContentType ci
(aAttrs', input) =
case digAlg of
Nothing -> (aAttrs, msg)
Just dig ->
let md = digest dig msg
l = setContentTypeAttr ct $ setMessageDigestAttr md aAttrs
in (l, encodeAuthAttrs l)
ebs = mac macAlg key input
f ris = build ebs <$> ris
build authTag ris = AuthenticatedData
{ adOriginatorInfo = oinfo
, adRecipientInfos = ris
, adMACAlgorithm = macAlg
, adDigestAlgorithm = digAlg
, adContentType = getContentType ci
, adEncapsulatedContent = encapsulate ci
, adAuthAttrs = aAttrs'
, adMAC = authTag
, adUnauthAttrs = uAttrs
}
verifyAuthenticatedData :: Monad m
=> ConsumerOfRI m
-> AuthenticatedData EncapsulatedContent
-> m (Either StoreError ContentInfo)
verifyAuthenticatedData devFn AuthenticatedData{..} =
riAttempts (map (fmap (>>= unwrap) . devFn) adRecipientInfos)
where
msg = adEncapsulatedContent
ct = adContentType
noAttr = null adAuthAttrs
mdMatch = case adDigestAlgorithm of
Nothing -> False
Just dig -> mdAttr == Just (digest dig msg)
attrMatch = ctAttr == Just ct && mdMatch
mdAttr = getMessageDigestAttr adAuthAttrs
ctAttr = getContentTypeAttr adAuthAttrs
input = if noAttr then msg else encodeAuthAttrs adAuthAttrs
unwrap k
| isJust adDigestAlgorithm && noAttr = Left (InvalidInput "Missing auth attributes")
| not noAttr && not attrMatch = Left (InvalidInput "Invalid auth attributes")
| adMAC /= mac adMACAlgorithm k input = Left BadContentMAC
| otherwise = decapsulate adContentType adEncapsulatedContent
authEnvelopData :: Applicative f
=> OriginatorInfo
-> ContentEncryptionKey
-> AuthContentEncryptionParams
-> [ProducerOfRI f]
-> [Attribute]
-> [Attribute]
-> ContentInfo
-> f (Either StoreError (AuthEnvelopedData EncryptedContent))
authEnvelopData oinfo key params envFns aAttrs uAttrs ci =
f <$> (sequence <$> traverse ($ key) envFns)
where
raw = encodeASN1Object params
aad = encodeAuthAttrs aAttrs
ebs = authContentEncrypt key params raw aad (encapsulate ci)
f ris = build <$> ebs <*> ris
build (authTag, bs) ris = AuthEnvelopedData
{ aeOriginatorInfo = oinfo
, aeRecipientInfos = ris
, aeContentType = getContentType ci
, aeContentEncryptionParams = ASN1ObjectExact params raw
, aeEncryptedContent = bs
, aeAuthAttrs = aAttrs
, aeMAC = authTag
, aeUnauthAttrs = uAttrs
}
openAuthEnvelopedData :: Monad m
=> ConsumerOfRI m
-> AuthEnvelopedData EncryptedContent
-> m (Either StoreError ContentInfo)
openAuthEnvelopedData devFn AuthEnvelopedData{..} = do
r <- riAttempts (map (fmap (>>= decr) . devFn) aeRecipientInfos)
return (r >>= decapsulate ct)
where
ct = aeContentType
params = exactObject aeContentEncryptionParams
raw = exactObjectRaw aeContentEncryptionParams
aad = encodeAuthAttrs aeAuthAttrs
decr k = authContentDecrypt k params raw aad aeEncryptedContent aeMAC
signData :: Applicative f
=> [ProducerOfSI f] -> ContentInfo -> f (Either StoreError (SignedData EncapsulatedContent))
signData sigFns ci =
f <$> (sequence <$> traverse (\fn -> fn ct msg) sigFns)
where
msg = encapsulate ci
ct = getContentType ci
f = fmap (build . unzip3)
build (sis, certLists, crlLists) =
SignedData
{ sdDigestAlgorithms = nub (map siDigestAlgorithm sis)
, sdContentType = getContentType ci
, sdEncapsulatedContent = encapsulate ci
, sdCertificates = concat certLists
, sdCRLs = concat crlLists
, sdSignerInfos = sis
}
verifySignedData :: Monad m
=> ConsumerOfSI m -> SignedData EncapsulatedContent -> m (Either StoreError ContentInfo)
verifySignedData verFn SignedData{..} =
f <$> siAttemps valid sdSignerInfos
where
msg = sdEncapsulatedContent
ct = sdContentType
valid si = verFn ct msg si sdCertificates sdCRLs
f bool = if bool then decapsulate sdContentType sdEncapsulatedContent
else Left SignatureNotVerified
riAttempts :: Monad m => [m (Either StoreError b)] -> m (Either StoreError b)
riAttempts [] = return (Left NoRecipientInfoFound)
riAttempts [single] = single
riAttempts list = loop list
where
loop [] = return (Left NoRecipientInfoMatched)
loop (x:xs) = x >>= orTail xs
orTail xs (Left _) = loop xs
orTail _ success = return success
siAttemps :: Monad m => (a -> m Bool) -> [a] -> m Bool
siAttemps _ [] = pure False
siAttemps f (x:xs) = f x >>= orTail
where orTail bool = if bool then return True else siAttemps f xs
decode :: ParseASN1 [ASN1Event] a -> ByteString -> Either StoreError a
decode parser bs = vals >>= mapLeft ParseFailure . runParseASN1_ parser
where vals = mapLeft DecodingError (decodeASN1Repr' BER bs)
encapsulate :: ContentInfo -> ByteString
encapsulate (DataCI bs) = bs
encapsulate (SignedDataCI ed) = encodeASN1Object ed
encapsulate (EnvelopedDataCI ed) = encodeASN1Object ed
encapsulate (DigestedDataCI dd) = encodeASN1Object dd
encapsulate (EncryptedDataCI ed) = encodeASN1Object ed
encapsulate (AuthenticatedDataCI ad) = encodeASN1Object ad
encapsulate (AuthEnvelopedDataCI ae) = encodeASN1Object ae
decapsulate :: ContentType -> ByteString -> Either StoreError ContentInfo
decapsulate DataType bs = pure (DataCI bs)
decapsulate SignedDataType bs = SignedDataCI <$> decode parse bs
decapsulate EnvelopedDataType bs = EnvelopedDataCI <$> decode parse bs
decapsulate DigestedDataType bs = DigestedDataCI <$> decode parse bs
decapsulate EncryptedDataType bs = EncryptedDataCI <$> decode parse bs
decapsulate AuthenticatedDataType bs = AuthenticatedDataCI <$> decode parse bs
decapsulate AuthEnvelopedDataType bs = AuthEnvelopedDataCI <$> decode parse bs