-- |
-- Module      : Crypto.Store.CMS.Authenticated
-- 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.Authenticated
    ( AuthenticatedData(..)
    ) where

import Control.Applicative
import Control.Monad

import           Data.ASN1.Types
import qualified Data.ByteArray as B

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

-- | Authenticated content information.
data AuthenticatedData content = AuthenticatedData
    { AuthenticatedData content -> OriginatorInfo
adOriginatorInfo :: OriginatorInfo
      -- ^ Optional information about the originator
    , AuthenticatedData content -> [RecipientInfo]
adRecipientInfos :: [RecipientInfo]
      -- ^ Information for recipients, allowing to authenticate the content
    , AuthenticatedData content -> MACAlgorithm
adMACAlgorithm :: MACAlgorithm
      -- ^ MAC algorithm
    , AuthenticatedData content -> Maybe DigestAlgorithm
adDigestAlgorithm :: Maybe DigestAlgorithm
      -- ^ Optional digest algorithm
    , AuthenticatedData content -> ContentType
adContentType :: ContentType
      -- ^ Inner content type
    , AuthenticatedData content -> content
adEncapsulatedContent :: content
      -- ^ Encapsulated content
    , AuthenticatedData content -> [Attribute]
adAuthAttrs :: [Attribute]
      -- ^ Optional authenticated attributes
    , AuthenticatedData content -> MessageAuthenticationCode
adMAC :: MessageAuthenticationCode
      -- ^ Message authentication code
    , AuthenticatedData content -> [Attribute]
adUnauthAttrs :: [Attribute]
      -- ^ Optional unauthenticated attributes
    }
    deriving (Int -> AuthenticatedData content -> ShowS
[AuthenticatedData content] -> ShowS
AuthenticatedData content -> String
(Int -> AuthenticatedData content -> ShowS)
-> (AuthenticatedData content -> String)
-> ([AuthenticatedData content] -> ShowS)
-> Show (AuthenticatedData content)
forall content.
Show content =>
Int -> AuthenticatedData content -> ShowS
forall content.
Show content =>
[AuthenticatedData content] -> ShowS
forall content. Show content => AuthenticatedData content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatedData content] -> ShowS
$cshowList :: forall content.
Show content =>
[AuthenticatedData content] -> ShowS
show :: AuthenticatedData content -> String
$cshow :: forall content. Show content => AuthenticatedData content -> String
showsPrec :: Int -> AuthenticatedData content -> ShowS
$cshowsPrec :: forall content.
Show content =>
Int -> AuthenticatedData content -> ShowS
Show,AuthenticatedData content -> AuthenticatedData content -> Bool
(AuthenticatedData content -> AuthenticatedData content -> Bool)
-> (AuthenticatedData content -> AuthenticatedData content -> Bool)
-> Eq (AuthenticatedData content)
forall content.
Eq content =>
AuthenticatedData content -> AuthenticatedData content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatedData content -> AuthenticatedData content -> Bool
$c/= :: forall content.
Eq content =>
AuthenticatedData content -> AuthenticatedData content -> Bool
== :: AuthenticatedData content -> AuthenticatedData content -> Bool
$c== :: forall content.
Eq content =>
AuthenticatedData content -> AuthenticatedData content -> Bool
Eq)

instance ProduceASN1Object ASN1P (AuthenticatedData (Encap EncapsulatedContent)) where
    asn1s :: AuthenticatedData (Encap EncapsulatedContent) -> ASN1Stream ASN1P
asn1s AuthenticatedData{[Attribute]
[RecipientInfo]
Maybe DigestAlgorithm
MessageAuthenticationCode
Encap EncapsulatedContent
ContentType
OriginatorInfo
MACAlgorithm
adUnauthAttrs :: [Attribute]
adMAC :: MessageAuthenticationCode
adAuthAttrs :: [Attribute]
adEncapsulatedContent :: Encap EncapsulatedContent
adContentType :: ContentType
adDigestAlgorithm :: Maybe DigestAlgorithm
adMACAlgorithm :: MACAlgorithm
adRecipientInfos :: [RecipientInfo]
adOriginatorInfo :: OriginatorInfo
adUnauthAttrs :: forall content. AuthenticatedData content -> [Attribute]
adMAC :: forall content.
AuthenticatedData content -> MessageAuthenticationCode
adAuthAttrs :: forall content. AuthenticatedData content -> [Attribute]
adEncapsulatedContent :: forall content. AuthenticatedData content -> content
adContentType :: forall content. AuthenticatedData content -> ContentType
adDigestAlgorithm :: forall content. AuthenticatedData content -> Maybe DigestAlgorithm
adMACAlgorithm :: forall content. AuthenticatedData content -> MACAlgorithm
adRecipientInfos :: forall content. AuthenticatedData content -> [RecipientInfo]
adOriginatorInfo :: forall content. AuthenticatedData content -> OriginatorInfo
..} =
        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
alg ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
dig ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
ci 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
v
        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]
adRecipientInfos)
        alg :: ASN1Stream ASN1P
alg = ASN1ConstructionType -> MACAlgorithm -> ASN1Stream ASN1P
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence MACAlgorithm
adMACAlgorithm
        dig :: ASN1Stream ASN1P
dig = ASN1ConstructionType -> Maybe DigestAlgorithm -> ASN1Stream ASN1P
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> Maybe param -> ASN1Stream e
algorithmMaybeASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) Maybe DigestAlgorithm
adDigestAlgorithm
        ci :: ASN1Stream ASN1P
ci  = ContentType -> Encap EncapsulatedContent -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ContentType -> Encap EncapsulatedContent -> ASN1Stream e
encapsulatedContentInfoASN1S ContentType
adContentType Encap EncapsulatedContent
adEncapsulatedContent
        aa :: ASN1Stream ASN1P
aa  = ASN1ConstructionType -> [Attribute] -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S(ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2) [Attribute]
adAuthAttrs
        tag :: ASN1Stream ASN1P
tag = EncapsulatedContent -> ASN1Stream ASN1P
forall e. ASN1Elem e => EncapsulatedContent -> ASN1Stream e
gOctetString (MessageAuthenticationCode -> EncapsulatedContent
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert MessageAuthenticationCode
adMAC)
        ua :: ASN1Stream ASN1P
ua  = ASN1ConstructionType -> [Attribute] -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
3) [Attribute]
adUnauthAttrs

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

        v :: Integer
v | OriginatorInfo -> Bool
forall a. HasChoiceOther a => a -> Bool
hasChoiceOther OriginatorInfo
adOriginatorInfo = Integer
3
          | Bool
otherwise                       = Integer
0

instance ParseASN1Object [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent)) where
    parse :: ParseASN1
  [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent))
parse =
        ASN1ConstructionType
-> ParseASN1
     [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent))
-> ParseASN1
     [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent))
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1
   [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent))
 -> ParseASN1
      [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent)))
-> ParseASN1
     [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent))
-> ParseASN1
     [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent))
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Integer
0, Integer
1, Integer
3]) (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
"AuthenticatedData: 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
            MACAlgorithm
alg <- ASN1ConstructionType -> ParseASN1 [ASN1Event] MACAlgorithm
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
            Maybe DigestAlgorithm
dig <- ASN1ConstructionType
-> ParseASN1 [ASN1Event] (Maybe DigestAlgorithm)
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e (Maybe param)
parseAlgorithmMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
            (ContentType
ct, Encap EncapsulatedContent
bs) <- ParseASN1 [ASN1Event] (ContentType, Encap EncapsulatedContent)
forall e.
Monoid e =>
ParseASN1 e (ContentType, Encap EncapsulatedContent)
parseEncapsulatedContentInfo
            [Attribute]
aAttrs <- ASN1ConstructionType -> ParseASN1 [ASN1Event] [Attribute]
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2)
            OctetString EncapsulatedContent
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
3)
            AuthenticatedData (Encap EncapsulatedContent)
-> ParseASN1
     [ASN1Event] (AuthenticatedData (Encap EncapsulatedContent))
forall (m :: * -> *) a. Monad m => a -> m a
return AuthenticatedData :: forall content.
OriginatorInfo
-> [RecipientInfo]
-> MACAlgorithm
-> Maybe DigestAlgorithm
-> ContentType
-> content
-> [Attribute]
-> MessageAuthenticationCode
-> [Attribute]
-> AuthenticatedData content
AuthenticatedData { adOriginatorInfo :: OriginatorInfo
adOriginatorInfo = OriginatorInfo
oi
                                     , adRecipientInfos :: [RecipientInfo]
adRecipientInfos = [RecipientInfo]
ris
                                     , adMACAlgorithm :: MACAlgorithm
adMACAlgorithm = MACAlgorithm
alg
                                     , adDigestAlgorithm :: Maybe DigestAlgorithm
adDigestAlgorithm = Maybe DigestAlgorithm
dig
                                     , adContentType :: ContentType
adContentType = ContentType
ct
                                     , adEncapsulatedContent :: Encap EncapsulatedContent
adEncapsulatedContent = Encap EncapsulatedContent
bs
                                     , adAuthAttrs :: [Attribute]
adAuthAttrs = [Attribute]
aAttrs
                                     , adMAC :: MessageAuthenticationCode
adMAC = Bytes -> MessageAuthenticationCode
AuthTag (Bytes -> MessageAuthenticationCode)
-> Bytes -> MessageAuthenticationCode
forall a b. (a -> b) -> a -> b
$ EncapsulatedContent -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert EncapsulatedContent
tag
                                     , adUnauthAttrs :: [Attribute]
adUnauthAttrs = [Attribute]
uAttrs
                                     }