{-# 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
type ContentEncryptionKey = B.ByteString
type EncryptedContent = B.ByteString
data EncryptedData content = EncryptedData
{ forall content. EncryptedData content -> ContentType
edContentType :: ContentType
, forall content. EncryptedData content -> ContentEncryptionParams
edContentEncryptionParams :: ContentEncryptionParams
, forall content. EncryptedData content -> content
edEncryptedContent :: content
, forall content. EncryptedData content -> [Attribute]
edUnprotectedAttrs :: [Attribute]
}
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
}
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)
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