{-# 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
getContentType :: ContentInfo -> ContentType
getContentType (DataCI _) = DataType
getContentType (SignedDataCI _) = SignedDataType
getContentType (EnvelopedDataCI _) = EnvelopedDataType
getContentType (DigestedDataCI _) = DigestedDataType
getContentType (EncryptedDataCI _) = EncryptedDataType
getContentType (AuthenticatedDataCI _) = AuthenticatedDataType
getContentType (AuthEnvelopedDataCI _) = AuthEnvelopedDataType
data ContentInfo = DataCI ByteString
| SignedDataCI (SignedData (Encap EncapsulatedContent))
| EnvelopedDataCI (EnvelopedData (Encap EncryptedContent))
| DigestedDataCI (DigestedData (Encap EncapsulatedContent))
| EncryptedDataCI (EncryptedData (Encap EncryptedContent))
| AuthenticatedDataCI (AuthenticatedData (Encap EncapsulatedContent))
| AuthEnvelopedDataCI (AuthEnvelopedData (Encap EncryptedContent))
deriving (Show,Eq)
instance ProduceASN1Object ASN1P ContentInfo where
asn1s ci = asn1Container Sequence (oid . cont)
where oid = gOID $ getObjectID $ getContentType ci
cont = asn1Container (Container Context 0) inner
inner =
case ci of
DataCI bs -> dataASN1S bs
SignedDataCI ed -> asn1s ed
EnvelopedDataCI ed -> asn1s ed
DigestedDataCI dd -> asn1s dd
EncryptedDataCI ed -> asn1s ed
AuthenticatedDataCI ad -> asn1s ad
AuthEnvelopedDataCI ae -> asn1s ae
instance ParseASN1Object [ASN1Event] ContentInfo where
parse =
onNextContainer Sequence $ do
OID oid <- getNext
withObjectID "content type" oid $ \ct ->
onNextContainer (Container Context 0) (parseInner ct)
where
parseInner DataType = DataCI <$> parseData
parseInner SignedDataType = SignedDataCI <$> parse
parseInner EnvelopedDataType = EnvelopedDataCI <$> parse
parseInner DigestedDataType = DigestedDataCI <$> parse
parseInner EncryptedDataType = EncryptedDataCI <$> parse
parseInner AuthenticatedDataType = AuthenticatedDataCI <$> parse
parseInner AuthEnvelopedDataType = AuthEnvelopedDataCI <$> parse
dataASN1S :: ASN1Elem e => ByteString -> ASN1Stream e
dataASN1S = gOctetString
parseData :: Monoid e => ParseASN1 e ByteString
parseData = do
next <- getNext
case next of
OctetString bs -> return bs
_ -> throwParseError "Data: parsed unexpected content"
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 f s = let g a = s { sdEncapsulatedContent = a }
in fmap g (f $ sdEncapsulatedContent s)
toCI = SignedDataCI
instance Encapsulates EnvelopedData where
lens f s = let g a = s { evEncryptedContent = a }
in fmap g (f $ evEncryptedContent s)
toCI = EnvelopedDataCI
instance Encapsulates DigestedData where
lens f s = let g a = s { ddEncapsulatedContent = a }
in fmap g (f $ ddEncapsulatedContent s)
toCI = DigestedDataCI
instance Encapsulates EncryptedData where
lens f s = let g a = s { edEncryptedContent = a }
in fmap g (f $ edEncryptedContent s)
toCI = EncryptedDataCI
instance Encapsulates AuthenticatedData where
lens f s = let g a = s { adEncapsulatedContent = a }
in fmap g (f $ adEncapsulatedContent s)
toCI = AuthenticatedDataCI
instance Encapsulates AuthEnvelopedData where
lens f s = let g a = s { aeEncryptedContent = a }
in fmap g (f $ aeEncryptedContent s)
toCI = AuthEnvelopedDataCI
isAttached :: Encapsulates struct => struct (Encap a) -> Bool
isAttached = isJust . fromAttached
fromAttached :: (MonadFail m, Encapsulates struct) => struct (Encap a) -> m (struct a)
fromAttached = lens (fromEncap err return)
where err = fail "fromAttached: detached"
toAttached :: Encapsulates struct => struct a -> struct (Encap a)
toAttached = runIdentity . lens (Identity . Attached)
toAttachedCI :: Encapsulates struct => struct ByteString -> ContentInfo
toAttachedCI = toCI . toAttached
isDetached :: Encapsulates struct => struct (Encap a) -> Bool
isDetached = isNothing . fromAttached
fromDetached :: (MonadFail m, Encapsulates struct) => b -> struct (Encap a) -> m (struct b)
fromDetached c = lens (fromEncap (return c) err)
where err _ = fail "fromDetached: attached"
toDetached :: Encapsulates struct => struct a -> (a, struct (Encap a))
toDetached = let f a = (a, Detached) in lens f
toDetachedCI :: Encapsulates struct => struct ByteString -> (ByteString, ContentInfo)
toDetachedCI = fmap toCI . toDetached