{-# 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(..)
, KeyAgreementKDF(..)
, 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
, getSigningTimeAttr
, setSigningTimeAttr
, setSigningTimeAttrCurrent
, 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)
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 -> 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 = forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash (ContentInfo -> EncapsulatedContent
encapsulate ContentInfo
ci)
}
digestVerify :: DigestedData EncapsulatedContent -> Either StoreError ContentInfo
digestVerify :: DigestedData EncapsulatedContent -> Either StoreError ContentInfo
digestVerify DigestedData{EncapsulatedContent
Digest hashAlg
ContentType
DigestProxy hashAlg
ddDigest :: Digest hashAlg
ddEncapsulatedContent :: EncapsulatedContent
ddContentType :: ContentType
ddDigestAlgorithm :: DigestProxy hashAlg
ddDigest :: ()
ddEncapsulatedContent :: forall content. DigestedData content -> content
ddContentType :: forall content. DigestedData content -> ContentType
ddDigestAlgorithm :: ()
..}
| Bool -> Bool
not Bool
acceptable = forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Digest too weak")
| Digest hashAlg
ddDigest forall a. Eq a => a -> a -> Bool
== 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 = forall a b. a -> Either a b
Left StoreError
DigestMismatch
where acceptable :: Bool
acceptable = forall params. HasStrength params => params -> Bool
securityAcceptable (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
ddDigestAlgorithm)
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 =
forall {content}. content -> EncryptedData content
build forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
}
decryptData :: ContentEncryptionKey
-> EncryptedData EncryptedContent
-> Either StoreError ContentInfo
decryptData :: EncapsulatedContent
-> EncryptedData EncapsulatedContent
-> Either StoreError ContentInfo
decryptData EncapsulatedContent
key EncryptedData{[Attribute]
EncapsulatedContent
ContentType
ContentEncryptionParams
edUnprotectedAttrs :: [Attribute]
edEncryptedContent :: EncapsulatedContent
edContentEncryptionParams :: ContentEncryptionParams
edContentType :: ContentType
edUnprotectedAttrs :: forall content. EncryptedData content -> [Attribute]
edEncryptedContent :: forall content. EncryptedData content -> content
edContentEncryptionParams :: forall content. EncryptedData content -> ContentEncryptionParams
edContentType :: forall content. EncryptedData content -> ContentType
..} = do
EncapsulatedContent
decrypted <- 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
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b. (a -> b) -> a -> b
$ EncapsulatedContent
key) [ProducerOfRI f]
envFns)
where
ebs :: Either StoreError EncapsulatedContent
ebs = 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 = forall {content}.
content -> [RecipientInfo] -> EnvelopedData content
build forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError EncapsulatedContent
ebs 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
}
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
evUnprotectedAttrs :: [Attribute]
evEncryptedContent :: EncapsulatedContent
evContentEncryptionParams :: ContentEncryptionParams
evContentType :: ContentType
evRecipientInfos :: [RecipientInfo]
evOriginatorInfo :: OriginatorInfo
evUnprotectedAttrs :: forall content. EnvelopedData content -> [Attribute]
evEncryptedContent :: forall content. EnvelopedData content -> content
evContentEncryptionParams :: forall content. EnvelopedData content -> ContentEncryptionParams
evContentType :: forall content. EnvelopedData content -> ContentType
evRecipientInfos :: forall content. EnvelopedData content -> [RecipientInfo]
evOriginatorInfo :: forall content. EnvelopedData content -> OriginatorInfo
..} = do
Either StoreError EncapsulatedContent
r <- forall (m :: * -> *) b.
Monad m =>
[m (Either StoreError b)] -> m (Either StoreError b)
riAttempts (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {cek}.
ByteArray cek =>
cek -> Either StoreError EncapsulatedContent
decr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsumerOfRI m
devFn) [RecipientInfo]
evRecipientInfos)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError EncapsulatedContent
r 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 = forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentDecrypt cek
k ContentEncryptionParams
params EncapsulatedContent
evEncryptedContent
type AuthenticationKey = ContentEncryptionKey
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 =
forall {f :: * -> *}.
Functor f =>
f [RecipientInfo] -> f (AuthenticatedData EncapsulatedContent)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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 = forall message.
ByteArrayAccess message =>
DigestAlgorithm -> message -> EncapsulatedContent
digest DigestAlgorithm
dig EncapsulatedContent
msg
l :: [Attribute]
l = ContentType -> [Attribute] -> [Attribute]
setContentTypeAttr ContentType
ct 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 = 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 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
}
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
adUnauthAttrs :: [Attribute]
adMAC :: MessageAuthenticationCode
adAuthAttrs :: [Attribute]
adEncapsulatedContent :: EncapsulatedContent
adContentType :: ContentType
adDigestAlgorithm :: Maybe DigestAlgorithm
adMACAlgorithm :: MACAlgorithm
adRecipientInfos :: [RecipientInfo]
adOriginatorInfo :: OriginatorInfo
adUnauthAttrs :: forall content. AuthenticatedData content -> [Attribute]
adMAC :: forall content.
AuthenticatedData content -> MessageAuthenticationCode
adAuthAttrs :: forall content. AuthenticatedData content -> [Attribute]
adEncapsulatedContent :: forall content. AuthenticatedData content -> content
adContentType :: forall content. AuthenticatedData content -> ContentType
adDigestAlgorithm :: forall content. AuthenticatedData content -> Maybe DigestAlgorithm
adMACAlgorithm :: forall content. AuthenticatedData content -> MACAlgorithm
adRecipientInfos :: forall content. AuthenticatedData content -> [RecipientInfo]
adOriginatorInfo :: forall content. AuthenticatedData content -> OriginatorInfo
..} =
forall (m :: * -> *) b.
Monad m =>
[m (Either StoreError b)] -> m (Either StoreError b)
riAttempts (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {key}.
ByteArrayAccess key =>
key -> Either StoreError ContentInfo
unwrap) 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 = 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 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall message.
ByteArrayAccess message =>
DigestAlgorithm -> message -> EncapsulatedContent
digest DigestAlgorithm
dig EncapsulatedContent
msg)
mdAccept :: Bool
mdAccept = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True forall params. HasStrength params => params -> Bool
securityAcceptable Maybe DigestAlgorithm
adDigestAlgorithm
macAccept :: Bool
macAccept = forall params. HasStrength params => params -> Bool
securityAcceptable MACAlgorithm
adMACAlgorithm
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 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
| forall a. Maybe a -> Bool
isJust Maybe DigestAlgorithm
adDigestAlgorithm Bool -> Bool -> Bool
&& Bool
noAttr = 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 = forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Invalid auth attributes")
| Bool -> Bool
not Bool
mdAccept = forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Digest too weak")
| Bool -> Bool
not Bool
macAccept = forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"MAC too weak")
| MessageAuthenticationCode
adMAC forall a. Eq a => a -> a -> Bool
/= forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
adMACAlgorithm key
k EncapsulatedContent
input = forall a b. a -> Either a b
Left StoreError
BadContentMAC
| Bool
otherwise = ContentType -> EncapsulatedContent -> Either StoreError ContentInfo
decapsulate ContentType
adContentType EncapsulatedContent
adEncapsulatedContent
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b. (a -> b) -> a -> b
$ EncapsulatedContent
key) [ProducerOfRI f]
envFns)
where
raw :: EncapsulatedContent
raw = forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object AuthContentEncryptionParams
params
aad :: EncapsulatedContent
aad = [Attribute] -> EncapsulatedContent
encodeAuthAttrs [Attribute]
aAttrs
ebs :: Either StoreError (MessageAuthenticationCode, EncapsulatedContent)
ebs = 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 = forall {content}.
(MessageAuthenticationCode, content)
-> [RecipientInfo] -> AuthEnvelopedData content
build forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError (MessageAuthenticationCode, EncapsulatedContent)
ebs 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 = 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
}
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
aeUnauthAttrs :: [Attribute]
aeMAC :: MessageAuthenticationCode
aeAuthAttrs :: [Attribute]
aeEncryptedContent :: EncapsulatedContent
aeContentEncryptionParams :: ASN1ObjectExact AuthContentEncryptionParams
aeContentType :: ContentType
aeRecipientInfos :: [RecipientInfo]
aeOriginatorInfo :: OriginatorInfo
aeUnauthAttrs :: forall content. AuthEnvelopedData content -> [Attribute]
aeMAC :: forall content.
AuthEnvelopedData content -> MessageAuthenticationCode
aeAuthAttrs :: forall content. AuthEnvelopedData content -> [Attribute]
aeEncryptedContent :: forall content. AuthEnvelopedData content -> content
aeContentEncryptionParams :: forall content.
AuthEnvelopedData content
-> ASN1ObjectExact AuthContentEncryptionParams
aeContentType :: forall content. AuthEnvelopedData content -> ContentType
aeRecipientInfos :: forall content. AuthEnvelopedData content -> [RecipientInfo]
aeOriginatorInfo :: forall content. AuthEnvelopedData content -> OriginatorInfo
..} = do
Either StoreError EncapsulatedContent
r <- forall (m :: * -> *) b.
Monad m =>
[m (Either StoreError b)] -> m (Either StoreError b)
riAttempts (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {cek}.
ByteArray cek =>
cek -> Either StoreError EncapsulatedContent
decr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsumerOfRI m
devFn) [RecipientInfo]
aeRecipientInfos)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError EncapsulatedContent
r 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 = forall a. ASN1ObjectExact a -> a
exactObject ASN1ObjectExact AuthContentEncryptionParams
aeContentEncryptionParams
raw :: EncapsulatedContent
raw = 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 = 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
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
([SignerInfo], t [CertificateChoice], t [RevocationInfoChoice])
-> SignedData EncapsulatedContent
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Eq a => [a] -> [a]
nub (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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [CertificateChoice]
certLists
, sdCRLs :: [RevocationInfoChoice]
sdCRLs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [RevocationInfoChoice]
crlLists
, sdSignerInfos :: [SignerInfo]
sdSignerInfos = [SignerInfo]
sis
}
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
sdSignerInfos :: [SignerInfo]
sdCRLs :: [RevocationInfoChoice]
sdCertificates :: [CertificateChoice]
sdEncapsulatedContent :: EncapsulatedContent
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]
..} =
Bool -> Either StoreError ContentInfo
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a b. a -> Either a b
Left StoreError
SignatureNotVerified
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 [] = forall (m :: * -> *) a. Monad m => a -> m a
return (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 = 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 [] = forall (m :: * -> *) a. Monad m => a -> m a
return (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 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 = 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
_ [] = 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 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 forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft String -> StoreError
ParseFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a.
Monoid e =>
ParseASN1 e a -> [(ASN1, e)] -> Either String a
runParseASN1_ ParseASN1 [ASN1Event] a
parser
where vals :: Either StoreError [ASN1Repr]
vals = forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft ASN1Error -> StoreError
DecodingError (forall a.
ASN1DecodingRepr a =>
a -> EncapsulatedContent -> Either ASN1Error [ASN1Repr]
decodeASN1Repr' BER
BER EncapsulatedContent
bs)
encapsulate :: ContentInfo -> ByteString
encapsulate :: ContentInfo -> EncapsulatedContent
encapsulate (DataCI EncapsulatedContent
bs) = EncapsulatedContent
bs
encapsulate (SignedDataCI SignedData (Encap EncapsulatedContent)
ed) = forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object SignedData (Encap EncapsulatedContent)
ed
encapsulate (EnvelopedDataCI EnvelopedData (Encap EncapsulatedContent)
ed) = forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object EnvelopedData (Encap EncapsulatedContent)
ed
encapsulate (DigestedDataCI DigestedData (Encap EncapsulatedContent)
dd) = forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object DigestedData (Encap EncapsulatedContent)
dd
encapsulate (EncryptedDataCI EncryptedData (Encap EncapsulatedContent)
ed) = forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object EncryptedData (Encap EncapsulatedContent)
ed
encapsulate (AuthenticatedDataCI AuthenticatedData (Encap EncapsulatedContent)
ad) = forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object AuthenticatedData (Encap EncapsulatedContent)
ad
encapsulate (AuthEnvelopedDataCI AuthEnvelopedData (Encap EncapsulatedContent)
ae) = forall obj.
ProduceASN1Object ASN1P obj =>
obj -> EncapsulatedContent
encodeASN1Object AuthEnvelopedData (Encap EncapsulatedContent)
ae
decapsulate :: ContentType -> ByteString -> Either StoreError ContentInfo
decapsulate :: ContentType -> EncapsulatedContent -> Either StoreError ContentInfo
decapsulate ContentType
DataType EncapsulatedContent
bs = forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncapsulatedContent -> ContentInfo
DataCI EncapsulatedContent
bs)
decapsulate ContentType
SignedDataType EncapsulatedContent
bs = SignedData (Encap EncapsulatedContent) -> ContentInfo
SignedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
EnvelopedDataType EncapsulatedContent
bs = EnvelopedData (Encap EncapsulatedContent) -> ContentInfo
EnvelopedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
DigestedDataType EncapsulatedContent
bs = DigestedData (Encap EncapsulatedContent) -> ContentInfo
DigestedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
EncryptedDataType EncapsulatedContent
bs = EncryptedData (Encap EncapsulatedContent) -> ContentInfo
EncryptedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
AuthenticatedDataType EncapsulatedContent
bs = AuthenticatedData (Encap EncapsulatedContent) -> ContentInfo
AuthenticatedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs
decapsulate ContentType
AuthEnvelopedDataType EncapsulatedContent
bs = AuthEnvelopedData (Encap EncapsulatedContent) -> ContentInfo
AuthEnvelopedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
ParseASN1 [ASN1Event] a
-> EncapsulatedContent -> Either StoreError a
decode forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse EncapsulatedContent
bs