-- |
-- 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
    ( EncapsulatedContent
    , 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
[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
$cshowsPrec :: forall content.
Show content =>
Int -> AuthenticatedData content -> ShowS
showsPrec :: Int -> AuthenticatedData content -> ShowS
$cshow :: forall content. Show content => AuthenticatedData content -> String
show :: AuthenticatedData content -> String
$cshowList :: forall content.
Show content =>
[AuthenticatedData content] -> ShowS
showList :: [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
$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
/= :: 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
adOriginatorInfo :: forall content. AuthenticatedData content -> OriginatorInfo
adRecipientInfos :: forall content. AuthenticatedData content -> [RecipientInfo]
adMACAlgorithm :: forall content. AuthenticatedData content -> MACAlgorithm
adDigestAlgorithm :: forall content. AuthenticatedData content -> Maybe DigestAlgorithm
adContentType :: forall content. AuthenticatedData content -> ContentType
adEncapsulatedContent :: forall content. AuthenticatedData content -> content
adAuthAttrs :: forall content. AuthenticatedData content -> [Attribute]
adMAC :: forall content.
AuthenticatedData content -> MessageAuthenticationCode
adUnauthAttrs :: forall content. AuthenticatedData content -> [Attribute]
adOriginatorInfo :: OriginatorInfo
adRecipientInfos :: [RecipientInfo]
adMACAlgorithm :: MACAlgorithm
adDigestAlgorithm :: Maybe DigestAlgorithm
adContentType :: ContentType
adEncapsulatedContent :: Encap EncapsulatedContent
adAuthAttrs :: [Attribute]
adMAC :: MessageAuthenticationCode
adUnauthAttrs :: [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
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 v <- ParseASN1 [ASN1Event] ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            when (v `notElem` [0, 1, 3]) $
                throwParseError ("AuthenticatedData: parsed invalid version: " ++ show v)
            oi <- parseOriginatorInfo (Container Context 0) <|> return mempty
            ris <- onNextContainer Set parse
            alg <- parseAlgorithm Sequence
            dig <- parseAlgorithmMaybe (Container Context 1)
            (ct, bs) <- parseEncapsulatedContentInfo
            aAttrs <- parseAttributes (Container Context 2)
            OctetString tag <- getNext
            uAttrs <- parseAttributes (Container Context 3)
            return AuthenticatedData { adOriginatorInfo = oi
                                     , adRecipientInfos = ris
                                     , adMACAlgorithm = alg
                                     , adDigestAlgorithm = dig
                                     , adContentType = ct
                                     , adEncapsulatedContent = bs
                                     , adAuthAttrs = aAttrs
                                     , adMAC = AuthTag $ B.convert tag
                                     , adUnauthAttrs = uAttrs
                                     }