-- |
-- 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
    { EncryptedData content -> ContentType
edContentType :: ContentType
      -- ^ Inner content type
    , EncryptedData content -> ContentEncryptionParams
edContentEncryptionParams :: ContentEncryptionParams
      -- ^ Encryption algorithm
    , EncryptedData content -> content
edEncryptedContent :: content
      -- ^ Encrypted content info
    , 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
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
(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
/= :: 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
..} =
        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 (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 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
"EncryptedData: parsed invalid version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
v)
            (ContentType
ct, ContentEncryptionParams
params, Encap EncryptedContent
ec) <- ParseASN1
  e (ContentType, ContentEncryptionParams, Encap EncryptedContent)
forall e alg.
ParseASN1Object e alg =>
ParseASN1 e (ContentType, alg, Encap EncryptedContent)
parseEncryptedContentInfo
            [Attribute]
attrs <- ASN1ConstructionType -> ParseASN1 e [Attribute]
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
            EncryptedData (Encap EncryptedContent)
-> ParseASN1 e (EncryptedData (Encap EncryptedContent))
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptedData :: forall content.
ContentType
-> ContentEncryptionParams
-> content
-> [Attribute]
-> EncryptedData content
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 :: (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 :: ASN1ConstructionType -> Encap EncryptedContent -> ASN1Stream e
encapsulatedASN1S ASN1ConstructionType
_   Encap EncryptedContent
Detached     = ASN1Stream e
forall a. a -> a
id
encapsulatedASN1S ASN1ConstructionType
ty (Attached EncryptedContent
bs) = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
ty (EncryptedContent -> ASN1Stream 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 :: 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
oid <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    alg
alg <- ParseASN1 e alg
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    Bool
b <- ParseASN1 e Bool
forall e. ParseASN1 e Bool
hasNext
    Encap EncryptedContent
ec <- if Bool
b then EncryptedContent -> Encap EncryptedContent
forall a. a -> Encap a
Attached (EncryptedContent -> Encap EncryptedContent)
-> ParseASN1 e EncryptedContent
-> ParseASN1 e (Encap EncryptedContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e EncryptedContent
parseEncryptedContent else Encap EncryptedContent -> ParseASN1 e (Encap EncryptedContent)
forall (m :: * -> *) a. Monad m => a -> m a
return Encap EncryptedContent
forall a. Encap a
Detached
    String
-> OID
-> (ContentType
    -> ParseASN1 e (ContentType, alg, Encap EncryptedContent))
-> ParseASN1 e (ContentType, alg, Encap EncryptedContent)
forall a e b.
OIDNameable a =>
String -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID String
"content type" OID
oid ((ContentType
  -> ParseASN1 e (ContentType, alg, Encap EncryptedContent))
 -> ParseASN1 e (ContentType, alg, Encap EncryptedContent))
-> (ContentType
    -> ParseASN1 e (ContentType, alg, Encap EncryptedContent))
-> ParseASN1 e (ContentType, alg, Encap EncryptedContent)
forall a b. (a -> b) -> a -> b
$ \ContentType
ct -> (ContentType, alg, Encap EncryptedContent)
-> ParseASN1 e (ContentType, alg, Encap EncryptedContent)
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 (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
parseOctetStrings
    parsePrimitive :: ParseASN1 e EncryptedContent
parsePrimitive = do Other ASN1Class
Context Int
0 EncryptedContent
bs <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext; EncryptedContent -> ParseASN1 e EncryptedContent
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptedContent
bs
    parseOctetString :: ParseASN1 e EncryptedContent
parseOctetString = do OctetString EncryptedContent
bs <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext; EncryptedContent -> ParseASN1 e EncryptedContent
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptedContent
bs
    parseOctetStrings :: ParseASN1 e EncryptedContent
parseOctetStrings = [EncryptedContent] -> EncryptedContent
B.concat ([EncryptedContent] -> EncryptedContent)
-> ParseASN1 e [EncryptedContent] -> ParseASN1 e EncryptedContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e EncryptedContent -> ParseASN1 e [EncryptedContent]
forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany ParseASN1 e EncryptedContent
parseOctetString