-- |
-- 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
    { AuthEnvelopedData content -> OriginatorInfo
aeOriginatorInfo :: OriginatorInfo
      -- ^ Optional information about the originator
    , AuthEnvelopedData content -> [RecipientInfo]
aeRecipientInfos :: [RecipientInfo]
      -- ^ Information for recipients, allowing to decrypt the content
    , AuthEnvelopedData content -> ContentType
aeContentType :: ContentType
      -- ^ Inner content type
    , AuthEnvelopedData content
-> ASN1ObjectExact AuthContentEncryptionParams
aeContentEncryptionParams :: ASN1ObjectExact AuthContentEncryptionParams
      -- ^ Encryption algorithm
    , AuthEnvelopedData content -> content
aeEncryptedContent :: content
      -- ^ Encrypted content info
    , AuthEnvelopedData content -> [Attribute]
aeAuthAttrs :: [Attribute]
      -- ^ Optional authenticated attributes
    , AuthEnvelopedData content -> MessageAuthenticationCode
aeMAC :: MessageAuthenticationCode
      -- ^ Message authentication code
    , AuthEnvelopedData content -> [Attribute]
aeUnauthAttrs :: [Attribute]
      -- ^ Optional unauthenticated attributes
    }
    deriving (Int -> AuthEnvelopedData content -> ShowS
[AuthEnvelopedData content] -> ShowS
AuthEnvelopedData content -> String
(Int -> AuthEnvelopedData content -> ShowS)
-> (AuthEnvelopedData content -> String)
-> ([AuthEnvelopedData content] -> ShowS)
-> Show (AuthEnvelopedData content)
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
(AuthEnvelopedData content -> AuthEnvelopedData content -> Bool)
-> (AuthEnvelopedData content -> AuthEnvelopedData content -> Bool)
-> Eq (AuthEnvelopedData content)
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 EncryptedContent) -> ASN1Stream ASN1P
asn1s AuthEnvelopedData{[Attribute]
[RecipientInfo]
MessageAuthenticationCode
ASN1ObjectExact AuthContentEncryptionParams
Encap EncryptedContent
ContentType
OriginatorInfo
aeUnauthAttrs :: [Attribute]
aeMAC :: MessageAuthenticationCode
aeAuthAttrs :: [Attribute]
aeEncryptedContent :: Encap EncryptedContent
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
..} =
        ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream ASN1P
ver ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
oi ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
ris ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
eci ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
aa ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
tag ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
ua)
      where
        ver :: ASN1Stream ASN1P
ver = Integer -> ASN1Stream ASN1P
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
0
        ris :: ASN1Stream ASN1P
ris = ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Set ([RecipientInfo] -> ASN1Stream ASN1P
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s [RecipientInfo]
aeRecipientInfos)
        eci :: ASN1Stream ASN1P
eci = (ContentType, ASN1ObjectExact AuthContentEncryptionParams,
 Encap EncryptedContent)
-> ASN1Stream ASN1P
forall e alg.
(ASN1Elem e, ProduceASN1Object e alg) =>
(ContentType, alg, Encap EncryptedContent) -> ASN1Stream e
encryptedContentInfoASN1S
                  (ContentType
aeContentType, ASN1ObjectExact AuthContentEncryptionParams
aeContentEncryptionParams, Encap EncryptedContent
aeEncryptedContent)
        aa :: ASN1Stream ASN1P
aa  = ASN1ConstructionType -> [Attribute] -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) [Attribute]
aeAuthAttrs
        tag :: ASN1Stream ASN1P
tag = EncryptedContent -> ASN1Stream ASN1P
forall e. ASN1Elem e => EncryptedContent -> ASN1Stream e
gOctetString (MessageAuthenticationCode -> EncryptedContent
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert MessageAuthenticationCode
aeMAC)
        ua :: ASN1Stream ASN1P
ua  = ASN1ConstructionType -> [Attribute] -> ASN1Stream ASN1P
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 OriginatorInfo -> OriginatorInfo -> Bool
forall a. Eq a => a -> a -> Bool
== OriginatorInfo
forall a. Monoid a => a
mempty = ASN1Stream ASN1P
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 EncryptedContent))
parse =
        ASN1ConstructionType
-> ParseASN1
     [ASN1Event] (AuthEnvelopedData (Encap EncryptedContent))
-> ParseASN1
     [ASN1Event] (AuthEnvelopedData (Encap EncryptedContent))
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 [ASN1Event] (AuthEnvelopedData (Encap EncryptedContent))
 -> ParseASN1
      [ASN1Event] (AuthEnvelopedData (Encap EncryptedContent)))
-> ParseASN1
     [ASN1Event] (AuthEnvelopedData (Encap EncryptedContent))
-> ParseASN1
     [ASN1Event] (AuthEnvelopedData (Encap EncryptedContent))
forall a b. (a -> b) -> a -> b
$ do
            IntVal Integer
v <- ParseASN1 [ASN1Event] ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            Bool -> ParseASN1 [ASN1Event] () -> ParseASN1 [ASN1Event] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) (ParseASN1 [ASN1Event] () -> ParseASN1 [ASN1Event] ())
-> ParseASN1 [ASN1Event] () -> ParseASN1 [ASN1Event] ()
forall a b. (a -> b) -> a -> b
$
                String -> ParseASN1 [ASN1Event] ()
forall e a. String -> ParseASN1 e a
throwParseError (String
"AuthEnvelopedData: parsed invalid version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
v)
            OriginatorInfo
oi <- ASN1ConstructionType -> ParseASN1 [ASN1Event] OriginatorInfo
parseOriginatorInfo (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ParseASN1 [ASN1Event] OriginatorInfo
-> ParseASN1 [ASN1Event] OriginatorInfo
-> ParseASN1 [ASN1Event] OriginatorInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OriginatorInfo -> ParseASN1 [ASN1Event] OriginatorInfo
forall (m :: * -> *) a. Monad m => a -> m a
return OriginatorInfo
forall a. Monoid a => a
mempty
            [RecipientInfo]
ris <- ASN1ConstructionType
-> ParseASN1 [ASN1Event] [RecipientInfo]
-> ParseASN1 [ASN1Event] [RecipientInfo]
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Set ParseASN1 [ASN1Event] [RecipientInfo]
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
            (ContentType
ct, ASN1ObjectExact AuthContentEncryptionParams
params, Encap EncryptedContent
ec) <- ParseASN1
  [ASN1Event]
  (ContentType, ASN1ObjectExact AuthContentEncryptionParams,
   Encap EncryptedContent)
forall e alg.
ParseASN1Object e alg =>
ParseASN1 e (ContentType, alg, Encap EncryptedContent)
parseEncryptedContentInfo
            [Attribute]
aAttrs <- ASN1ConstructionType -> ParseASN1 [ASN1Event] [Attribute]
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
            OctetString EncryptedContent
tag <- ParseASN1 [ASN1Event] ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            [Attribute]
uAttrs <- ASN1ConstructionType -> ParseASN1 [ASN1Event] [Attribute]
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2)
            AuthEnvelopedData (Encap EncryptedContent)
-> ParseASN1
     [ASN1Event] (AuthEnvelopedData (Encap EncryptedContent))
forall (m :: * -> *) a. Monad m => a -> m a
return AuthEnvelopedData :: forall content.
OriginatorInfo
-> [RecipientInfo]
-> ContentType
-> ASN1ObjectExact AuthContentEncryptionParams
-> content
-> [Attribute]
-> MessageAuthenticationCode
-> [Attribute]
-> AuthEnvelopedData content
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 EncryptedContent
aeEncryptedContent = Encap EncryptedContent
ec
                                     , aeAuthAttrs :: [Attribute]
aeAuthAttrs = [Attribute]
aAttrs
                                     , aeMAC :: MessageAuthenticationCode
aeMAC = Bytes -> MessageAuthenticationCode
AuthTag (Bytes -> MessageAuthenticationCode)
-> Bytes -> MessageAuthenticationCode
forall a b. (a -> b) -> a -> b
$ EncryptedContent -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert EncryptedContent
tag
                                     , aeUnauthAttrs :: [Attribute]
aeUnauthAttrs = [Attribute]
uAttrs
                                     }

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