-- |
-- Module      : Crypto.Store.CMS.Type
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- CMS content information type.
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
module Crypto.Store.CMS.Type
    ( ContentType(..)
    , Encap(..)
    , fromEncap
    ) where

import Data.ASN1.OID

import Crypto.Store.CMS.Util

-- | CMS content information type.
data ContentType = DataType              -- ^ Arbitrary octet string
                 | SignedDataType        -- ^ Signed content info
                 | EnvelopedDataType     -- ^ Enveloped content info
                 | DigestedDataType      -- ^ Content info with associated digest
                 | EncryptedDataType     -- ^ Encrypted content info
                 | AuthenticatedDataType -- ^ Authenticated content info
                 | AuthEnvelopedDataType -- ^ Authenticated-enveloped content info
                 deriving (Int -> ContentType -> ShowS
[ContentType] -> ShowS
ContentType -> String
(Int -> ContentType -> ShowS)
-> (ContentType -> String)
-> ([ContentType] -> ShowS)
-> Show ContentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentType] -> ShowS
$cshowList :: [ContentType] -> ShowS
show :: ContentType -> String
$cshow :: ContentType -> String
showsPrec :: Int -> ContentType -> ShowS
$cshowsPrec :: Int -> ContentType -> ShowS
Show,ContentType -> ContentType -> Bool
(ContentType -> ContentType -> Bool)
-> (ContentType -> ContentType -> Bool) -> Eq ContentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentType -> ContentType -> Bool
$c/= :: ContentType -> ContentType -> Bool
== :: ContentType -> ContentType -> Bool
$c== :: ContentType -> ContentType -> Bool
Eq)

instance Enumerable ContentType where
    values :: [ContentType]
values = [ ContentType
DataType
             , ContentType
SignedDataType
             , ContentType
EnvelopedDataType
             , ContentType
DigestedDataType
             , ContentType
EncryptedDataType
             , ContentType
AuthenticatedDataType
             , ContentType
AuthEnvelopedDataType
             ]

instance OIDable ContentType where
    getObjectID :: ContentType -> OID
getObjectID ContentType
DataType              = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
7,Integer
1]
    getObjectID ContentType
SignedDataType        = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
7,Integer
2]
    getObjectID ContentType
EnvelopedDataType     = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
7,Integer
3]
    getObjectID ContentType
DigestedDataType      = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
7,Integer
5]
    getObjectID ContentType
EncryptedDataType     = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
7,Integer
6]
    getObjectID ContentType
AuthenticatedDataType = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
16,Integer
1,Integer
2]
    getObjectID ContentType
AuthEnvelopedDataType = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
16,Integer
1,Integer
23]

instance OIDNameable ContentType where
    fromObjectID :: OID -> Maybe ContentType
fromObjectID OID
oid = OIDNameableWrapper ContentType -> ContentType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper ContentType -> ContentType)
-> Maybe (OIDNameableWrapper ContentType) -> Maybe ContentType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper ContentType)
forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | Denote the state of encapsulated content in a CMS data structure.  This
-- type is isomorphic to 'Maybe'.
data Encap a
    = Detached    -- ^ Content is stored externally to the structure
    | Attached a  -- ^ Content is stored inside the CMS struture
    deriving (Int -> Encap a -> ShowS
[Encap a] -> ShowS
Encap a -> String
(Int -> Encap a -> ShowS)
-> (Encap a -> String) -> ([Encap a] -> ShowS) -> Show (Encap a)
forall a. Show a => Int -> Encap a -> ShowS
forall a. Show a => [Encap a] -> ShowS
forall a. Show a => Encap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Encap a] -> ShowS
$cshowList :: forall a. Show a => [Encap a] -> ShowS
show :: Encap a -> String
$cshow :: forall a. Show a => Encap a -> String
showsPrec :: Int -> Encap a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Encap a -> ShowS
Show,Encap a -> Encap a -> Bool
(Encap a -> Encap a -> Bool)
-> (Encap a -> Encap a -> Bool) -> Eq (Encap a)
forall a. Eq a => Encap a -> Encap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Encap a -> Encap a -> Bool
$c/= :: forall a. Eq a => Encap a -> Encap a -> Bool
== :: Encap a -> Encap a -> Bool
$c== :: forall a. Eq a => Encap a -> Encap a -> Bool
Eq)

instance Functor Encap where
    fmap :: (a -> b) -> Encap a -> Encap b
fmap a -> b
_ Encap a
Detached = Encap b
forall a. Encap a
Detached
    fmap a -> b
f (Attached a
c) = b -> Encap b
forall a. a -> Encap a
Attached (a -> b
f a
c)

instance Applicative Encap where
    pure :: a -> Encap a
pure = a -> Encap a
forall a. a -> Encap a
Attached

    Attached a -> b
f <*> :: Encap (a -> b) -> Encap a -> Encap b
<*> Encap a
e = (a -> b) -> Encap a -> Encap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Encap a
e
    Encap (a -> b)
Detached   <*> Encap a
_ = Encap b
forall a. Encap a
Detached

instance Foldable Encap where
    foldMap :: (a -> m) -> Encap a -> m
foldMap = m -> (a -> m) -> Encap a -> m
forall b a. b -> (a -> b) -> Encap a -> b
fromEncap m
forall a. Monoid a => a
mempty

    foldr :: (a -> b -> b) -> b -> Encap a -> b
foldr a -> b -> b
_ b
d Encap a
Detached     = b
d
    foldr a -> b -> b
f b
d (Attached a
c) = a -> b -> b
f a
c b
d

    foldl :: (b -> a -> b) -> b -> Encap a -> b
foldl b -> a -> b
_ b
d Encap a
Detached     = b
d
    foldl b -> a -> b
f b
d (Attached a
c) = b -> a -> b
f b
d a
c

instance Traversable Encap where
    traverse :: (a -> f b) -> Encap a -> f (Encap b)
traverse a -> f b
_ Encap a
Detached     = Encap b -> f (Encap b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Encap b
forall a. Encap a
Detached
    traverse a -> f b
f (Attached a
c) = b -> Encap b
forall a. a -> Encap a
Attached (b -> Encap b) -> f b -> f (Encap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
c

-- | Fold over an 'Encap' value.  This is similar to function 'maybe'.  If the
-- content is detached, the first argument is returned.  Otherwise the second
-- argument is applied to the content.
fromEncap :: b -> (a -> b) -> Encap a -> b
fromEncap :: b -> (a -> b) -> Encap a -> b
fromEncap b
d a -> b
_ Encap a
Detached     = b
d
fromEncap b
_ a -> b
f (Attached a
c) = a -> b
f a
c