-- |
-- Module      : Crypto.Store.CMS.AuthEnveloped
-- 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.AuthEnveloped
    ( AuthEnvelopedData(..)
    , encodeAuthAttrs
    ) where

import Control.Applicative
import Control.Monad

import Data.ASN1.Types
import Data.ByteArray (convert)
import Data.ByteString (ByteString)

import Crypto.Cipher.Types

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.Enveloped
import Crypto.Store.CMS.OriginatorInfo
import Crypto.Store.CMS.Type
import Crypto.Store.CMS.Util

-- | Authenticated-enveloped content information.
data AuthEnvelopedData content = AuthEnvelopedData
    { forall content. AuthEnvelopedData content -> OriginatorInfo
aeOriginatorInfo :: OriginatorInfo
      -- ^ Optional information about the originator
    , forall content. AuthEnvelopedData content -> [RecipientInfo]
aeRecipientInfos :: [RecipientInfo]
      -- ^ Information for recipients, allowing to decrypt the content
    , forall content. AuthEnvelopedData content -> ContentType
aeContentType :: ContentType
      -- ^ Inner content type
    , forall content.
AuthEnvelopedData content
-> ASN1ObjectExact AuthContentEncryptionParams
aeContentEncryptionParams :: ASN1ObjectExact AuthContentEncryptionParams
      -- ^ Encryption algorithm
    , forall content. AuthEnvelopedData content -> content
aeEncryptedContent :: content
      -- ^ Encrypted content info
    , forall content. AuthEnvelopedData content -> [Attribute]
aeAuthAttrs :: [Attribute]
      -- ^ Optional authenticated attributes
    , forall content.
AuthEnvelopedData content -> MessageAuthenticationCode
aeMAC :: MessageAuthenticationCode
      -- ^ Message authentication code
    , forall content. AuthEnvelopedData content -> [Attribute]
aeUnauthAttrs :: [Attribute]
      -- ^ Optional unauthenticated attributes
    }
    deriving (Int -> AuthEnvelopedData content -> ShowS
forall content.
Show content =>
Int -> AuthEnvelopedData content -> ShowS
forall content.
Show content =>
[AuthEnvelopedData content] -> ShowS
forall content. Show content => AuthEnvelopedData content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthEnvelopedData content] -> ShowS
$cshowList :: forall content.
Show content =>
[AuthEnvelopedData content] -> ShowS
show :: AuthEnvelopedData content -> String
$cshow :: forall content. Show content => AuthEnvelopedData content -> String
showsPrec :: Int -> AuthEnvelopedData content -> ShowS
$cshowsPrec :: forall content.
Show content =>
Int -> AuthEnvelopedData content -> ShowS
Show,AuthEnvelopedData content -> AuthEnvelopedData content -> Bool
forall content.
Eq content =>
AuthEnvelopedData content -> AuthEnvelopedData content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthEnvelopedData content -> AuthEnvelopedData content -> Bool
$c/= :: forall content.
Eq content =>
AuthEnvelopedData content -> AuthEnvelopedData content -> Bool
== :: AuthEnvelopedData content -> AuthEnvelopedData content -> Bool
$c== :: forall content.
Eq content =>
AuthEnvelopedData content -> AuthEnvelopedData content -> Bool
Eq)

instance ProduceASN1Object ASN1P (AuthEnvelopedData (Encap EncryptedContent)) where
    asn1s :: AuthEnvelopedData (Encap ByteString) -> ASN1Stream ASN1P
asn1s AuthEnvelopedData{[Attribute]
[RecipientInfo]
MessageAuthenticationCode
ASN1ObjectExact AuthContentEncryptionParams
Encap ByteString
ContentType
OriginatorInfo
aeUnauthAttrs :: [Attribute]
aeMAC :: MessageAuthenticationCode
aeAuthAttrs :: [Attribute]
aeEncryptedContent :: Encap ByteString
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
..} =
        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
aa forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
tag 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
0
        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]
aeRecipientInfos)
        eci :: ASN1Stream ASN1P
eci = forall e alg.
(ASN1Elem e, ProduceASN1Object e alg) =>
(ContentType, alg, Encap ByteString) -> ASN1Stream e
encryptedContentInfoASN1S
                  (ContentType
aeContentType, ASN1ObjectExact AuthContentEncryptionParams
aeContentEncryptionParams, Encap ByteString
aeEncryptedContent)
        aa :: ASN1Stream ASN1P
aa  = forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) [Attribute]
aeAuthAttrs
        tag :: ASN1Stream ASN1P
tag = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert MessageAuthenticationCode
aeMAC)
        ua :: ASN1Stream ASN1P
ua  = forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2) [Attribute]
aeUnauthAttrs

        oi :: ASN1Stream ASN1P
oi | OriginatorInfo
aeOriginatorInfo 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
aeOriginatorInfo

instance ParseASN1Object [ASN1Event] (AuthEnvelopedData (Encap EncryptedContent)) where
    parse :: ParseASN1 [ASN1Event] (AuthEnvelopedData (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. Eq a => a -> a -> Bool
/= Integer
0) forall a b. (a -> b) -> a -> b
$
                forall e a. String -> ParseASN1 e a
throwParseError (String
"AuthEnvelopedData: 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, ASN1ObjectExact AuthContentEncryptionParams
params, Encap ByteString
ec) <- forall e alg.
ParseASN1Object e alg =>
ParseASN1 e (ContentType, alg, Encap ByteString)
parseEncryptedContentInfo
            [Attribute]
aAttrs <- forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
            OctetString ByteString
tag <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            [Attribute]
uAttrs <- forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2)
            forall (m :: * -> *) a. Monad m => a -> m a
return AuthEnvelopedData { aeOriginatorInfo :: OriginatorInfo
aeOriginatorInfo = OriginatorInfo
oi
                                     , aeContentType :: ContentType
aeContentType = ContentType
ct
                                     , aeRecipientInfos :: [RecipientInfo]
aeRecipientInfos = [RecipientInfo]
ris
                                     , aeContentEncryptionParams :: ASN1ObjectExact AuthContentEncryptionParams
aeContentEncryptionParams = ASN1ObjectExact AuthContentEncryptionParams
params
                                     , aeEncryptedContent :: Encap ByteString
aeEncryptedContent = Encap ByteString
ec
                                     , aeAuthAttrs :: [Attribute]
aeAuthAttrs = [Attribute]
aAttrs
                                     , aeMAC :: MessageAuthenticationCode
aeMAC = Bytes -> MessageAuthenticationCode
AuthTag forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
tag
                                     , aeUnauthAttrs :: [Attribute]
aeUnauthAttrs = [Attribute]
uAttrs
                                     }

-- | Return the DER encoding of the attributes as required for AAD.
encodeAuthAttrs :: [Attribute] -> ByteString
encodeAuthAttrs :: [Attribute] -> ByteString
encodeAuthAttrs [] = forall a. Monoid a => a
mempty
encodeAuthAttrs [Attribute]
l  = ASN1Stream ASN1P -> ByteString
encodeASN1S forall a b. (a -> b) -> a -> b
$ forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Set (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s [Attribute]
l)