-- |
-- 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
    { forall content. AuthenticatedData content -> OriginatorInfo
adOriginatorInfo :: OriginatorInfo
      -- ^ Optional information about the originator
    , forall content. AuthenticatedData content -> [RecipientInfo]
adRecipientInfos :: [RecipientInfo]
      -- ^ Information for recipients, allowing to authenticate the content
    , forall content. AuthenticatedData content -> MACAlgorithm
adMACAlgorithm :: MACAlgorithm
      -- ^ MAC algorithm
    , forall content. AuthenticatedData content -> Maybe DigestAlgorithm
adDigestAlgorithm :: Maybe DigestAlgorithm
      -- ^ Optional digest algorithm
    , forall content. AuthenticatedData content -> ContentType
adContentType :: ContentType
      -- ^ Inner content type
    , forall content. AuthenticatedData content -> content
adEncapsulatedContent :: content
      -- ^ Encapsulated content
    , forall content. AuthenticatedData content -> [Attribute]
adAuthAttrs :: [Attribute]
      -- ^ Optional authenticated attributes
    , forall content.
AuthenticatedData content -> MessageAuthenticationCode
adMAC :: MessageAuthenticationCode
      -- ^ Message authentication code
    , forall content. AuthenticatedData content -> [Attribute]
adUnauthAttrs :: [Attribute]
      -- ^ Optional unauthenticated attributes
    }
    deriving (Int -> AuthenticatedData content -> ShowS
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
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
..} =
        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
alg forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
dig forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
ci 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
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]
adRecipientInfos)
        alg :: ASN1Stream ASN1P
alg = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence MACAlgorithm
adMACAlgorithm
        dig :: ASN1Stream ASN1P
dig = 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  = forall e.
ASN1Elem e =>
ContentType -> Encap EncapsulatedContent -> ASN1Stream e
encapsulatedContentInfoASN1S ContentType
adContentType Encap EncapsulatedContent
adEncapsulatedContent
        aa :: ASN1Stream ASN1P
aa  = forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S(ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2) [Attribute]
adAuthAttrs
        tag :: ASN1Stream ASN1P
tag = forall e. ASN1Elem e => EncapsulatedContent -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert MessageAuthenticationCode
adMAC)
        ua :: ASN1Stream ASN1P
ua  = 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 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
adOriginatorInfo

        v :: Integer
v | 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 =
        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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Integer
0, Integer
1, Integer
3]) forall a b. (a -> b) -> a -> b
$
                forall e a. String -> ParseASN1 e a
throwParseError (String
"AuthenticatedData: 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
            MACAlgorithm
alg <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
            Maybe DigestAlgorithm
dig <- 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) <- forall e.
Monoid e =>
ParseASN1 e (ContentType, Encap EncapsulatedContent)
parseEncapsulatedContentInfo
            [Attribute]
aAttrs <- forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2)
            OctetString EncapsulatedContent
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
3)
            forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert EncapsulatedContent
tag
                                     , adUnauthAttrs :: [Attribute]
adUnauthAttrs = [Attribute]
uAttrs
                                     }