-- |
-- Module      : Data.X509.ExtensionRaw
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- extension marshalling
--
module Data.X509.ExtensionRaw
    ( ExtensionRaw(..)
    , tryExtRawASN1
    , extRawASN1
    , Extensions(..)
    ) where

import Control.Applicative
import Data.ASN1.Types
import Data.ASN1.Encoding
import Data.ASN1.BinaryEncoding
import Data.X509.Internal
import qualified Data.ByteString as B

-- | An undecoded extension
data ExtensionRaw = ExtensionRaw
    { ExtensionRaw -> OID
extRawOID      :: OID    -- ^ OID of this extension
    , ExtensionRaw -> Bool
extRawCritical :: Bool   -- ^ if this extension is critical
    , ExtensionRaw -> ByteString
extRawContent  :: B.ByteString -- ^ undecoded content
    } deriving (Int -> ExtensionRaw -> ShowS
[ExtensionRaw] -> ShowS
ExtensionRaw -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtensionRaw] -> ShowS
$cshowList :: [ExtensionRaw] -> ShowS
show :: ExtensionRaw -> String
$cshow :: ExtensionRaw -> String
showsPrec :: Int -> ExtensionRaw -> ShowS
$cshowsPrec :: Int -> ExtensionRaw -> ShowS
Show,ExtensionRaw -> ExtensionRaw -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtensionRaw -> ExtensionRaw -> Bool
$c/= :: ExtensionRaw -> ExtensionRaw -> Bool
== :: ExtensionRaw -> ExtensionRaw -> Bool
$c== :: ExtensionRaw -> ExtensionRaw -> Bool
Eq)

tryExtRawASN1 :: ExtensionRaw -> Either String [ASN1]
tryExtRawASN1 :: ExtensionRaw -> Either String [ASN1]
tryExtRawASN1 (ExtensionRaw OID
oid Bool
_ ByteString
content) =
    case forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
content of
        Left ASN1Error
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"fromASN1: X509.ExtensionRaw: OID=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show OID
oid forall a. [a] -> [a] -> [a]
++ String
": cannot decode data: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASN1Error
err
        Right [ASN1]
r  -> forall a b. b -> Either a b
Right [ASN1]
r

extRawASN1 :: ExtensionRaw -> [ASN1]
extRawASN1 :: ExtensionRaw -> [ASN1]
extRawASN1 ExtensionRaw
extRaw = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Either String [ASN1]
tryExtRawASN1 ExtensionRaw
extRaw
{-# DEPRECATED extRawASN1 "use tryExtRawASN1 instead" #-}

-- | a Set of 'ExtensionRaw'
newtype Extensions = Extensions (Maybe [ExtensionRaw])
    deriving (Int -> Extensions -> ShowS
[Extensions] -> ShowS
Extensions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extensions] -> ShowS
$cshowList :: [Extensions] -> ShowS
show :: Extensions -> String
$cshow :: Extensions -> String
showsPrec :: Int -> Extensions -> ShowS
$cshowsPrec :: Int -> Extensions -> ShowS
Show,Extensions -> Extensions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extensions -> Extensions -> Bool
$c/= :: Extensions -> Extensions -> Bool
== :: Extensions -> Extensions -> Bool
$c== :: Extensions -> Extensions -> Bool
Eq)

instance ASN1Object Extensions where
    toASN1 :: Extensions -> ASN1S
toASN1 (Extensions Maybe [ExtensionRaw]
Nothing) = \[ASN1]
xs -> [ASN1]
xs
    toASN1 (Extensions (Just [ExtensionRaw]
exts)) = \[ASN1]
xs ->
        ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExtensionRaw -> [ASN1]
encodeExt [ExtensionRaw]
exts) forall a. [a] -> [a] -> [a]
++ [ASN1]
xs
    fromASN1 :: [ASN1] -> Either String (Extensions, [ASN1])
fromASN1 [ASN1]
s = forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
runParseASN1State (Maybe [ExtensionRaw] -> Extensions
Extensions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 (Maybe [ExtensionRaw])
parseExtensions) [ASN1]
s
      where parseExtensions :: ParseASN1 (Maybe [ExtensionRaw])
parseExtensions = forall a.
ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
onNextContainerMaybe ASN1ConstructionType
Sequence (forall a. ParseASN1 a -> ParseASN1 [a]
getMany forall a. ASN1Object a => ParseASN1 a
getObject)

instance ASN1Object ExtensionRaw where
    toASN1 :: ExtensionRaw -> ASN1S
toASN1 ExtensionRaw
extraw = \[ASN1]
xs -> ExtensionRaw -> [ASN1]
encodeExt ExtensionRaw
extraw forall a. [a] -> [a] -> [a]
++ [ASN1]
xs
    fromASN1 :: [ASN1] -> Either String (ExtensionRaw, [ASN1])
fromASN1 (Start ASN1ConstructionType
Sequence:OID OID
oid:[ASN1]
xs) =
        case [ASN1]
xs of
            Boolean Bool
b:OctetString ByteString
obj:End ASN1ConstructionType
Sequence:[ASN1]
xs2 -> forall a b. b -> Either a b
Right (OID -> Bool -> ByteString -> ExtensionRaw
ExtensionRaw OID
oid Bool
b ByteString
obj, [ASN1]
xs2)
            OctetString ByteString
obj:End ASN1ConstructionType
Sequence:[ASN1]
xs2           -> forall a b. b -> Either a b
Right (OID -> Bool -> ByteString -> ExtensionRaw
ExtensionRaw OID
oid Bool
False ByteString
obj, [ASN1]
xs2)
            [ASN1]
_                                          -> forall a b. a -> Either a b
Left (String
"fromASN1: X509.ExtensionRaw: unknown format:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [ASN1]
xs)
    fromASN1 [ASN1]
l                                      =
        forall a b. a -> Either a b
Left (String
"fromASN1: X509.ExtensionRaw: unknown format:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [ASN1]
l)

encodeExt :: ExtensionRaw -> [ASN1]
encodeExt :: ExtensionRaw -> [ASN1]
encodeExt (ExtensionRaw OID
oid Bool
critical ByteString
content) =
    ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence ([OID -> ASN1
OID OID
oid] forall a. [a] -> [a] -> [a]
++ (if Bool
critical then [Bool -> ASN1
Boolean Bool
True] else []) forall a. [a] -> [a] -> [a]
++ [ByteString -> ASN1
OctetString ByteString
content])