-- |
-- Module      : Crypto.Store.CMS.Encrypted
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
--
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
module Crypto.Store.CMS.Encrypted
    ( EncryptedContent
    , ContentEncryptionKey
    , EncryptedData(..)
    , encryptedContentInfoASN1S
    , parseEncryptedContentInfo
    ) where

import Control.Applicative
import Control.Monad

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

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

-- | Key used for content encryption.
type ContentEncryptionKey = B.ByteString

-- | Encrypted content.
type EncryptedContent = B.ByteString

-- | Encrypted content information.
data EncryptedData content = EncryptedData
    { forall content. EncryptedData content -> ContentType
edContentType :: ContentType
      -- ^ Inner content type
    , forall content. EncryptedData content -> ContentEncryptionParams
edContentEncryptionParams :: ContentEncryptionParams
      -- ^ Encryption algorithm
    , forall content. EncryptedData content -> content
edEncryptedContent :: content
      -- ^ Encrypted content info
    , forall content. EncryptedData content -> [Attribute]
edUnprotectedAttrs :: [Attribute]
      -- ^ Optional unprotected attributes
    }
    deriving (Int -> EncryptedData content -> ShowS
[EncryptedData content] -> ShowS
EncryptedData content -> String
(Int -> EncryptedData content -> ShowS)
-> (EncryptedData content -> String)
-> ([EncryptedData content] -> ShowS)
-> Show (EncryptedData content)
forall content.
Show content =>
Int -> EncryptedData content -> ShowS
forall content. Show content => [EncryptedData content] -> ShowS
forall content. Show content => EncryptedData content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall content.
Show content =>
Int -> EncryptedData content -> ShowS
showsPrec :: Int -> EncryptedData content -> ShowS
$cshow :: forall content. Show content => EncryptedData content -> String
show :: EncryptedData content -> String
$cshowList :: forall content. Show content => [EncryptedData content] -> ShowS
showList :: [EncryptedData content] -> ShowS
Show,EncryptedData content -> EncryptedData content -> Bool
(EncryptedData content -> EncryptedData content -> Bool)
-> (EncryptedData content -> EncryptedData content -> Bool)
-> Eq (EncryptedData content)
forall content.
Eq content =>
EncryptedData content -> EncryptedData content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall content.
Eq content =>
EncryptedData content -> EncryptedData content -> Bool
== :: EncryptedData content -> EncryptedData content -> Bool
$c/= :: forall content.
Eq content =>
EncryptedData content -> EncryptedData content -> Bool
/= :: EncryptedData content -> EncryptedData content -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e (EncryptedData (Encap EncryptedContent)) where
    asn1s :: EncryptedData (Encap EncryptedContent) -> ASN1Stream e
asn1s EncryptedData{[Attribute]
Encap EncryptedContent
ContentType
ContentEncryptionParams
edContentType :: forall content. EncryptedData content -> ContentType
edContentEncryptionParams :: forall content. EncryptedData content -> ContentEncryptionParams
edEncryptedContent :: forall content. EncryptedData content -> content
edUnprotectedAttrs :: forall content. EncryptedData content -> [Attribute]
edContentType :: ContentType
edContentEncryptionParams :: ContentEncryptionParams
edEncryptedContent :: Encap EncryptedContent
edUnprotectedAttrs :: [Attribute]
..} =
        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
eci ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ua)
      where
        ver :: ASN1Stream e
ver = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (if [Attribute] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
edUnprotectedAttrs then Integer
0 else Integer
2)
        eci :: ASN1Stream e
eci = (ContentType, ContentEncryptionParams, Encap EncryptedContent)
-> ASN1Stream e
forall e alg.
(ASN1Elem e, ProduceASN1Object e alg) =>
(ContentType, alg, Encap EncryptedContent) -> ASN1Stream e
encryptedContentInfoASN1S
                  (ContentType
edContentType, ContentEncryptionParams
edContentEncryptionParams, Encap EncryptedContent
edEncryptedContent)
        ua :: ASN1Stream e
ua  = ASN1ConstructionType -> [Attribute] -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) [Attribute]
edUnprotectedAttrs

instance Monoid e => ParseASN1Object e (EncryptedData (Encap EncryptedContent)) where
    parse :: ParseASN1 e (EncryptedData (Encap EncryptedContent))
parse =
        ASN1ConstructionType
-> ParseASN1 e (EncryptedData (Encap EncryptedContent))
-> ParseASN1 e (EncryptedData (Encap EncryptedContent))
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (EncryptedData (Encap EncryptedContent))
 -> ParseASN1 e (EncryptedData (Encap EncryptedContent)))
-> ParseASN1 e (EncryptedData (Encap EncryptedContent))
-> ParseASN1 e (EncryptedData (Encap EncryptedContent))
forall a b. (a -> b) -> a -> b
$ do
            IntVal v <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            when (v /= 0 && v /= 2) $
                throwParseError ("EncryptedData: parsed invalid version: " ++ show v)
            (ct, params, ec) <- parseEncryptedContentInfo
            attrs <- parseAttributes (Container Context 1)
            return EncryptedData { edContentType = ct
                                 , edContentEncryptionParams = params
                                 , edEncryptedContent = ec
                                 , edUnprotectedAttrs = attrs
                                 }

-- | Generate ASN.1 for EncryptedContentInfo.
encryptedContentInfoASN1S :: (ASN1Elem e, ProduceASN1Object e alg)
                          => (ContentType, alg, Encap EncryptedContent) -> ASN1Stream e
encryptedContentInfoASN1S :: forall e alg.
(ASN1Elem e, ProduceASN1Object e alg) =>
(ContentType, alg, Encap EncryptedContent) -> ASN1Stream e
encryptedContentInfoASN1S (ContentType
ct, alg
alg, Encap EncryptedContent
ec) =
    ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
ct' 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
ec')
  where
    ct' :: ASN1Stream e
ct'  = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (ContentType -> OID
forall a. OIDable a => a -> OID
getObjectID ContentType
ct)
    alg' :: ASN1Stream e
alg' = alg -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s alg
alg
    ec' :: ASN1Stream e
ec'  = ASN1ConstructionType -> Encap EncryptedContent -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> Encap EncryptedContent -> ASN1Stream e
encapsulatedASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) Encap EncryptedContent
ec

encapsulatedASN1S :: ASN1Elem e
                  => ASN1ConstructionType -> Encap EncryptedContent -> ASN1Stream e
encapsulatedASN1S :: forall e.
ASN1Elem e =>
ASN1ConstructionType -> Encap EncryptedContent -> ASN1Stream e
encapsulatedASN1S ASN1ConstructionType
_   Encap EncryptedContent
Detached     = [e] -> [e]
forall a. a -> a
id
encapsulatedASN1S ASN1ConstructionType
ty (Attached EncryptedContent
bs) = ASN1ConstructionType -> ([e] -> [e]) -> [e] -> [e]
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
ty (EncryptedContent -> [e] -> [e]
forall e. ASN1Elem e => EncryptedContent -> ASN1Stream e
gOctetString EncryptedContent
bs)

-- | Parse EncryptedContentInfo from ASN.1.
parseEncryptedContentInfo :: ParseASN1Object e alg
                          => ParseASN1 e (ContentType, alg, Encap EncryptedContent)
parseEncryptedContentInfo :: forall e alg.
ParseASN1Object e alg =>
ParseASN1 e (ContentType, alg, Encap EncryptedContent)
parseEncryptedContentInfo = ASN1ConstructionType
-> ParseASN1 e (ContentType, alg, Encap EncryptedContent)
-> ParseASN1 e (ContentType, alg, Encap EncryptedContent)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (ContentType, alg, Encap EncryptedContent)
 -> ParseASN1 e (ContentType, alg, Encap EncryptedContent))
-> ParseASN1 e (ContentType, alg, Encap EncryptedContent)
-> ParseASN1 e (ContentType, alg, Encap EncryptedContent)
forall a b. (a -> b) -> a -> b
$ do
    OID oid <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    alg <- parse
    b <- hasNext
    ec <- if b then Attached <$> parseEncryptedContent else return Detached
    withObjectID "content type" oid $ \ContentType
ct -> (ContentType, alg, Encap EncryptedContent)
-> ParseASN1 e (ContentType, alg, Encap EncryptedContent)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentType
ct, alg
alg, Encap EncryptedContent
ec)
  where
    parseEncryptedContent :: ParseASN1 e EncryptedContent
parseEncryptedContent = ParseASN1 e EncryptedContent
parseWrapped ParseASN1 e EncryptedContent
-> ParseASN1 e EncryptedContent -> ParseASN1 e EncryptedContent
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e EncryptedContent
parsePrimitive
    parseWrapped :: ParseASN1 e EncryptedContent
parseWrapped  = ASN1ConstructionType
-> ParseASN1 e EncryptedContent -> ParseASN1 e EncryptedContent
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ParseASN1 e EncryptedContent
forall e. Monoid e => ParseASN1 e EncryptedContent
parseOctetStrings
    parsePrimitive :: ParseASN1 e EncryptedContent
parsePrimitive = do Other Context 0 bs <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext; return bs