-- |
-- Module      : Crypto.Store.CMS.Info
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- CMS content information.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Crypto.Store.CMS.Info
    ( ContentInfo(..)
    , getContentType
    , Encapsulates
    , isAttached
    , fromAttached
    , toAttachedCI
    , isDetached
    , fromDetached
    , toDetachedCI
    ) where

import Control.Monad.Fail (MonadFail)

import Data.ASN1.Types
import Data.ByteString (ByteString)
import Data.Functor.Identity
import Data.Maybe (isJust, isNothing)

import Crypto.Store.ASN1.Generate
import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS.Authenticated
import Crypto.Store.CMS.AuthEnveloped
import Crypto.Store.CMS.Digested
import Crypto.Store.CMS.Encrypted
import Crypto.Store.CMS.Enveloped
import Crypto.Store.CMS.Signed
import Crypto.Store.CMS.Type
import Crypto.Store.CMS.Util

-- | Get the type of a content info.
getContentType :: ContentInfo -> ContentType
getContentType :: ContentInfo -> ContentType
getContentType (DataCI ByteString
_)              = ContentType
DataType
getContentType (SignedDataCI SignedData (Encap ByteString)
_)        = ContentType
SignedDataType
getContentType (EnvelopedDataCI EnvelopedData (Encap ByteString)
_)     = ContentType
EnvelopedDataType
getContentType (DigestedDataCI DigestedData (Encap ByteString)
_)      = ContentType
DigestedDataType
getContentType (EncryptedDataCI EncryptedData (Encap ByteString)
_)     = ContentType
EncryptedDataType
getContentType (AuthenticatedDataCI AuthenticatedData (Encap ByteString)
_) = ContentType
AuthenticatedDataType
getContentType (AuthEnvelopedDataCI AuthEnvelopedData (Encap ByteString)
_) = ContentType
AuthEnvelopedDataType


-- ContentInfo

-- | CMS content information.
data ContentInfo = DataCI ByteString
                   -- ^ Arbitrary octet string
                 | SignedDataCI (SignedData (Encap EncapsulatedContent))
                   -- ^ Signed content info
                 | EnvelopedDataCI (EnvelopedData (Encap EncryptedContent))
                   -- ^ Enveloped content info
                 | DigestedDataCI (DigestedData (Encap EncapsulatedContent))
                   -- ^ Content info with associated digest
                 | EncryptedDataCI (EncryptedData (Encap EncryptedContent))
                   -- ^ Encrypted content info
                 | AuthenticatedDataCI (AuthenticatedData (Encap EncapsulatedContent))
                   -- ^ Authenticatedcontent info
                 | AuthEnvelopedDataCI (AuthEnvelopedData (Encap EncryptedContent))
                   -- ^ Authenticated-enveloped content info
                 deriving (Int -> ContentInfo -> ShowS
[ContentInfo] -> ShowS
ContentInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentInfo] -> ShowS
$cshowList :: [ContentInfo] -> ShowS
show :: ContentInfo -> String
$cshow :: ContentInfo -> String
showsPrec :: Int -> ContentInfo -> ShowS
$cshowsPrec :: Int -> ContentInfo -> ShowS
Show,ContentInfo -> ContentInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentInfo -> ContentInfo -> Bool
$c/= :: ContentInfo -> ContentInfo -> Bool
== :: ContentInfo -> ContentInfo -> Bool
$c== :: ContentInfo -> ContentInfo -> Bool
Eq)

instance ProduceASN1Object ASN1P ContentInfo where
    asn1s :: ContentInfo -> ASN1Stream ASN1P
asn1s ContentInfo
ci = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream ASN1P
oid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
cont)
      where oid :: ASN1Stream ASN1P
oid = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID forall a b. (a -> b) -> a -> b
$ forall a. OIDable a => a -> OID
getObjectID forall a b. (a -> b) -> a -> b
$ ContentInfo -> ContentType
getContentType ContentInfo
ci
            cont :: ASN1Stream ASN1P
cont = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ASN1Stream ASN1P
inner
            inner :: ASN1Stream ASN1P
inner =
                case ContentInfo
ci of
                    DataCI ByteString
bs              -> forall e. ASN1Elem e => ByteString -> ASN1Stream e
dataASN1S ByteString
bs
                    SignedDataCI SignedData (Encap ByteString)
ed        -> forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s SignedData (Encap ByteString)
ed
                    EnvelopedDataCI EnvelopedData (Encap ByteString)
ed     -> forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s EnvelopedData (Encap ByteString)
ed
                    DigestedDataCI DigestedData (Encap ByteString)
dd      -> forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s DigestedData (Encap ByteString)
dd
                    EncryptedDataCI EncryptedData (Encap ByteString)
ed     -> forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s EncryptedData (Encap ByteString)
ed
                    AuthenticatedDataCI AuthenticatedData (Encap ByteString)
ad -> forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s AuthenticatedData (Encap ByteString)
ad
                    AuthEnvelopedDataCI AuthEnvelopedData (Encap ByteString)
ae -> forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s AuthEnvelopedData (Encap ByteString)
ae

instance ParseASN1Object [ASN1Event] ContentInfo where
    parse :: ParseASN1 [ASN1Event] ContentInfo
parse =
        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
            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 e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (forall {e}.
(ParseASN1Object e (SignedData (Encap ByteString)),
 ParseASN1Object e (EnvelopedData (Encap ByteString)),
 ParseASN1Object e (AuthenticatedData (Encap ByteString)),
 ParseASN1Object e (AuthEnvelopedData (Encap ByteString))) =>
ContentType -> ParseASN1 e ContentInfo
parseInner ContentType
ct)
      where
        parseInner :: ContentType -> ParseASN1 e ContentInfo
parseInner ContentType
DataType              = ByteString -> ContentInfo
DataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Monoid e => ParseASN1 e ByteString
parseData
        parseInner ContentType
SignedDataType        = SignedData (Encap ByteString) -> ContentInfo
SignedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        parseInner ContentType
EnvelopedDataType     = EnvelopedData (Encap ByteString) -> ContentInfo
EnvelopedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        parseInner ContentType
DigestedDataType      = DigestedData (Encap ByteString) -> ContentInfo
DigestedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        parseInner ContentType
EncryptedDataType     = EncryptedData (Encap ByteString) -> ContentInfo
EncryptedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        parseInner ContentType
AuthenticatedDataType = AuthenticatedData (Encap ByteString) -> ContentInfo
AuthenticatedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        parseInner ContentType
AuthEnvelopedDataType = AuthEnvelopedData (Encap ByteString) -> ContentInfo
AuthEnvelopedDataCI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse


-- Data

dataASN1S :: ASN1Elem e => ByteString -> ASN1Stream e
dataASN1S :: forall e. ASN1Elem e => ByteString -> ASN1Stream e
dataASN1S = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString

parseData :: Monoid e => ParseASN1 e ByteString
parseData :: forall e. Monoid e => ParseASN1 e ByteString
parseData = do
    ASN1
next <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    case ASN1
next of
        OctetString ByteString
bs -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
        ASN1
_              -> forall e a. String -> ParseASN1 e a
throwParseError String
"Data: parsed unexpected content"


-- Encapsulation

-- | Class of data structures with inner content that may be stored externally.
-- This class has instances for each CMS content type containing other
-- encapsulated or encrypted content info.
--
-- Functions 'fromAttached' and 'fromDetached' are used to introspect
-- encapsulation state (attached or detached), and recover a data structure with
-- actionable content.
--
-- Functions 'toAttachedCI' and 'toDetachedCI' are needed to decide about the
-- outer encapsulation state and build a 'ContentInfo'.
class Encapsulates struct where
    lens :: Functor f => (a -> f b) -> struct a -> f (struct b)
    toCI :: struct (Encap ByteString) -> ContentInfo

instance Encapsulates SignedData where
    lens :: forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> SignedData a -> f (SignedData b)
lens a -> f b
f SignedData a
s = let g :: content -> SignedData content
g content
a = SignedData a
s { sdEncapsulatedContent :: content
sdEncapsulatedContent = content
a }
                in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {content}. content -> SignedData content
g (a -> f b
f forall a b. (a -> b) -> a -> b
$ forall content. SignedData content -> content
sdEncapsulatedContent SignedData a
s)
    toCI :: SignedData (Encap ByteString) -> ContentInfo
toCI = SignedData (Encap ByteString) -> ContentInfo
SignedDataCI

instance Encapsulates EnvelopedData where
    lens :: forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> EnvelopedData a -> f (EnvelopedData b)
lens a -> f b
f EnvelopedData a
s = let g :: content -> EnvelopedData content
g content
a = EnvelopedData a
s { evEncryptedContent :: content
evEncryptedContent = content
a }
                in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {content}. content -> EnvelopedData content
g (a -> f b
f forall a b. (a -> b) -> a -> b
$ forall content. EnvelopedData content -> content
evEncryptedContent EnvelopedData a
s)
    toCI :: EnvelopedData (Encap ByteString) -> ContentInfo
toCI = EnvelopedData (Encap ByteString) -> ContentInfo
EnvelopedDataCI

instance Encapsulates DigestedData where
    lens :: forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> DigestedData a -> f (DigestedData b)
lens a -> f b
f DigestedData a
s = let g :: content -> DigestedData content
g content
a = DigestedData a
s { ddEncapsulatedContent :: content
ddEncapsulatedContent = content
a }
                in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {content}. content -> DigestedData content
g (a -> f b
f forall a b. (a -> b) -> a -> b
$ forall content. DigestedData content -> content
ddEncapsulatedContent DigestedData a
s)
    toCI :: DigestedData (Encap ByteString) -> ContentInfo
toCI = DigestedData (Encap ByteString) -> ContentInfo
DigestedDataCI

instance Encapsulates EncryptedData where
    lens :: forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> EncryptedData a -> f (EncryptedData b)
lens a -> f b
f EncryptedData a
s = let g :: content -> EncryptedData content
g content
a = EncryptedData a
s { edEncryptedContent :: content
edEncryptedContent = content
a }
                in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {content}. content -> EncryptedData content
g (a -> f b
f forall a b. (a -> b) -> a -> b
$ forall content. EncryptedData content -> content
edEncryptedContent EncryptedData a
s)
    toCI :: EncryptedData (Encap ByteString) -> ContentInfo
toCI = EncryptedData (Encap ByteString) -> ContentInfo
EncryptedDataCI

instance Encapsulates AuthenticatedData where
    lens :: forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> AuthenticatedData a -> f (AuthenticatedData b)
lens a -> f b
f AuthenticatedData a
s = let g :: content -> AuthenticatedData content
g content
a = AuthenticatedData a
s { adEncapsulatedContent :: content
adEncapsulatedContent = content
a }
                in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {content}. content -> AuthenticatedData content
g (a -> f b
f forall a b. (a -> b) -> a -> b
$ forall content. AuthenticatedData content -> content
adEncapsulatedContent AuthenticatedData a
s)
    toCI :: AuthenticatedData (Encap ByteString) -> ContentInfo
toCI = AuthenticatedData (Encap ByteString) -> ContentInfo
AuthenticatedDataCI

instance Encapsulates AuthEnvelopedData where
    lens :: forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> AuthEnvelopedData a -> f (AuthEnvelopedData b)
lens a -> f b
f AuthEnvelopedData a
s = let g :: content -> AuthEnvelopedData content
g content
a = AuthEnvelopedData a
s { aeEncryptedContent :: content
aeEncryptedContent = content
a }
                in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {content}. content -> AuthEnvelopedData content
g (a -> f b
f forall a b. (a -> b) -> a -> b
$ forall content. AuthEnvelopedData content -> content
aeEncryptedContent AuthEnvelopedData a
s)
    toCI :: AuthEnvelopedData (Encap ByteString) -> ContentInfo
toCI = AuthEnvelopedData (Encap ByteString) -> ContentInfo
AuthEnvelopedDataCI

-- | Return 'True' when the encapsulated content is attached.
isAttached :: Encapsulates struct => struct (Encap a) -> Bool
isAttached :: forall (struct :: * -> *) a.
Encapsulates struct =>
struct (Encap a) -> Bool
isAttached = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (struct :: * -> *) a.
(MonadFail m, Encapsulates struct) =>
struct (Encap a) -> m (struct a)
fromAttached

-- | Unwrap the encapsulation, assuming the inner content is inside the data
-- structure.  The monadic computation fails if the content was detached.
fromAttached :: (MonadFail m, Encapsulates struct) => struct (Encap a) -> m (struct a)
fromAttached :: forall (m :: * -> *) (struct :: * -> *) a.
(MonadFail m, Encapsulates struct) =>
struct (Encap a) -> m (struct a)
fromAttached = forall (struct :: * -> *) (f :: * -> *) a b.
(Encapsulates struct, Functor f) =>
(a -> f b) -> struct a -> f (struct b)
lens (forall b a. b -> (a -> b) -> Encap a -> b
fromEncap forall {a}. m a
err forall (m :: * -> *) a. Monad m => a -> m a
return)
  where err :: m a
err = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"fromAttached: detached"

-- | Keep the content inside the data structure.
toAttached :: Encapsulates struct => struct a -> struct (Encap a)
toAttached :: forall (struct :: * -> *) a.
Encapsulates struct =>
struct a -> struct (Encap a)
toAttached = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (struct :: * -> *) (f :: * -> *) a b.
(Encapsulates struct, Functor f) =>
(a -> f b) -> struct a -> f (struct b)
lens (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Encap a
Attached)

-- | Transform the data structure into a content info, keeping the encapsulated
-- content attached.  May be applied to structures with 'EncapsulatedContent' or
-- 'EncryptedContent'.
toAttachedCI :: Encapsulates struct => struct ByteString -> ContentInfo
toAttachedCI :: forall (struct :: * -> *).
Encapsulates struct =>
struct ByteString -> ContentInfo
toAttachedCI = forall (struct :: * -> *).
Encapsulates struct =>
struct (Encap ByteString) -> ContentInfo
toCI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (struct :: * -> *) a.
Encapsulates struct =>
struct a -> struct (Encap a)
toAttached

-- | Return 'True' when the encapsulated content is detached.
isDetached :: Encapsulates struct => struct (Encap a) -> Bool
isDetached :: forall (struct :: * -> *) a.
Encapsulates struct =>
struct (Encap a) -> Bool
isDetached = forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (struct :: * -> *) a.
(MonadFail m, Encapsulates struct) =>
struct (Encap a) -> m (struct a)
fromAttached

-- | Recover the original data structure from a detached encapsulation and the
-- external content.  The monadic computation fails if the content was attached.
fromDetached :: (MonadFail m, Encapsulates struct) => b -> struct (Encap a) -> m (struct b)
fromDetached :: forall (m :: * -> *) (struct :: * -> *) b a.
(MonadFail m, Encapsulates struct) =>
b -> struct (Encap a) -> m (struct b)
fromDetached b
c = forall (struct :: * -> *) (f :: * -> *) a b.
(Encapsulates struct, Functor f) =>
(a -> f b) -> struct a -> f (struct b)
lens (forall b a. b -> (a -> b) -> Encap a -> b
fromEncap (forall (m :: * -> *) a. Monad m => a -> m a
return b
c) forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
err)
  where err :: p -> m a
err p
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"fromDetached: attached"

-- | Remove the content from the data structure to store it externally.
toDetached :: Encapsulates struct => struct a -> (a, struct (Encap a))
toDetached :: forall (struct :: * -> *) a.
Encapsulates struct =>
struct a -> (a, struct (Encap a))
toDetached = let f :: a -> (a, Encap a)
f a
a = (a
a, forall a. Encap a
Detached) in forall (struct :: * -> *) (f :: * -> *) a b.
(Encapsulates struct, Functor f) =>
(a -> f b) -> struct a -> f (struct b)
lens forall {a} {a}. a -> (a, Encap a)
f

-- | Transform the data structure into a content info, detaching the
-- encapsulated content.  May be applied to structures with
-- 'EncapsulatedContent' or 'EncryptedContent'.
toDetachedCI :: Encapsulates struct => struct ByteString -> (ByteString, ContentInfo)
toDetachedCI :: forall (struct :: * -> *).
Encapsulates struct =>
struct ByteString -> (ByteString, ContentInfo)
toDetachedCI = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (struct :: * -> *).
Encapsulates struct =>
struct (Encap ByteString) -> ContentInfo
toCI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (struct :: * -> *) a.
Encapsulates struct =>
struct a -> (a, struct (Encap a))
toDetached