-- |
-- Module      : Crypto.Store.CMS.Digested
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
--
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
module Crypto.Store.CMS.Digested
    ( DigestedData(..)
    ) where

import Control.Monad

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

import Crypto.Hash hiding (MD5)

import Crypto.Store.ASN1.Generate
import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS.Algorithms
import Crypto.Store.CMS.Signed
import Crypto.Store.CMS.Type
import Crypto.Store.CMS.Util

-- | Digested content information.
data DigestedData content = forall hashAlg. HashAlgorithm hashAlg => DigestedData
    { ()
ddDigestAlgorithm :: DigestProxy hashAlg     -- ^ Digest algorithm
    , forall content. DigestedData content -> ContentType
ddContentType :: ContentType                 -- ^ Inner content type
    , forall content. DigestedData content -> content
ddEncapsulatedContent :: content             -- ^ Encapsulated content
    , ()
ddDigest :: Digest hashAlg                   -- ^ Digest value
    }

instance Show content => Show (DigestedData content) where
    showsPrec :: Int -> DigestedData content -> ShowS
showsPrec Int
d DigestedData{content
Digest hashAlg
ContentType
DigestProxy hashAlg
ddDigest :: Digest hashAlg
ddEncapsulatedContent :: content
ddContentType :: ContentType
ddDigestAlgorithm :: DigestProxy hashAlg
ddDigest :: ()
ddEncapsulatedContent :: forall content. DigestedData content -> content
ddContentType :: forall content. DigestedData content -> ContentType
ddDigestAlgorithm :: ()
..} = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"DigestedData "
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"{ ddDigestAlgorithm = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows DigestProxy hashAlg
ddDigestAlgorithm
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", ddContentType = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows ContentType
ddContentType
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", ddEncapsulatedContent = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows content
ddEncapsulatedContent
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", ddDigest = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Digest hashAlg
ddDigest
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" }"

instance Eq content => Eq (DigestedData content) where
    DigestedData DigestProxy hashAlg
a1 ContentType
t1 content
e1 Digest hashAlg
d1 == :: DigestedData content -> DigestedData content -> Bool
== DigestedData DigestProxy hashAlg
a2 ContentType
t2 content
e2 Digest hashAlg
d2 =
        forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
a1 forall a. Eq a => a -> a -> Bool
== forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
a2 Bool -> Bool -> Bool
&& Digest hashAlg
d1 forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`B.eq` Digest hashAlg
d2 Bool -> Bool -> Bool
&& ContentType
t1 forall a. Eq a => a -> a -> Bool
== ContentType
t2 Bool -> Bool -> Bool
&& content
e1 forall a. Eq a => a -> a -> Bool
== content
e2

instance ASN1Elem e => ProduceASN1Object e (DigestedData (Encap EncapsulatedContent)) where
    asn1s :: DigestedData (Encap EncapsulatedContent) -> ASN1Stream e
asn1s DigestedData{Digest hashAlg
Encap EncapsulatedContent
ContentType
DigestProxy hashAlg
ddDigest :: Digest hashAlg
ddEncapsulatedContent :: Encap EncapsulatedContent
ddContentType :: ContentType
ddDigestAlgorithm :: DigestProxy hashAlg
ddDigest :: ()
ddEncapsulatedContent :: forall content. DigestedData content -> content
ddContentType :: forall content. DigestedData content -> ContentType
ddDigestAlgorithm :: ()
..} =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
alg forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ci forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
dig)
      where
        v :: Integer
v = if ContentType
ddContentType forall a. Eq a => a -> a -> Bool
== ContentType
DataType then Integer
0 else Integer
2
        d :: DigestAlgorithm
d = forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
ddDigestAlgorithm

        ver :: ASN1Stream e
ver = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
v
        alg :: ASN1Stream e
alg = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
d
        ci :: ASN1Stream e
ci  = forall e.
ASN1Elem e =>
ContentType -> Encap EncapsulatedContent -> ASN1Stream e
encapsulatedContentInfoASN1S ContentType
ddContentType Encap EncapsulatedContent
ddEncapsulatedContent
        dig :: ASN1Stream e
dig = forall e. ASN1Elem e => EncapsulatedContent -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Digest hashAlg
ddDigest)

instance Monoid e => ParseASN1Object e (DigestedData (Encap EncapsulatedContent)) where
    parse :: ParseASN1 e (DigestedData (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 a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
&& Integer
v forall a. Eq a => a -> a -> Bool
/= Integer
2) forall a b. (a -> b) -> a -> b
$
                forall e a. String -> ParseASN1 e a
throwParseError (String
"DigestedData: parsed invalid version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
v)
            DigestAlgorithm
alg <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
            (ContentType
ct, Encap EncapsulatedContent
bs) <- forall e.
Monoid e =>
ParseASN1 e (ContentType, Encap EncapsulatedContent)
parseEncapsulatedContentInfo
            OctetString EncapsulatedContent
digValue <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            case DigestAlgorithm
alg of
                DigestAlgorithm DigestProxy hashAlg
digAlg ->
                    case forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString EncapsulatedContent
digValue of
                        Maybe (Digest hashAlg)
Nothing -> forall e a. String -> ParseASN1 e a
throwParseError String
"DigestedData: parsed invalid digest"
                        Just Digest hashAlg
d  ->
                            forall (m :: * -> *) a. Monad m => a -> m a
return DigestedData { ddDigestAlgorithm :: DigestProxy hashAlg
ddDigestAlgorithm = DigestProxy hashAlg
digAlg
                                                , ddContentType :: ContentType
ddContentType = ContentType
ct
                                                , ddEncapsulatedContent :: Encap EncapsulatedContent
ddEncapsulatedContent = Encap EncapsulatedContent
bs
                                                , ddDigest :: Digest hashAlg
ddDigest = Digest hashAlg
d
                                                }