-- |
-- 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
[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
$cshowsPrec :: forall content.
Show content =>
Int -> AuthEnvelopedData content -> ShowS
showsPrec :: Int -> AuthEnvelopedData content -> ShowS
$cshow :: forall content. Show content => AuthEnvelopedData content -> String
show :: AuthEnvelopedData content -> String
$cshowList :: forall content.
Show content =>
[AuthEnvelopedData content] -> ShowS
showList :: [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
$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
/= :: 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
aeOriginatorInfo :: forall content. AuthEnvelopedData content -> OriginatorInfo
aeRecipientInfos :: forall content. AuthEnvelopedData content -> [RecipientInfo]
aeContentType :: forall content. AuthEnvelopedData content -> ContentType
aeContentEncryptionParams :: forall content.
AuthEnvelopedData content
-> ASN1ObjectExact AuthContentEncryptionParams
aeEncryptedContent :: forall content. AuthEnvelopedData content -> content
aeAuthAttrs :: forall content. AuthEnvelopedData content -> [Attribute]
aeMAC :: forall content.
AuthEnvelopedData content -> MessageAuthenticationCode
aeUnauthAttrs :: forall content. AuthEnvelopedData content -> [Attribute]
aeOriginatorInfo :: OriginatorInfo
aeRecipientInfos :: [RecipientInfo]
aeContentType :: ContentType
aeContentEncryptionParams :: ASN1ObjectExact AuthContentEncryptionParams
aeEncryptedContent :: Encap ByteString
aeAuthAttrs :: [Attribute]
aeMAC :: MessageAuthenticationCode
aeUnauthAttrs :: [Attribute]
..} =
        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 ByteString)
-> ASN1Stream ASN1P
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  = 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 = ByteString -> ASN1Stream ASN1P
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (MessageAuthenticationCode -> ByteString
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 ByteString))
parse =
        ASN1ConstructionType
-> ParseASN1 [ASN1Event] (AuthEnvelopedData (Encap ByteString))
-> ParseASN1 [ASN1Event] (AuthEnvelopedData (Encap ByteString))
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 [ASN1Event] (AuthEnvelopedData (Encap ByteString))
 -> ParseASN1 [ASN1Event] (AuthEnvelopedData (Encap ByteString)))
-> ParseASN1 [ASN1Event] (AuthEnvelopedData (Encap ByteString))
-> ParseASN1 [ASN1Event] (AuthEnvelopedData (Encap ByteString))
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 a.
ParseASN1 [ASN1Event] a
-> ParseASN1 [ASN1Event] a -> ParseASN1 [ASN1Event] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OriginatorInfo -> ParseASN1 [ASN1Event] OriginatorInfo
forall a. a -> ParseASN1 [ASN1Event] a
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 ByteString
ec) <- ParseASN1
  [ASN1Event]
  (ContentType, ASN1ObjectExact AuthContentEncryptionParams,
   Encap ByteString)
forall e alg.
ParseASN1Object e alg =>
ParseASN1 e (ContentType, alg, Encap ByteString)
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 ByteString
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 ByteString)
-> ParseASN1 [ASN1Event] (AuthEnvelopedData (Encap ByteString))
forall a. a -> ParseASN1 [ASN1Event] a
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 (Bytes -> MessageAuthenticationCode)
-> Bytes -> MessageAuthenticationCode
forall a b. (a -> b) -> a -> b
$ ByteString -> Bytes
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 [] = ByteString
forall a. Monoid a => a
mempty
encodeAuthAttrs [Attribute]
l  = ASN1Stream ASN1P -> ByteString
encodeASN1S (ASN1Stream ASN1P -> ByteString) -> ASN1Stream ASN1P -> ByteString
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)