{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
module Crypto.Store.CMS.Attribute
( Attribute(..)
, attributesASN1S
, parseAttributes
, findAttribute
, setAttribute
, filterAttributes
, setAttributeASN1S
, runParseAttribute
, getContentTypeAttr
, setContentTypeAttr
, getMessageDigestAttr
, setMessageDigestAttr
) where
import Data.ASN1.Types
import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)
import Crypto.Store.ASN1.Generate
import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS.Type
import Crypto.Store.CMS.Util
data Attribute = Attribute
{ attrType :: OID
, attrValues :: [ASN1]
}
deriving (Show,Eq)
instance ASN1Elem e => ProduceASN1Object e Attribute where
asn1s Attribute{..} =
asn1Container Sequence
(gOID attrType . asn1Container Set (gMany attrValues))
instance Monoid e => ParseASN1Object e Attribute where
parse = onNextContainer Sequence $ do
OID oid <- getNext
vals <- onNextContainer Set (getMany getNext)
return Attribute { attrType = oid, attrValues = vals }
attributesASN1S :: ASN1Elem e
=> ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S _ [] = id
attributesASN1S ty attrs = asn1Container ty (asn1s attrs)
parseAttributes :: Monoid e => ASN1ConstructionType -> ParseASN1 e [Attribute]
parseAttributes ty = fromMaybe [] <$> onNextContainerMaybe ty parse
findAttribute :: OID -> [Attribute] -> Maybe [ASN1]
findAttribute oid attrs =
case [ attrValues a | a <- attrs, attrType a == oid ] of
[] -> Nothing
(v:_) -> Just v
filterAttributes :: (OID -> Bool) -> [Attribute] -> [Attribute]
filterAttributes p = filter (p . attrType)
setAttribute :: OID -> [ASN1] -> [Attribute] -> [Attribute]
setAttribute oid vals = (:) attr . filterAttributes (/= oid)
where attr = Attribute { attrType = oid, attrValues = vals }
runParseAttribute :: OID -> [Attribute] -> ParseASN1 () a -> Maybe a
runParseAttribute oid attrs p =
case findAttribute oid attrs of
Nothing -> Nothing
Just s -> either (const Nothing) Just (runParseASN1 p s)
setAttributeASN1S :: OID -> ASN1S -> [Attribute] -> [Attribute]
setAttributeASN1S oid g = setAttribute oid (g [])
contentType :: OID
contentType = [1,2,840,113549,1,9,3]
getContentTypeAttr :: [Attribute] -> Maybe ContentType
getContentTypeAttr attrs = runParseAttribute contentType attrs $ do
OID oid <- getNext
withObjectID "content type" oid return
setContentTypeAttr :: ContentType -> [Attribute] -> [Attribute]
setContentTypeAttr ct = setAttributeASN1S contentType (gOID $ getObjectID ct)
messageDigest :: OID
messageDigest = [1,2,840,113549,1,9,4]
getMessageDigestAttr :: [Attribute] -> Maybe ByteString
getMessageDigestAttr attrs = runParseAttribute messageDigest attrs $ do
OctetString d <- getNext
return d
setMessageDigestAttr :: ByteString -> [Attribute] -> [Attribute]
setMessageDigestAttr d = setAttributeASN1S messageDigest (gOctetString d)