-- |
-- Module      : Crypto.Store.CMS.Enveloped
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
--
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
module Crypto.Store.CMS.Enveloped
    ( EncryptedKey
    , UserKeyingMaterial
    , RecipientInfo(..)
    , EnvelopedData(..)
    , ProducerOfRI
    , ConsumerOfRI
    -- * Key Transport recipients
    , KTRecipientInfo(..)
    , RecipientIdentifier(..)
    , IssuerAndSerialNumber(..)
    , forKeyTransRecipient
    , withRecipientKeyTrans
    -- * Key Agreement recipients
    , KARecipientInfo(..)
    , OriginatorIdentifierOrKey(..)
    , OriginatorPublicKey
    , RecipientEncryptedKey(..)
    , KeyAgreeRecipientIdentifier(..)
    , forKeyAgreeRecipient
    , withRecipientKeyAgree
    -- * Key Encryption Key recipients
    , KeyEncryptionKey
    , KEKRecipientInfo(..)
    , KeyIdentifier(..)
    , OtherKeyAttribute(..)
    , forKeyRecipient
    , withRecipientKey
    -- * Password recipients
    , Password
    , PasswordRecipientInfo(..)
    , forPasswordRecipient
    , withRecipientPassword
    ) where

import Control.Applicative
import Control.Monad

import Data.ASN1.BitArray
import Data.ASN1.Types
import Data.ByteString (ByteString)
import Data.List (find)
import Data.Maybe (fromMaybe)
import Data.X509

import Time.Types

import Crypto.Random (MonadRandom)

import Crypto.Store.ASN1.Generate
import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS.Algorithms
import Crypto.Store.CMS.Attribute
import Crypto.Store.CMS.Encrypted
import Crypto.Store.CMS.OriginatorInfo
import Crypto.Store.CMS.Type
import Crypto.Store.CMS.Util
import Crypto.Store.Error

-- | Encrypted key.
type EncryptedKey = ByteString

-- | User keying material.
type UserKeyingMaterial = ByteString

-- | Key used for key encryption.
type KeyEncryptionKey = ByteString

-- | A password stored as a sequence of UTF-8 bytes.
--
-- Some key-derivation functions add restrictions to what characters
-- are supported.
type Password = ByteString

-- | Union type related to identification of the recipient.
data RecipientIdentifier
    = RecipientIASN IssuerAndSerialNumber  -- ^ Issuer and Serial Number
    | RecipientSKI  ByteString             -- ^ Subject Key Identifier
    deriving (Int -> RecipientIdentifier -> ShowS
[RecipientIdentifier] -> ShowS
RecipientIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecipientIdentifier] -> ShowS
$cshowList :: [RecipientIdentifier] -> ShowS
show :: RecipientIdentifier -> String
$cshow :: RecipientIdentifier -> String
showsPrec :: Int -> RecipientIdentifier -> ShowS
$cshowsPrec :: Int -> RecipientIdentifier -> ShowS
Show,RecipientIdentifier -> RecipientIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecipientIdentifier -> RecipientIdentifier -> Bool
$c/= :: RecipientIdentifier -> RecipientIdentifier -> Bool
== :: RecipientIdentifier -> RecipientIdentifier -> Bool
$c== :: RecipientIdentifier -> RecipientIdentifier -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e RecipientIdentifier where
    asn1s :: RecipientIdentifier -> ASN1Stream e
asn1s (RecipientIASN IssuerAndSerialNumber
iasn) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s IssuerAndSerialNumber
iasn
    asn1s (RecipientSKI  ByteString
ski)  = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                                    (forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
ski)

instance Monoid e => ParseASN1Object e RecipientIdentifier where
    parse :: ParseASN1 e RecipientIdentifier
parse = ParseASN1 e RecipientIdentifier
parseIASN forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e RecipientIdentifier
parseSKI
      where parseIASN :: ParseASN1 e RecipientIdentifier
parseIASN = IssuerAndSerialNumber -> RecipientIdentifier
RecipientIASN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            parseSKI :: ParseASN1 e RecipientIdentifier
parseSKI  = ByteString -> RecipientIdentifier
RecipientSKI  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ParseASN1 e ByteString
parseBS
            parseBS :: ParseASN1 e ByteString
parseBS = do { OctetString ByteString
bs <- forall e. Monoid e => ParseASN1 e ASN1
getNext; forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs }

getKTVersion :: RecipientIdentifier -> Integer
getKTVersion :: RecipientIdentifier -> Integer
getKTVersion (RecipientIASN IssuerAndSerialNumber
_) = Integer
0
getKTVersion (RecipientSKI ByteString
_)  = Integer
2

-- | Identification of a certificate using the issuer DN and serial number.
data IssuerAndSerialNumber = IssuerAndSerialNumber
    { IssuerAndSerialNumber -> DistinguishedName
iasnIssuer :: DistinguishedName
      -- ^ Distinguished name of the certificate issuer
    , IssuerAndSerialNumber -> Integer
iasnSerial :: Integer
      -- ^ Issuer-specific certificate serial number
    }
    deriving (Int -> IssuerAndSerialNumber -> ShowS
[IssuerAndSerialNumber] -> ShowS
IssuerAndSerialNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssuerAndSerialNumber] -> ShowS
$cshowList :: [IssuerAndSerialNumber] -> ShowS
show :: IssuerAndSerialNumber -> String
$cshow :: IssuerAndSerialNumber -> String
showsPrec :: Int -> IssuerAndSerialNumber -> ShowS
$cshowsPrec :: Int -> IssuerAndSerialNumber -> ShowS
Show,IssuerAndSerialNumber -> IssuerAndSerialNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssuerAndSerialNumber -> IssuerAndSerialNumber -> Bool
$c/= :: IssuerAndSerialNumber -> IssuerAndSerialNumber -> Bool
== :: IssuerAndSerialNumber -> IssuerAndSerialNumber -> Bool
$c== :: IssuerAndSerialNumber -> IssuerAndSerialNumber -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e IssuerAndSerialNumber where
    asn1s :: IssuerAndSerialNumber -> ASN1Stream e
asn1s IssuerAndSerialNumber{Integer
DistinguishedName
iasnSerial :: Integer
iasnIssuer :: DistinguishedName
iasnSerial :: IssuerAndSerialNumber -> Integer
iasnIssuer :: IssuerAndSerialNumber -> DistinguishedName
..} =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s DistinguishedName
iasnIssuer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
iasnSerial)

instance Monoid e => ParseASN1Object e IssuerAndSerialNumber where
    parse :: ParseASN1 e IssuerAndSerialNumber
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        DistinguishedName
i <- forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        IntVal Integer
s <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        forall (m :: * -> *) a. Monad m => a -> m a
return IssuerAndSerialNumber { iasnIssuer :: DistinguishedName
iasnIssuer = DistinguishedName
i
                                     , iasnSerial :: Integer
iasnSerial = Integer
s
                                     }

idEcPublicKey :: OID
idEcPublicKey :: OID
idEcPublicKey = [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
2,Integer
1]

-- | Originator public key used for key-agreement.  Contrary to 'PubKey' the
-- domain parameters are not used and may be left empty.
data OriginatorPublicKey = OriginatorPublicKeyEC [ASN1] BitArray
    deriving (Int -> OriginatorPublicKey -> ShowS
[OriginatorPublicKey] -> ShowS
OriginatorPublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OriginatorPublicKey] -> ShowS
$cshowList :: [OriginatorPublicKey] -> ShowS
show :: OriginatorPublicKey -> String
$cshow :: OriginatorPublicKey -> String
showsPrec :: Int -> OriginatorPublicKey -> ShowS
$cshowsPrec :: Int -> OriginatorPublicKey -> ShowS
Show,OriginatorPublicKey -> OriginatorPublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OriginatorPublicKey -> OriginatorPublicKey -> Bool
$c/= :: OriginatorPublicKey -> OriginatorPublicKey -> Bool
== :: OriginatorPublicKey -> OriginatorPublicKey -> Bool
$c== :: OriginatorPublicKey -> OriginatorPublicKey -> Bool
Eq)

originatorPublicKeyASN1S :: ASN1Elem e
                         => ASN1ConstructionType
                         -> OriginatorPublicKey
                         -> ASN1Stream e
originatorPublicKeyASN1S :: forall e.
ASN1Elem e =>
ASN1ConstructionType -> OriginatorPublicKey -> ASN1Stream e
originatorPublicKeyASN1S ASN1ConstructionType
ty (OriginatorPublicKeyEC [ASN1]
asn1 BitArray
ba) =
    forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
ty ([e] -> [e]
alg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ASN1Elem e => BitArray -> ASN1Stream e
gBitString BitArray
ba)
  where
    alg :: [e] -> [e]
alg = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (forall e. ASN1Elem e => OID -> ASN1Stream e
gOID OID
idEcPublicKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
gMany [ASN1]
asn1)

parseOriginatorPublicKey :: Monoid e
                         => ASN1ConstructionType
                         -> ParseASN1 e OriginatorPublicKey
parseOriginatorPublicKey :: forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e OriginatorPublicKey
parseOriginatorPublicKey ASN1ConstructionType
ty =
    forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
ty forall a b. (a -> b) -> a -> b
$ do
        [ASN1]
asn1 <- forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
                    OID OID
oid <- forall e. Monoid e => ParseASN1 e ASN1
getNext
                    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (OID
oid forall a. Eq a => a -> a -> Bool
== OID
idEcPublicKey)
                    forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany forall e. Monoid e => ParseASN1 e ASN1
getNext
        BitString BitArray
ba <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        forall (m :: * -> *) a. Monad m => a -> m a
return ([ASN1] -> BitArray -> OriginatorPublicKey
OriginatorPublicKeyEC [ASN1]
asn1 BitArray
ba)

-- | Union type related to identification of the originator.
data OriginatorIdentifierOrKey
    = OriginatorIASN IssuerAndSerialNumber  -- ^ Issuer and Serial Number
    | OriginatorSKI  ByteString             -- ^ Subject Key Identifier
    | OriginatorPublic OriginatorPublicKey  -- ^ Anonymous public key
    deriving (Int -> OriginatorIdentifierOrKey -> ShowS
[OriginatorIdentifierOrKey] -> ShowS
OriginatorIdentifierOrKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OriginatorIdentifierOrKey] -> ShowS
$cshowList :: [OriginatorIdentifierOrKey] -> ShowS
show :: OriginatorIdentifierOrKey -> String
$cshow :: OriginatorIdentifierOrKey -> String
showsPrec :: Int -> OriginatorIdentifierOrKey -> ShowS
$cshowsPrec :: Int -> OriginatorIdentifierOrKey -> ShowS
Show,OriginatorIdentifierOrKey -> OriginatorIdentifierOrKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OriginatorIdentifierOrKey -> OriginatorIdentifierOrKey -> Bool
$c/= :: OriginatorIdentifierOrKey -> OriginatorIdentifierOrKey -> Bool
== :: OriginatorIdentifierOrKey -> OriginatorIdentifierOrKey -> Bool
$c== :: OriginatorIdentifierOrKey -> OriginatorIdentifierOrKey -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e OriginatorIdentifierOrKey where
    asn1s :: OriginatorIdentifierOrKey -> ASN1Stream e
asn1s (OriginatorIASN IssuerAndSerialNumber
iasn)   = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s IssuerAndSerialNumber
iasn
    asn1s (OriginatorSKI  ByteString
ski)    = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                                       (forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
ski)
    asn1s (OriginatorPublic OriginatorPublicKey
pub)  =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> OriginatorPublicKey -> ASN1Stream e
originatorPublicKeyASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) OriginatorPublicKey
pub

instance Monoid e => ParseASN1Object e OriginatorIdentifierOrKey where
    parse :: ParseASN1 e OriginatorIdentifierOrKey
parse = ParseASN1 e OriginatorIdentifierOrKey
parseIASN forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e OriginatorIdentifierOrKey
parseSKI forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e OriginatorIdentifierOrKey
parsePublic
      where parseIASN :: ParseASN1 e OriginatorIdentifierOrKey
parseIASN = IssuerAndSerialNumber -> OriginatorIdentifierOrKey
OriginatorIASN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            parseSKI :: ParseASN1 e OriginatorIdentifierOrKey
parseSKI  = ByteString -> OriginatorIdentifierOrKey
OriginatorSKI  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ParseASN1 e ByteString
parseBS
            parseBS :: ParseASN1 e ByteString
parseBS = do { OctetString ByteString
bs <- forall e. Monoid e => ParseASN1 e ASN1
getNext; forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs }
            parsePublic :: ParseASN1 e OriginatorIdentifierOrKey
parsePublic  = OriginatorPublicKey -> OriginatorIdentifierOrKey
OriginatorPublic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e OriginatorPublicKey
parseOriginatorPublicKey (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)

-- | Union type related to identification of a key-agreement recipient.
data KeyAgreeRecipientIdentifier
    = KeyAgreeRecipientIASN IssuerAndSerialNumber  -- ^ Issuer and Serial Number
    | KeyAgreeRecipientKI   KeyIdentifier          -- ^ Key identifier
    deriving (Int -> KeyAgreeRecipientIdentifier -> ShowS
[KeyAgreeRecipientIdentifier] -> ShowS
KeyAgreeRecipientIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyAgreeRecipientIdentifier] -> ShowS
$cshowList :: [KeyAgreeRecipientIdentifier] -> ShowS
show :: KeyAgreeRecipientIdentifier -> String
$cshow :: KeyAgreeRecipientIdentifier -> String
showsPrec :: Int -> KeyAgreeRecipientIdentifier -> ShowS
$cshowsPrec :: Int -> KeyAgreeRecipientIdentifier -> ShowS
Show,KeyAgreeRecipientIdentifier -> KeyAgreeRecipientIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyAgreeRecipientIdentifier -> KeyAgreeRecipientIdentifier -> Bool
$c/= :: KeyAgreeRecipientIdentifier -> KeyAgreeRecipientIdentifier -> Bool
== :: KeyAgreeRecipientIdentifier -> KeyAgreeRecipientIdentifier -> Bool
$c== :: KeyAgreeRecipientIdentifier -> KeyAgreeRecipientIdentifier -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e KeyAgreeRecipientIdentifier where
    asn1s :: KeyAgreeRecipientIdentifier -> ASN1Stream e
asn1s (KeyAgreeRecipientIASN IssuerAndSerialNumber
iasn) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s IssuerAndSerialNumber
iasn
    asn1s (KeyAgreeRecipientKI   KeyIdentifier
ki)   = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                                            (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s KeyIdentifier
ki)

instance Monoid e => ParseASN1Object e KeyAgreeRecipientIdentifier where
    parse :: ParseASN1 e KeyAgreeRecipientIdentifier
parse = ParseASN1 e KeyAgreeRecipientIdentifier
parseIASN forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e KeyAgreeRecipientIdentifier
parseKI
      where parseIASN :: ParseASN1 e KeyAgreeRecipientIdentifier
parseIASN = IssuerAndSerialNumber -> KeyAgreeRecipientIdentifier
KeyAgreeRecipientIASN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            parseKI :: ParseASN1 e KeyAgreeRecipientIdentifier
parseKI   = KeyIdentifier -> KeyAgreeRecipientIdentifier
KeyAgreeRecipientKI   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse

-- | Encrypted key for a recipient in a key-agreement RI.
data RecipientEncryptedKey = RecipientEncryptedKey
    { RecipientEncryptedKey -> KeyAgreeRecipientIdentifier
rekRid :: KeyAgreeRecipientIdentifier -- ^ identifier of recipient
    , RecipientEncryptedKey -> ByteString
rekEncryptedKey :: EncryptedKey       -- ^ encrypted content-encryption key
    }
    deriving (Int -> RecipientEncryptedKey -> ShowS
[RecipientEncryptedKey] -> ShowS
RecipientEncryptedKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecipientEncryptedKey] -> ShowS
$cshowList :: [RecipientEncryptedKey] -> ShowS
show :: RecipientEncryptedKey -> String
$cshow :: RecipientEncryptedKey -> String
showsPrec :: Int -> RecipientEncryptedKey -> ShowS
$cshowsPrec :: Int -> RecipientEncryptedKey -> ShowS
Show,RecipientEncryptedKey -> RecipientEncryptedKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecipientEncryptedKey -> RecipientEncryptedKey -> Bool
$c/= :: RecipientEncryptedKey -> RecipientEncryptedKey -> Bool
== :: RecipientEncryptedKey -> RecipientEncryptedKey -> Bool
$c== :: RecipientEncryptedKey -> RecipientEncryptedKey -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e RecipientEncryptedKey where
    asn1s :: RecipientEncryptedKey -> ASN1Stream e
asn1s RecipientEncryptedKey{ByteString
KeyAgreeRecipientIdentifier
rekEncryptedKey :: ByteString
rekRid :: KeyAgreeRecipientIdentifier
rekEncryptedKey :: RecipientEncryptedKey -> ByteString
rekRid :: RecipientEncryptedKey -> KeyAgreeRecipientIdentifier
..} = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
rid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ek)
      where rid :: ASN1Stream e
rid = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s KeyAgreeRecipientIdentifier
rekRid
            ek :: ASN1Stream e
ek  = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
rekEncryptedKey

instance Monoid e => ParseASN1Object e RecipientEncryptedKey where
    parse :: ParseASN1 e RecipientEncryptedKey
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        KeyAgreeRecipientIdentifier
rid <- forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        OctetString ByteString
ek <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        forall (m :: * -> *) a. Monad m => a -> m a
return RecipientEncryptedKey { rekRid :: KeyAgreeRecipientIdentifier
rekRid = KeyAgreeRecipientIdentifier
rid, rekEncryptedKey :: ByteString
rekEncryptedKey = ByteString
ek }

findRecipientEncryptedKey :: SignedCertificate
                          -> [RecipientEncryptedKey]
                          -> Maybe EncryptedKey
findRecipientEncryptedKey :: SignedCertificate -> [RecipientEncryptedKey] -> Maybe ByteString
findRecipientEncryptedKey SignedCertificate
cert [RecipientEncryptedKey]
list = RecipientEncryptedKey -> ByteString
rekEncryptedKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find RecipientEncryptedKey -> Bool
fn [RecipientEncryptedKey]
list
  where
    c :: Certificate
c = forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject (forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned SignedCertificate
cert)
    matchIASN :: IssuerAndSerialNumber -> Bool
matchIASN IssuerAndSerialNumber
iasn =
        (IssuerAndSerialNumber -> DistinguishedName
iasnIssuer IssuerAndSerialNumber
iasn, IssuerAndSerialNumber -> Integer
iasnSerial IssuerAndSerialNumber
iasn) forall a. Eq a => a -> a -> Bool
== (Certificate -> DistinguishedName
certIssuerDN Certificate
c, Certificate -> Integer
certSerial Certificate
c)
    matchSKI :: ByteString -> Bool
matchSKI ByteString
ski   =
        case forall a. Extension a => Extensions -> Maybe a
extensionGet (Certificate -> Extensions
certExtensions Certificate
c) of
            Just (ExtSubjectKeyId ByteString
idBs) -> ByteString
idBs forall a. Eq a => a -> a -> Bool
== ByteString
ski
            Maybe ExtSubjectKeyId
Nothing                     -> Bool
False
    fn :: RecipientEncryptedKey -> Bool
fn RecipientEncryptedKey
rek = case RecipientEncryptedKey -> KeyAgreeRecipientIdentifier
rekRid RecipientEncryptedKey
rek of
                 KeyAgreeRecipientIASN IssuerAndSerialNumber
iasn -> IssuerAndSerialNumber -> Bool
matchIASN IssuerAndSerialNumber
iasn
                 KeyAgreeRecipientKI   KeyIdentifier
ki   -> ByteString -> Bool
matchSKI (KeyIdentifier -> ByteString
keyIdentifier KeyIdentifier
ki)

-- | Additional information in a 'KeyIdentifier'.
data OtherKeyAttribute = OtherKeyAttribute
    { OtherKeyAttribute -> OID
keyAttrId :: OID    -- ^ attribute identifier
    , OtherKeyAttribute -> [ASN1]
keyAttr   :: [ASN1] -- ^ attribute value
    }
    deriving (Int -> OtherKeyAttribute -> ShowS
[OtherKeyAttribute] -> ShowS
OtherKeyAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherKeyAttribute] -> ShowS
$cshowList :: [OtherKeyAttribute] -> ShowS
show :: OtherKeyAttribute -> String
$cshow :: OtherKeyAttribute -> String
showsPrec :: Int -> OtherKeyAttribute -> ShowS
$cshowsPrec :: Int -> OtherKeyAttribute -> ShowS
Show,OtherKeyAttribute -> OtherKeyAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherKeyAttribute -> OtherKeyAttribute -> Bool
$c/= :: OtherKeyAttribute -> OtherKeyAttribute -> Bool
== :: OtherKeyAttribute -> OtherKeyAttribute -> Bool
$c== :: OtherKeyAttribute -> OtherKeyAttribute -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e OtherKeyAttribute where
    asn1s :: OtherKeyAttribute -> ASN1Stream e
asn1s OtherKeyAttribute{OID
[ASN1]
keyAttr :: [ASN1]
keyAttrId :: OID
keyAttr :: OtherKeyAttribute -> [ASN1]
keyAttrId :: OtherKeyAttribute -> OID
..} = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
attrId forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
attr)
      where attrId :: ASN1Stream e
attrId = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID OID
keyAttrId
            attr :: ASN1Stream e
attr   = forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
gMany [ASN1]
keyAttr

instance Monoid e => ParseASN1Object e OtherKeyAttribute where
    parse :: ParseASN1 e OtherKeyAttribute
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        OID OID
attrId <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        [ASN1]
attr <- forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany forall e. Monoid e => ParseASN1 e ASN1
getNext
        forall (m :: * -> *) a. Monad m => a -> m a
return OtherKeyAttribute { keyAttrId :: OID
keyAttrId = OID
attrId, keyAttr :: [ASN1]
keyAttr = [ASN1]
attr }

-- | Key identifier and optional attributes.
data KeyIdentifier = KeyIdentifier
    { KeyIdentifier -> ByteString
keyIdentifier :: ByteString         -- ^ identifier of the key
    , KeyIdentifier -> Maybe DateTime
keyDate :: Maybe DateTime           -- ^ optional timestamp
    , KeyIdentifier -> Maybe OtherKeyAttribute
keyOther :: Maybe OtherKeyAttribute -- ^ optional information
    }
    deriving (Int -> KeyIdentifier -> ShowS
[KeyIdentifier] -> ShowS
KeyIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyIdentifier] -> ShowS
$cshowList :: [KeyIdentifier] -> ShowS
show :: KeyIdentifier -> String
$cshow :: KeyIdentifier -> String
showsPrec :: Int -> KeyIdentifier -> ShowS
$cshowsPrec :: Int -> KeyIdentifier -> ShowS
Show,KeyIdentifier -> KeyIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyIdentifier -> KeyIdentifier -> Bool
$c/= :: KeyIdentifier -> KeyIdentifier -> Bool
== :: KeyIdentifier -> KeyIdentifier -> Bool
$c== :: KeyIdentifier -> KeyIdentifier -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e KeyIdentifier where
    asn1s :: KeyIdentifier -> ASN1Stream e
asn1s KeyIdentifier{Maybe DateTime
Maybe OtherKeyAttribute
ByteString
keyOther :: Maybe OtherKeyAttribute
keyDate :: Maybe DateTime
keyIdentifier :: ByteString
keyOther :: KeyIdentifier -> Maybe OtherKeyAttribute
keyDate :: KeyIdentifier -> Maybe DateTime
keyIdentifier :: KeyIdentifier -> ByteString
..} = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
keyId forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
date forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
other)
      where
        keyId :: ASN1Stream e
keyId = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
keyIdentifier
        date :: ASN1Stream e
date  = forall a e. Maybe a -> (a -> ASN1Stream e) -> ASN1Stream e
optASN1S Maybe DateTime
keyDate forall a b. (a -> b) -> a -> b
$ \DateTime
v -> forall e.
ASN1Elem e =>
ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1Stream e
gASN1Time ASN1TimeType
TimeGeneralized DateTime
v forall a. Maybe a
Nothing
        other :: ASN1Stream e
other = forall a e. Maybe a -> (a -> ASN1Stream e) -> ASN1Stream e
optASN1S Maybe OtherKeyAttribute
keyOther forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s

instance Monoid e => ParseASN1Object e KeyIdentifier where
    parse :: ParseASN1 e KeyIdentifier
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        OctetString ByteString
keyId <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        Maybe DateTime
date <- forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe DateTime
dateTimeOrNothing
        Bool
b <- forall e. ParseASN1 e Bool
hasNext
        Maybe OtherKeyAttribute
other <- if Bool
b then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
return KeyIdentifier { keyIdentifier :: ByteString
keyIdentifier = ByteString
keyId
                             , keyDate :: Maybe DateTime
keyDate = Maybe DateTime
date
                             , keyOther :: Maybe OtherKeyAttribute
keyOther = Maybe OtherKeyAttribute
other
                             }

-- | Recipient using key transport.
data KTRecipientInfo = KTRecipientInfo
    { KTRecipientInfo -> RecipientIdentifier
ktRid :: RecipientIdentifier                 -- ^ identifier of recipient
    , KTRecipientInfo -> KeyTransportParams
ktKeyTransportParams :: KeyTransportParams   -- ^ key transport algorithm
    , KTRecipientInfo -> ByteString
ktEncryptedKey :: EncryptedKey               -- ^ encrypted content-encryption key
    }
    deriving (Int -> KTRecipientInfo -> ShowS
[KTRecipientInfo] -> ShowS
KTRecipientInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KTRecipientInfo] -> ShowS
$cshowList :: [KTRecipientInfo] -> ShowS
show :: KTRecipientInfo -> String
$cshow :: KTRecipientInfo -> String
showsPrec :: Int -> KTRecipientInfo -> ShowS
$cshowsPrec :: Int -> KTRecipientInfo -> ShowS
Show,KTRecipientInfo -> KTRecipientInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KTRecipientInfo -> KTRecipientInfo -> Bool
$c/= :: KTRecipientInfo -> KTRecipientInfo -> Bool
== :: KTRecipientInfo -> KTRecipientInfo -> Bool
$c== :: KTRecipientInfo -> KTRecipientInfo -> Bool
Eq)

-- | Recipient using key agreement.
data KARecipientInfo = KARecipientInfo
    { KARecipientInfo -> OriginatorIdentifierOrKey
kaOriginator :: OriginatorIdentifierOrKey           -- ^ identifier of orginator or anonymous key
    , KARecipientInfo -> Maybe ByteString
kaUkm        :: Maybe UserKeyingMaterial            -- ^ user keying material
    , KARecipientInfo -> KeyAgreementParams
kaKeyAgreementParams :: KeyAgreementParams          -- ^ key agreement algorithm
    , KARecipientInfo -> [RecipientEncryptedKey]
kaRecipientEncryptedKeys :: [RecipientEncryptedKey] -- ^ encrypted content-encryption key for one or multiple recipients
    }
    deriving (Int -> KARecipientInfo -> ShowS
[KARecipientInfo] -> ShowS
KARecipientInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KARecipientInfo] -> ShowS
$cshowList :: [KARecipientInfo] -> ShowS
show :: KARecipientInfo -> String
$cshow :: KARecipientInfo -> String
showsPrec :: Int -> KARecipientInfo -> ShowS
$cshowsPrec :: Int -> KARecipientInfo -> ShowS
Show,KARecipientInfo -> KARecipientInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KARecipientInfo -> KARecipientInfo -> Bool
$c/= :: KARecipientInfo -> KARecipientInfo -> Bool
== :: KARecipientInfo -> KARecipientInfo -> Bool
$c== :: KARecipientInfo -> KARecipientInfo -> Bool
Eq)

-- | Recipient using key encryption.
data KEKRecipientInfo = KEKRecipientInfo
    { KEKRecipientInfo -> KeyIdentifier
kekId :: KeyIdentifier                        -- ^ identifier of key encryption key
    , KEKRecipientInfo -> KeyEncryptionParams
kekKeyEncryptionParams :: KeyEncryptionParams -- ^ key encryption algorithm
    , KEKRecipientInfo -> ByteString
kekEncryptedKey :: EncryptedKey               -- ^ encrypted content-encryption key
    }
    deriving (Int -> KEKRecipientInfo -> ShowS
[KEKRecipientInfo] -> ShowS
KEKRecipientInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KEKRecipientInfo] -> ShowS
$cshowList :: [KEKRecipientInfo] -> ShowS
show :: KEKRecipientInfo -> String
$cshow :: KEKRecipientInfo -> String
showsPrec :: Int -> KEKRecipientInfo -> ShowS
$cshowsPrec :: Int -> KEKRecipientInfo -> ShowS
Show,KEKRecipientInfo -> KEKRecipientInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KEKRecipientInfo -> KEKRecipientInfo -> Bool
$c/= :: KEKRecipientInfo -> KEKRecipientInfo -> Bool
== :: KEKRecipientInfo -> KEKRecipientInfo -> Bool
$c== :: KEKRecipientInfo -> KEKRecipientInfo -> Bool
Eq)

-- | Recipient using password-based protection.
data PasswordRecipientInfo = PasswordRecipientInfo
    { PasswordRecipientInfo -> KeyDerivationFunc
priKeyDerivationFunc :: KeyDerivationFunc     -- ^ function to derive key
    , PasswordRecipientInfo -> KeyEncryptionParams
priKeyEncryptionParams :: KeyEncryptionParams -- ^ key encryption algorithm
    , PasswordRecipientInfo -> ByteString
priEncryptedKey :: EncryptedKey               -- ^ encrypted content-encryption key
    }
    deriving (Int -> PasswordRecipientInfo -> ShowS
[PasswordRecipientInfo] -> ShowS
PasswordRecipientInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PasswordRecipientInfo] -> ShowS
$cshowList :: [PasswordRecipientInfo] -> ShowS
show :: PasswordRecipientInfo -> String
$cshow :: PasswordRecipientInfo -> String
showsPrec :: Int -> PasswordRecipientInfo -> ShowS
$cshowsPrec :: Int -> PasswordRecipientInfo -> ShowS
Show,PasswordRecipientInfo -> PasswordRecipientInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasswordRecipientInfo -> PasswordRecipientInfo -> Bool
$c/= :: PasswordRecipientInfo -> PasswordRecipientInfo -> Bool
== :: PasswordRecipientInfo -> PasswordRecipientInfo -> Bool
$c== :: PasswordRecipientInfo -> PasswordRecipientInfo -> Bool
Eq)

-- | Information for a recipient of an 'EnvelopedData'.  An element contains
-- the content-encryption key in encrypted form.
data RecipientInfo = KTRI KTRecipientInfo
                     -- ^ Recipient using key transport
                   | KARI KARecipientInfo
                     -- ^ Recipient using key agreement
                   | KEKRI KEKRecipientInfo
                     -- ^ Recipient using key encryption
                   | PasswordRI PasswordRecipientInfo
                     -- ^ Recipient using password-based protection
    deriving (Int -> RecipientInfo -> ShowS
[RecipientInfo] -> ShowS
RecipientInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecipientInfo] -> ShowS
$cshowList :: [RecipientInfo] -> ShowS
show :: RecipientInfo -> String
$cshow :: RecipientInfo -> String
showsPrec :: Int -> RecipientInfo -> ShowS
$cshowsPrec :: Int -> RecipientInfo -> ShowS
Show,RecipientInfo -> RecipientInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecipientInfo -> RecipientInfo -> Bool
$c/= :: RecipientInfo -> RecipientInfo -> Bool
== :: RecipientInfo -> RecipientInfo -> Bool
$c== :: RecipientInfo -> RecipientInfo -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e RecipientInfo where
    asn1s :: RecipientInfo -> ASN1Stream e
asn1s (KTRI KTRecipientInfo{ByteString
KeyTransportParams
RecipientIdentifier
ktEncryptedKey :: ByteString
ktKeyTransportParams :: KeyTransportParams
ktRid :: RecipientIdentifier
ktEncryptedKey :: KTRecipientInfo -> ByteString
ktKeyTransportParams :: KTRecipientInfo -> KeyTransportParams
ktRid :: KTRecipientInfo -> RecipientIdentifier
..}) =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
rid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ktp forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ek)
      where
        ver :: ASN1Stream e
ver = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (RecipientIdentifier -> Integer
getKTVersion RecipientIdentifier
ktRid)
        rid :: ASN1Stream e
rid = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s RecipientIdentifier
ktRid
        ktp :: ASN1Stream e
ktp = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence KeyTransportParams
ktKeyTransportParams
        ek :: ASN1Stream e
ek  = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
ktEncryptedKey

    asn1s (KARI KARecipientInfo{[RecipientEncryptedKey]
Maybe ByteString
KeyAgreementParams
OriginatorIdentifierOrKey
kaRecipientEncryptedKeys :: [RecipientEncryptedKey]
kaKeyAgreementParams :: KeyAgreementParams
kaUkm :: Maybe ByteString
kaOriginator :: OriginatorIdentifierOrKey
kaRecipientEncryptedKeys :: KARecipientInfo -> [RecipientEncryptedKey]
kaKeyAgreementParams :: KARecipientInfo -> KeyAgreementParams
kaUkm :: KARecipientInfo -> Maybe ByteString
kaOriginator :: KARecipientInfo -> OriginatorIdentifierOrKey
..}) =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) (ASN1Stream e
ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ori forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ukm forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
kap forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
reks)
      where
        ver :: ASN1Stream e
ver  = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
3
        ori :: ASN1Stream e
ori  = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s OriginatorIdentifierOrKey
kaOriginator)
        kap :: ASN1Stream e
kap  = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence KeyAgreementParams
kaKeyAgreementParams
        reks :: ASN1Stream e
reks = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s [RecipientEncryptedKey]
kaRecipientEncryptedKeys)

        ukm :: ASN1Stream e
ukm = case Maybe ByteString
kaUkm of
                  Maybe ByteString
Nothing -> forall a. a -> a
id
                  Just ByteString
bs -> forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) (forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
bs)

    asn1s (KEKRI KEKRecipientInfo{ByteString
KeyEncryptionParams
KeyIdentifier
kekEncryptedKey :: ByteString
kekKeyEncryptionParams :: KeyEncryptionParams
kekId :: KeyIdentifier
kekEncryptedKey :: KEKRecipientInfo -> ByteString
kekKeyEncryptionParams :: KEKRecipientInfo -> KeyEncryptionParams
kekId :: KEKRecipientInfo -> KeyIdentifier
..}) =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2) (ASN1Stream e
ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
kid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
kep forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ek)
      where
        ver :: ASN1Stream e
ver = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
4
        kid :: ASN1Stream e
kid = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s KeyIdentifier
kekId
        kep :: ASN1Stream e
kep = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence KeyEncryptionParams
kekKeyEncryptionParams
        ek :: ASN1Stream e
ek  = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
kekEncryptedKey

    asn1s (PasswordRI PasswordRecipientInfo{ByteString
KeyEncryptionParams
KeyDerivationFunc
priEncryptedKey :: ByteString
priKeyEncryptionParams :: KeyEncryptionParams
priKeyDerivationFunc :: KeyDerivationFunc
priEncryptedKey :: PasswordRecipientInfo -> ByteString
priKeyEncryptionParams :: PasswordRecipientInfo -> KeyEncryptionParams
priKeyDerivationFunc :: PasswordRecipientInfo -> KeyDerivationFunc
..}) =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
3) (ASN1Stream e
ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
kdf forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
kep forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ek)
      where
        ver :: ASN1Stream e
ver = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
0
        kdf :: ASN1Stream e
kdf = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) KeyDerivationFunc
priKeyDerivationFunc
        kep :: ASN1Stream e
kep = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence KeyEncryptionParams
priKeyEncryptionParams
        ek :: ASN1Stream e
ek  = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
priEncryptedKey

instance Monoid e => ParseASN1Object e RecipientInfo where
    parse :: ParseASN1 e RecipientInfo
parse = do
        Maybe RecipientInfo
c <- forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe ASN1ConstructionType
Sequence ParseASN1 e RecipientInfo
parseKT
             forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
`orElse` forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) ParseASN1 e RecipientInfo
parseKA
             forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
`orElse` forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2) ParseASN1 e RecipientInfo
parseKEK
             forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
`orElse` forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
3) ParseASN1 e RecipientInfo
parsePassword
        case Maybe RecipientInfo
c of
            Just RecipientInfo
val -> forall (m :: * -> *) a. Monad m => a -> m a
return RecipientInfo
val
            Maybe RecipientInfo
Nothing  -> forall e a. String -> ParseASN1 e a
throwParseError String
"RecipientInfo: unable to parse"
      where
        parseKT :: ParseASN1 e RecipientInfo
parseKT = KTRecipientInfo -> RecipientInfo
KTRI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            IntVal Integer
v <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Integer
0, Integer
2]) forall a b. (a -> b) -> a -> b
$
                forall e a. String -> ParseASN1 e a
throwParseError (String
"RecipientInfo: parsed invalid KT version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
v)
            RecipientIdentifier
rid <- forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            KeyTransportParams
ktp <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
            (OctetString ByteString
ek) <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            forall (m :: * -> *) a. Monad m => a -> m a
return KTRecipientInfo { ktRid :: RecipientIdentifier
ktRid = RecipientIdentifier
rid
                                   , ktKeyTransportParams :: KeyTransportParams
ktKeyTransportParams = KeyTransportParams
ktp
                                   , ktEncryptedKey :: ByteString
ktEncryptedKey = ByteString
ek
                                   }

        parseKA :: ParseASN1 e RecipientInfo
parseKA = KARecipientInfo -> RecipientInfo
KARI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            IntVal Integer
3 <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            OriginatorIdentifierOrKey
ori <- forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            Maybe ByteString
ukm <- forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) forall a b. (a -> b) -> a -> b
$
                       do { OctetString ByteString
bs <- forall e. Monoid e => ParseASN1 e ASN1
getNext; forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs }
            KeyAgreementParams
kap <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
            [RecipientEncryptedKey]
reks <- forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            forall (m :: * -> *) a. Monad m => a -> m a
return KARecipientInfo { kaOriginator :: OriginatorIdentifierOrKey
kaOriginator = OriginatorIdentifierOrKey
ori
                                   , kaUkm :: Maybe ByteString
kaUkm = Maybe ByteString
ukm
                                   , kaKeyAgreementParams :: KeyAgreementParams
kaKeyAgreementParams = KeyAgreementParams
kap
                                   , kaRecipientEncryptedKeys :: [RecipientEncryptedKey]
kaRecipientEncryptedKeys = [RecipientEncryptedKey]
reks
                                   }

        parseKEK :: ParseASN1 e RecipientInfo
parseKEK = KEKRecipientInfo -> RecipientInfo
KEKRI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            IntVal Integer
4 <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            KeyIdentifier
kid <- forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            KeyEncryptionParams
kep <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
            (OctetString ByteString
ek) <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            forall (m :: * -> *) a. Monad m => a -> m a
return KEKRecipientInfo { kekId :: KeyIdentifier
kekId = KeyIdentifier
kid
                                    , kekKeyEncryptionParams :: KeyEncryptionParams
kekKeyEncryptionParams = KeyEncryptionParams
kep
                                    , kekEncryptedKey :: ByteString
kekEncryptedKey = ByteString
ek
                                    }

        parsePassword :: ParseASN1 e RecipientInfo
parsePassword = PasswordRecipientInfo -> RecipientInfo
PasswordRI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            IntVal Integer
0 <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            KeyDerivationFunc
kdf <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
            KeyEncryptionParams
kep <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
            (OctetString ByteString
ek) <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            forall (m :: * -> *) a. Monad m => a -> m a
return PasswordRecipientInfo { priKeyDerivationFunc :: KeyDerivationFunc
priKeyDerivationFunc = KeyDerivationFunc
kdf
                                         , priKeyEncryptionParams :: KeyEncryptionParams
priKeyEncryptionParams = KeyEncryptionParams
kep
                                         , priEncryptedKey :: ByteString
priEncryptedKey = ByteString
ek
                                         }

isVersion0 :: RecipientInfo -> Bool
isVersion0 :: RecipientInfo -> Bool
isVersion0 (KTRI KTRecipientInfo
x)       = RecipientIdentifier -> Integer
getKTVersion (KTRecipientInfo -> RecipientIdentifier
ktRid KTRecipientInfo
x) forall a. Eq a => a -> a -> Bool
== Integer
0
isVersion0 (KARI KARecipientInfo
_)       = Bool
False      -- because version is always 3
isVersion0 (KEKRI KEKRecipientInfo
_)      = Bool
False      -- because version is always 4
isVersion0 (PasswordRI PasswordRecipientInfo
_) = Bool
True       -- because version is always 0

isPwriOri :: RecipientInfo -> Bool
isPwriOri :: RecipientInfo -> Bool
isPwriOri (KTRI KTRecipientInfo
_)       = Bool
False
isPwriOri (KARI KARecipientInfo
_)       = Bool
False
isPwriOri (KEKRI KEKRecipientInfo
_)      = Bool
False
isPwriOri (PasswordRI PasswordRecipientInfo
_) = Bool
True

-- | Enveloped content information.
data EnvelopedData content = EnvelopedData
    { forall content. EnvelopedData content -> OriginatorInfo
evOriginatorInfo :: OriginatorInfo
      -- ^ Optional information about the originator
    , forall content. EnvelopedData content -> [RecipientInfo]
evRecipientInfos :: [RecipientInfo]
      -- ^ Information for recipients, allowing to decrypt the content
    , forall content. EnvelopedData content -> ContentType
evContentType :: ContentType
      -- ^ Inner content type
    , forall content. EnvelopedData content -> ContentEncryptionParams
evContentEncryptionParams :: ContentEncryptionParams
      -- ^ Encryption algorithm
    , forall content. EnvelopedData content -> content
evEncryptedContent :: content
      -- ^ Encrypted content info
    , forall content. EnvelopedData content -> [Attribute]
evUnprotectedAttrs :: [Attribute]
      -- ^ Optional unprotected attributes
    }
    deriving (Int -> EnvelopedData content -> ShowS
forall content.
Show content =>
Int -> EnvelopedData content -> ShowS
forall content. Show content => [EnvelopedData content] -> ShowS
forall content. Show content => EnvelopedData content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnvelopedData content] -> ShowS
$cshowList :: forall content. Show content => [EnvelopedData content] -> ShowS
show :: EnvelopedData content -> String
$cshow :: forall content. Show content => EnvelopedData content -> String
showsPrec :: Int -> EnvelopedData content -> ShowS
$cshowsPrec :: forall content.
Show content =>
Int -> EnvelopedData content -> ShowS
Show,EnvelopedData content -> EnvelopedData content -> Bool
forall content.
Eq content =>
EnvelopedData content -> EnvelopedData content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnvelopedData content -> EnvelopedData content -> Bool
$c/= :: forall content.
Eq content =>
EnvelopedData content -> EnvelopedData content -> Bool
== :: EnvelopedData content -> EnvelopedData content -> Bool
$c== :: forall content.
Eq content =>
EnvelopedData content -> EnvelopedData content -> Bool
Eq)

instance ProduceASN1Object ASN1P (EnvelopedData (Encap EncryptedContent)) where
    asn1s :: EnvelopedData (Encap ByteString) -> ASN1Stream ASN1P
asn1s EnvelopedData{[Attribute]
[RecipientInfo]
Encap ByteString
ContentType
OriginatorInfo
ContentEncryptionParams
evUnprotectedAttrs :: [Attribute]
evEncryptedContent :: Encap ByteString
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
..} =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream ASN1P
ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
oi forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
ris forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
eci forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
ua)
      where
        ver :: ASN1Stream ASN1P
ver = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
v
        ris :: ASN1Stream ASN1P
ris = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Set (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s [RecipientInfo]
evRecipientInfos)
        eci :: ASN1Stream ASN1P
eci = forall e alg.
(ASN1Elem e, ProduceASN1Object e alg) =>
(ContentType, alg, Encap ByteString) -> ASN1Stream e
encryptedContentInfoASN1S
                  (ContentType
evContentType, ContentEncryptionParams
evContentEncryptionParams, Encap ByteString
evEncryptedContent)
        ua :: ASN1Stream ASN1P
ua  = forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) [Attribute]
evUnprotectedAttrs

        oi :: ASN1Stream ASN1P
oi | OriginatorInfo
evOriginatorInfo forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = forall a. a -> a
id
           | Bool
otherwise = ASN1ConstructionType -> OriginatorInfo -> ASN1Stream ASN1P
originatorInfoASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) OriginatorInfo
evOriginatorInfo

        v :: Integer
v | forall a. HasChoiceOther a => a -> Bool
hasChoiceOther OriginatorInfo
evOriginatorInfo = Integer
4
          | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RecipientInfo -> Bool
isPwriOri [RecipientInfo]
evRecipientInfos  = Integer
3
          | OriginatorInfo
evOriginatorInfo forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty      = Integer
2
          | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
evUnprotectedAttrs)   = Integer
2
          | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all RecipientInfo -> Bool
isVersion0 [RecipientInfo]
evRecipientInfos = Integer
0
          | Bool
otherwise                       = Integer
2

instance ParseASN1Object [ASN1Event] (EnvelopedData (Encap EncryptedContent)) where
    parse :: ParseASN1 [ASN1Event] (EnvelopedData (Encap ByteString))
parse =
        forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
            IntVal Integer
v <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v forall a. Ord a => a -> a -> Bool
> Integer
4) forall a b. (a -> b) -> a -> b
$
                forall e a. String -> ParseASN1 e a
throwParseError (String
"EnvelopedData: parsed invalid version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
v)
            OriginatorInfo
oi <- ASN1ConstructionType -> ParseASN1 [ASN1Event] OriginatorInfo
parseOriginatorInfo (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
            [RecipientInfo]
ris <- forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Set forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            (ContentType
ct, ContentEncryptionParams
params, Encap ByteString
ec) <- forall e alg.
ParseASN1Object e alg =>
ParseASN1 e (ContentType, alg, Encap ByteString)
parseEncryptedContentInfo
            [Attribute]
attrs <- forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
            forall (m :: * -> *) a. Monad m => a -> m a
return EnvelopedData { evOriginatorInfo :: OriginatorInfo
evOriginatorInfo = OriginatorInfo
oi
                                 , evRecipientInfos :: [RecipientInfo]
evRecipientInfos = [RecipientInfo]
ris
                                 , evContentType :: ContentType
evContentType = ContentType
ct
                                 , evContentEncryptionParams :: ContentEncryptionParams
evContentEncryptionParams = ContentEncryptionParams
params
                                 , evEncryptedContent :: Encap ByteString
evEncryptedContent = Encap ByteString
ec
                                 , evUnprotectedAttrs :: [Attribute]
evUnprotectedAttrs = [Attribute]
attrs
                                 }

-- | Function able to produce a 'RecipientInfo'.
type ProducerOfRI m = ContentEncryptionKey -> m (Either StoreError RecipientInfo)

-- | Function able to consume a 'RecipientInfo'.
type ConsumerOfRI m = RecipientInfo -> m (Either StoreError ContentEncryptionKey)

-- | Generate a Key Transport recipient from a certificate and
-- desired algorithm.  The recipient will contain certificate identifier.
--
-- This function can be used as parameter to 'Crypto.Store.CMS.envelopData'.
forKeyTransRecipient :: MonadRandom m
                     => SignedCertificate -> KeyTransportParams -> ProducerOfRI m
forKeyTransRecipient :: forall (m :: * -> *).
MonadRandom m =>
SignedCertificate -> KeyTransportParams -> ProducerOfRI m
forKeyTransRecipient SignedCertificate
cert KeyTransportParams
params ByteString
inkey = do
    Either StoreError ByteString
ek <- forall (m :: * -> *).
MonadRandom m =>
KeyTransportParams
-> PubKey -> ByteString -> m (Either StoreError ByteString)
transportEncrypt KeyTransportParams
params (Certificate -> PubKey
certPubKey Certificate
obj) ByteString
inkey
    forall (m :: * -> *) a. Monad m => a -> m a
return (KTRecipientInfo -> RecipientInfo
KTRI forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> KTRecipientInfo
build forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError ByteString
ek)
  where
    obj :: Certificate
obj = forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject (forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned SignedCertificate
cert)
    isn :: IssuerAndSerialNumber
isn = DistinguishedName -> Integer -> IssuerAndSerialNumber
IssuerAndSerialNumber (Certificate -> DistinguishedName
certIssuerDN Certificate
obj) (Certificate -> Integer
certSerial Certificate
obj)

    build :: ByteString -> KTRecipientInfo
build ByteString
ek = KTRecipientInfo
                  { ktRid :: RecipientIdentifier
ktRid = IssuerAndSerialNumber -> RecipientIdentifier
RecipientIASN IssuerAndSerialNumber
isn
                  , ktKeyTransportParams :: KeyTransportParams
ktKeyTransportParams = KeyTransportParams
params
                  , ktEncryptedKey :: ByteString
ktEncryptedKey = ByteString
ek
                  }

-- | Use a Key Transport recipient, knowing the private key.
--
-- This function can be used as parameter to
-- 'Crypto.Store.CMS.openEnvelopedData'.
withRecipientKeyTrans :: MonadRandom m => PrivKey -> ConsumerOfRI m
withRecipientKeyTrans :: forall (m :: * -> *). MonadRandom m => PrivKey -> ConsumerOfRI m
withRecipientKeyTrans PrivKey
privKey (KTRI KTRecipientInfo{ByteString
KeyTransportParams
RecipientIdentifier
ktEncryptedKey :: ByteString
ktKeyTransportParams :: KeyTransportParams
ktRid :: RecipientIdentifier
ktEncryptedKey :: KTRecipientInfo -> ByteString
ktKeyTransportParams :: KTRecipientInfo -> KeyTransportParams
ktRid :: KTRecipientInfo -> RecipientIdentifier
..}) =
    forall (m :: * -> *).
MonadRandom m =>
KeyTransportParams
-> PrivKey -> ByteString -> m (Either StoreError ByteString)
transportDecrypt KeyTransportParams
ktKeyTransportParams PrivKey
privKey ByteString
ktEncryptedKey
withRecipientKeyTrans PrivKey
_ RecipientInfo
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left StoreError
RecipientTypeMismatch)

-- | Generate a Key Agreement recipient from a certificate and
-- desired algorithm.  The recipient info will contain an ephemeral public key.
--
-- This function can be used as parameter to 'Crypto.Store.CMS.envelopData'.
--
-- To avoid decreasing the security strength, Key Encryption parameters should
-- use a key size equal or greater than the content encryption key.
forKeyAgreeRecipient :: MonadRandom m
                     => SignedCertificate -> KeyAgreementParams -> ProducerOfRI m
forKeyAgreeRecipient :: forall (m :: * -> *).
MonadRandom m =>
SignedCertificate -> KeyAgreementParams -> ProducerOfRI m
forKeyAgreeRecipient SignedCertificate
cert KeyAgreementParams
params ByteString
inkey = do
    Either StoreError ECDHPair
ephemeral <- forall (m :: * -> *).
MonadRandom m =>
PubKey -> m (Either StoreError ECDHPair)
ecdhGenerate (Certificate -> PubKey
certPubKey Certificate
obj)
    case Either StoreError ECDHPair
ephemeral of
        Right ECDHPair
pair -> do
            let pt :: ByteString
pt = ECDHPair -> ByteString
ecdhPublic ECDHPair
pair
                aPub :: OriginatorPublicKey
aPub = [ASN1] -> BitArray -> OriginatorPublicKey
OriginatorPublicKeyEC [] (ByteString -> Int -> BitArray
toBitArray ByteString
pt Int
0)
            Either StoreError ByteString
ek <- forall (m :: * -> *) ba.
(MonadRandom m, ByteArray ba) =>
KeyAgreementParams
-> Maybe ByteString -> ECDHPair -> ba -> m (Either StoreError ba)
ecdhEncrypt KeyAgreementParams
params forall a. Maybe a
Nothing ECDHPair
pair ByteString
inkey
            forall (m :: * -> *) a. Monad m => a -> m a
return (KARecipientInfo -> RecipientInfo
KARI forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginatorPublicKey -> ByteString -> KARecipientInfo
build OriginatorPublicKey
aPub forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError ByteString
ek)
        Left StoreError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left StoreError
err
  where
    obj :: Certificate
obj = forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject (forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned SignedCertificate
cert)
    isn :: IssuerAndSerialNumber
isn = DistinguishedName -> Integer -> IssuerAndSerialNumber
IssuerAndSerialNumber (Certificate -> DistinguishedName
certIssuerDN Certificate
obj) (Certificate -> Integer
certSerial Certificate
obj)

    makeREK :: ByteString -> RecipientEncryptedKey
makeREK ByteString
ek = RecipientEncryptedKey
                     { rekRid :: KeyAgreeRecipientIdentifier
rekRid = IssuerAndSerialNumber -> KeyAgreeRecipientIdentifier
KeyAgreeRecipientIASN IssuerAndSerialNumber
isn
                     , rekEncryptedKey :: ByteString
rekEncryptedKey = ByteString
ek
                     }

    build :: OriginatorPublicKey -> ByteString -> KARecipientInfo
build OriginatorPublicKey
aPub ByteString
ek =
        KARecipientInfo
            { kaOriginator :: OriginatorIdentifierOrKey
kaOriginator = OriginatorPublicKey -> OriginatorIdentifierOrKey
OriginatorPublic OriginatorPublicKey
aPub
            , kaUkm :: Maybe ByteString
kaUkm = forall a. Maybe a
Nothing
            , kaKeyAgreementParams :: KeyAgreementParams
kaKeyAgreementParams = KeyAgreementParams
params
            , kaRecipientEncryptedKeys :: [RecipientEncryptedKey]
kaRecipientEncryptedKeys = [ ByteString -> RecipientEncryptedKey
makeREK ByteString
ek ]
            }

-- | Use a Key Agreement recipient, knowing the recipient private key.  The
-- recipient certificate is also required to locate which encrypted key to use.
--
-- This function can be used as parameter to
-- 'Crypto.Store.CMS.openEnvelopedData'.
withRecipientKeyAgree :: MonadRandom m => PrivKey -> SignedCertificate -> ConsumerOfRI m
withRecipientKeyAgree :: forall (m :: * -> *).
MonadRandom m =>
PrivKey -> SignedCertificate -> ConsumerOfRI m
withRecipientKeyAgree PrivKey
priv SignedCertificate
cert (KARI KARecipientInfo{[RecipientEncryptedKey]
Maybe ByteString
KeyAgreementParams
OriginatorIdentifierOrKey
kaRecipientEncryptedKeys :: [RecipientEncryptedKey]
kaKeyAgreementParams :: KeyAgreementParams
kaUkm :: Maybe ByteString
kaOriginator :: OriginatorIdentifierOrKey
kaRecipientEncryptedKeys :: KARecipientInfo -> [RecipientEncryptedKey]
kaKeyAgreementParams :: KARecipientInfo -> KeyAgreementParams
kaUkm :: KARecipientInfo -> Maybe ByteString
kaOriginator :: KARecipientInfo -> OriginatorIdentifierOrKey
..}) =
    case OriginatorIdentifierOrKey
kaOriginator of
        OriginatorPublic (OriginatorPublicKeyEC [ASN1]
_ BitArray
ba) ->
            case SignedCertificate -> [RecipientEncryptedKey] -> Maybe ByteString
findRecipientEncryptedKey SignedCertificate
cert [RecipientEncryptedKey]
kaRecipientEncryptedKeys of
                Maybe ByteString
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left StoreError
RecipientKeyNotFound)
                Just ByteString
ek ->
                    let pub :: ByteString
pub = BitArray -> ByteString
bitArrayGetData BitArray
ba
                     in forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall ba.
ByteArray ba =>
KeyAgreementParams
-> Maybe ByteString
-> PrivKey
-> ByteString
-> ba
-> Either StoreError ba
ecdhDecrypt KeyAgreementParams
kaKeyAgreementParams Maybe ByteString
kaUkm PrivKey
priv ByteString
pub ByteString
ek)
        OriginatorIdentifierOrKey
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left StoreError
UnsupportedOriginatorFormat)
withRecipientKeyAgree PrivKey
_ SignedCertificate
_ RecipientInfo
_        = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left StoreError
RecipientTypeMismatch)

-- | Generate a Key Encryption Key recipient from a key encryption key and
-- desired algorithm.  The recipient may identify the KEK that was used with
-- the supplied identifier.
--
-- This function can be used as parameter to 'Crypto.Store.CMS.envelopData'.
--
-- To avoid decreasing the security strength, Key Encryption parameters should
-- use a key size equal or greater than the content encryption key.
forKeyRecipient :: MonadRandom m
                => KeyEncryptionKey
                -> KeyIdentifier
                -> KeyEncryptionParams
                -> ProducerOfRI m
forKeyRecipient :: forall (m :: * -> *).
MonadRandom m =>
ByteString
-> KeyIdentifier -> KeyEncryptionParams -> ProducerOfRI m
forKeyRecipient ByteString
key KeyIdentifier
kid KeyEncryptionParams
params ByteString
inkey = do
    Either StoreError ByteString
ek <- forall (m :: * -> *) kek ba.
(MonadRandom m, ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> m (Either StoreError ba)
keyEncrypt ByteString
key KeyEncryptionParams
params ByteString
inkey
    forall (m :: * -> *) a. Monad m => a -> m a
return (KEKRecipientInfo -> RecipientInfo
KEKRI forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> KEKRecipientInfo
build forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError ByteString
ek)
  where
    build :: ByteString -> KEKRecipientInfo
build ByteString
ek = KEKRecipientInfo
                   { kekId :: KeyIdentifier
kekId = KeyIdentifier
kid
                   , kekKeyEncryptionParams :: KeyEncryptionParams
kekKeyEncryptionParams = KeyEncryptionParams
params
                   , kekEncryptedKey :: ByteString
kekEncryptedKey = ByteString
ek
                   }

-- | Use a Key Encryption Key recipient, knowing the key encryption key.
--
-- This function can be used as parameter to
-- 'Crypto.Store.CMS.openEnvelopedData'.
withRecipientKey :: Applicative f => KeyEncryptionKey -> ConsumerOfRI f
withRecipientKey :: forall (f :: * -> *). Applicative f => ByteString -> ConsumerOfRI f
withRecipientKey ByteString
key (KEKRI KEKRecipientInfo{ByteString
KeyEncryptionParams
KeyIdentifier
kekEncryptedKey :: ByteString
kekKeyEncryptionParams :: KeyEncryptionParams
kekId :: KeyIdentifier
kekEncryptedKey :: KEKRecipientInfo -> ByteString
kekKeyEncryptionParams :: KEKRecipientInfo -> KeyEncryptionParams
kekId :: KEKRecipientInfo -> KeyIdentifier
..}) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall kek ba.
(ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> Either StoreError ba
keyDecrypt ByteString
key KeyEncryptionParams
kekKeyEncryptionParams ByteString
kekEncryptedKey)
withRecipientKey ByteString
_ RecipientInfo
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left StoreError
RecipientTypeMismatch)

-- | Generate a password recipient from a password.
--
-- This function can be used as parameter to 'Crypto.Store.CMS.envelopData'.
forPasswordRecipient :: MonadRandom m
                     => Password
                     -> KeyDerivationFunc
                     -> KeyEncryptionParams
                     -> ProducerOfRI m
forPasswordRecipient :: forall (m :: * -> *).
MonadRandom m =>
ByteString
-> KeyDerivationFunc -> KeyEncryptionParams -> ProducerOfRI m
forPasswordRecipient ByteString
pwd KeyDerivationFunc
kdf KeyEncryptionParams
params ByteString
inkey = do
    Either StoreError ByteString
ek <- forall (m :: * -> *) kek ba.
(MonadRandom m, ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> m (Either StoreError ba)
keyEncrypt ByteString
derived KeyEncryptionParams
params ByteString
inkey
    forall (m :: * -> *) a. Monad m => a -> m a
return (PasswordRecipientInfo -> RecipientInfo
PasswordRI forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PasswordRecipientInfo
build forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError ByteString
ek)
  where
    derived :: ByteString
derived = forall password out.
(ByteArrayAccess password, ByteArray out) =>
KeyDerivationFunc -> Int -> password -> out
kdfDerive KeyDerivationFunc
kdf Int
len ByteString
pwd :: EncryptedKey
    len :: Int
len = forall a. a -> Maybe a -> a
fromMaybe (forall params. HasKeySize params => params -> Int
getMaximumKeySize KeyEncryptionParams
params) (KeyDerivationFunc -> Maybe Int
kdfKeyLength KeyDerivationFunc
kdf)
    build :: ByteString -> PasswordRecipientInfo
build ByteString
ek = PasswordRecipientInfo
                   { priKeyDerivationFunc :: KeyDerivationFunc
priKeyDerivationFunc = KeyDerivationFunc
kdf
                   , priKeyEncryptionParams :: KeyEncryptionParams
priKeyEncryptionParams = KeyEncryptionParams
params
                   , priEncryptedKey :: ByteString
priEncryptedKey = ByteString
ek
                   }

-- | Use a password recipient, knowing the password.
--
-- This function can be used as parameter to
-- 'Crypto.Store.CMS.openEnvelopedData'.
withRecipientPassword :: Applicative f => Password -> ConsumerOfRI f
withRecipientPassword :: forall (f :: * -> *). Applicative f => ByteString -> ConsumerOfRI f
withRecipientPassword ByteString
pwd (PasswordRI PasswordRecipientInfo{ByteString
KeyEncryptionParams
KeyDerivationFunc
priEncryptedKey :: ByteString
priKeyEncryptionParams :: KeyEncryptionParams
priKeyDerivationFunc :: KeyDerivationFunc
priEncryptedKey :: PasswordRecipientInfo -> ByteString
priKeyEncryptionParams :: PasswordRecipientInfo -> KeyEncryptionParams
priKeyDerivationFunc :: PasswordRecipientInfo -> KeyDerivationFunc
..}) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall kek ba.
(ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> Either StoreError ba
keyDecrypt ByteString
derived KeyEncryptionParams
priKeyEncryptionParams ByteString
priEncryptedKey)
  where
    derived :: ByteString
derived = forall password out.
(ByteArrayAccess password, ByteArray out) =>
KeyDerivationFunc -> Int -> password -> out
kdfDerive KeyDerivationFunc
priKeyDerivationFunc Int
len ByteString
pwd :: EncryptedKey
    len :: Int
len = forall a. a -> Maybe a -> a
fromMaybe (forall params. HasKeySize params => params -> Int
getMaximumKeySize KeyEncryptionParams
priKeyEncryptionParams)
                    (KeyDerivationFunc -> Maybe Int
kdfKeyLength KeyDerivationFunc
priKeyDerivationFunc)
withRecipientPassword ByteString
_ RecipientInfo
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left StoreError
RecipientTypeMismatch)