-- |
-- 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
ddDigestAlgorithm :: ()
ddContentType :: forall content. DigestedData content -> ContentType
ddEncapsulatedContent :: forall content. DigestedData content -> content
ddDigest :: ()
ddDigestAlgorithm :: DigestProxy hashAlg
ddContentType :: ContentType
ddEncapsulatedContent :: content
ddDigest :: Digest hashAlg
..} = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"DigestedData "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"{ ddDigestAlgorithm = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DigestProxy hashAlg -> ShowS
forall a. Show a => a -> ShowS
shows DigestProxy hashAlg
ddDigestAlgorithm
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", ddContentType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentType -> ShowS
forall a. Show a => a -> ShowS
shows ContentType
ddContentType
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", ddEncapsulatedContent = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. content -> ShowS
forall a. Show a => a -> ShowS
shows content
ddEncapsulatedContent
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", ddDigest = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest hashAlg -> ShowS
forall a. Show a => a -> ShowS
shows Digest hashAlg
ddDigest
            ShowS -> ShowS -> ShowS
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 =
        DigestProxy hashAlg -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
a1 DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestProxy hashAlg -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
a2 Bool -> Bool -> Bool
&& Digest hashAlg
d1 Digest hashAlg -> Digest hashAlg -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`B.eq` Digest hashAlg
d2 Bool -> Bool -> Bool
&& ContentType
t1 ContentType -> ContentType -> Bool
forall a. Eq a => a -> a -> Bool
== ContentType
t2 Bool -> Bool -> Bool
&& content
e1 content -> content -> Bool
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
ddDigestAlgorithm :: ()
ddContentType :: forall content. DigestedData content -> ContentType
ddEncapsulatedContent :: forall content. DigestedData content -> content
ddDigest :: ()
ddDigestAlgorithm :: DigestProxy hashAlg
ddContentType :: ContentType
ddEncapsulatedContent :: Encap EncapsulatedContent
ddDigest :: Digest hashAlg
..} =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
ver ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
alg ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ci ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
dig)
      where
        v :: Integer
v = if ContentType
ddContentType ContentType -> ContentType -> Bool
forall a. Eq a => a -> a -> Bool
== ContentType
DataType then Integer
0 else Integer
2
        d :: DigestAlgorithm
d = DigestProxy hashAlg -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
ddDigestAlgorithm

        ver :: ASN1Stream e
ver = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
v
        alg :: ASN1Stream e
alg = ASN1ConstructionType -> DigestAlgorithm -> ASN1Stream e
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
d
        ci :: ASN1Stream e
ci  = ContentType -> Encap EncapsulatedContent -> ASN1Stream e
forall e.
ASN1Elem e =>
ContentType -> Encap EncapsulatedContent -> ASN1Stream e
encapsulatedContentInfoASN1S ContentType
ddContentType Encap EncapsulatedContent
ddEncapsulatedContent
        dig :: ASN1Stream e
dig = EncapsulatedContent -> ASN1Stream e
forall e. ASN1Elem e => EncapsulatedContent -> ASN1Stream e
gOctetString (Digest hashAlg -> EncapsulatedContent
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 =
        ASN1ConstructionType
-> ParseASN1 e (DigestedData (Encap EncapsulatedContent))
-> ParseASN1 e (DigestedData (Encap EncapsulatedContent))
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (DigestedData (Encap EncapsulatedContent))
 -> ParseASN1 e (DigestedData (Encap EncapsulatedContent)))
-> ParseASN1 e (DigestedData (Encap EncapsulatedContent))
-> ParseASN1 e (DigestedData (Encap EncapsulatedContent))
forall a b. (a -> b) -> a -> b
$ do
            IntVal Integer
v <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            Bool -> ParseASN1 e () -> ParseASN1 e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
&& Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
2) (ParseASN1 e () -> ParseASN1 e ())
-> ParseASN1 e () -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$
                String -> ParseASN1 e ()
forall e a. String -> ParseASN1 e a
throwParseError (String
"DigestedData: parsed invalid version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
v)
            DigestAlgorithm
alg <- ASN1ConstructionType -> ParseASN1 e DigestAlgorithm
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
            (ContentType
ct, Encap EncapsulatedContent
bs) <- ParseASN1 e (ContentType, Encap EncapsulatedContent)
forall e.
Monoid e =>
ParseASN1 e (ContentType, Encap EncapsulatedContent)
parseEncapsulatedContentInfo
            OctetString EncapsulatedContent
digValue <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            case DigestAlgorithm
alg of
                DigestAlgorithm DigestProxy hashAlg
digAlg ->
                    case EncapsulatedContent -> Maybe (Digest hashAlg)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString EncapsulatedContent
digValue of
                        Maybe (Digest hashAlg)
Nothing -> String -> ParseASN1 e (DigestedData (Encap EncapsulatedContent))
forall e a. String -> ParseASN1 e a
throwParseError String
"DigestedData: parsed invalid digest"
                        Just Digest hashAlg
d  ->
                            DigestedData (Encap EncapsulatedContent)
-> ParseASN1 e (DigestedData (Encap EncapsulatedContent))
forall a. a -> ParseASN1 e a
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
                                                }