-- |
-- 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
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
showList :: [EncryptedData content] -> ShowS
$cshowList :: forall content. Show content => [EncryptedData content] -> ShowS
show :: EncryptedData content -> String
$cshow :: forall content. Show content => EncryptedData content -> String
showsPrec :: Int -> EncryptedData content -> ShowS
$cshowsPrec :: forall content.
Show content =>
Int -> EncryptedData content -> ShowS
Show,EncryptedData content -> EncryptedData content -> Bool
forall content.
Eq content =>
EncryptedData content -> EncryptedData content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptedData content -> EncryptedData content -> Bool
$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
Eq)

instance ASN1Elem e => ProduceASN1Object e (EncryptedData (Encap EncryptedContent)) where
    asn1s :: EncryptedData (Encap EncryptedContent) -> ASN1Stream e
asn1s EncryptedData{[Attribute]
Encap EncryptedContent
ContentType
ContentEncryptionParams
edUnprotectedAttrs :: [Attribute]
edEncryptedContent :: Encap EncryptedContent
edContentEncryptionParams :: ContentEncryptionParams
edContentType :: ContentType
edUnprotectedAttrs :: forall content. EncryptedData content -> [Attribute]
edEncryptedContent :: forall content. EncryptedData content -> content
edContentEncryptionParams :: forall content. EncryptedData content -> ContentEncryptionParams
edContentType :: forall content. EncryptedData content -> ContentType
..} =
        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
eci forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ua)
      where
        ver :: ASN1Stream e
ver = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
edUnprotectedAttrs then Integer
0 else Integer
2)
        eci :: ASN1Stream e
eci = 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  = 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 =
        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
"EncryptedData: parsed invalid version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
v)
            (ContentType
ct, ContentEncryptionParams
params, Encap EncryptedContent
ec) <- forall e alg.
ParseASN1Object e alg =>
ParseASN1 e (ContentType, alg, Encap EncryptedContent)
parseEncryptedContentInfo
            [Attribute]
attrs <- forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
            forall (m :: * -> *) a. Monad m => a -> m a
return EncryptedData { edContentType :: ContentType
edContentType = ContentType
ct
                                 , edContentEncryptionParams :: ContentEncryptionParams
edContentEncryptionParams = ContentEncryptionParams
params
                                 , edEncryptedContent :: Encap EncryptedContent
edEncryptedContent = Encap EncryptedContent
ec
                                 , edUnprotectedAttrs :: [Attribute]
edUnprotectedAttrs = [Attribute]
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) =
    forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence ([e] -> [e]
ct' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
alg' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
ec')
  where
    ct' :: [e] -> [e]
ct'  = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (forall a. OIDable a => a -> OID
getObjectID ContentType
ct)
    alg' :: [e] -> [e]
alg' = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s alg
alg
    ec' :: [e] -> [e]
ec'  = 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     = forall a. a -> a
id
encapsulatedASN1S ASN1ConstructionType
ty (Attached EncryptedContent
bs) = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
ty (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 = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
    OID OID
oid <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    alg
alg <- forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    Bool
b <- forall e. ParseASN1 e Bool
hasNext
    Encap EncryptedContent
ec <- if Bool
b then forall a. a -> Encap a
Attached forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e EncryptedContent
parseEncryptedContent else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Encap a
Detached
    forall a e b.
OIDNameable a =>
String -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID String
"content type" OID
oid forall a b. (a -> b) -> a -> b
$ \ContentType
ct -> 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e EncryptedContent
parsePrimitive
    parseWrapped :: ParseASN1 e EncryptedContent
parseWrapped  = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ParseASN1 e EncryptedContent
parseOctetStrings
    parsePrimitive :: ParseASN1 e EncryptedContent
parsePrimitive = do Other ASN1Class
Context Int
0 EncryptedContent
bs <- forall e. Monoid e => ParseASN1 e ASN1
getNext; forall (m :: * -> *) a. Monad m => a -> m a
return EncryptedContent
bs
    parseOctetString :: ParseASN1 e EncryptedContent
parseOctetString = do OctetString EncryptedContent
bs <- forall e. Monoid e => ParseASN1 e ASN1
getNext; forall (m :: * -> *) a. Monad m => a -> m a
return EncryptedContent
bs
    parseOctetStrings :: ParseASN1 e EncryptedContent
parseOctetStrings = [EncryptedContent] -> EncryptedContent
B.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany ParseASN1 e EncryptedContent
parseOctetString