-- |
-- 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
(Int -> ExtensionRaw -> ShowS)
-> (ExtensionRaw -> String)
-> ([ExtensionRaw] -> ShowS)
-> Show ExtensionRaw
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
(ExtensionRaw -> ExtensionRaw -> Bool)
-> (ExtensionRaw -> ExtensionRaw -> Bool) -> Eq ExtensionRaw
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 BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
content of
        Left ASN1Error
err -> String -> Either String [ASN1]
forall a b. a -> Either a b
Left (String -> Either String [ASN1]) -> String -> Either String [ASN1]
forall a b. (a -> b) -> a -> b
$ String
"fromASN1: X509.ExtensionRaw: OID=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ OID -> String
forall a. Show a => a -> String
show OID
oid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": cannot decode data: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
err
        Right [ASN1]
r  -> [ASN1] -> Either String [ASN1]
forall a b. b -> Either a b
Right [ASN1]
r

extRawASN1 :: ExtensionRaw -> [ASN1]
extRawASN1 :: ExtensionRaw -> [ASN1]
extRawASN1 ExtensionRaw
extRaw = (String -> [ASN1])
-> ([ASN1] -> [ASN1]) -> Either String [ASN1] -> [ASN1]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [ASN1]
forall a. HasCallStack => String -> a
error [ASN1] -> [ASN1]
forall a. a -> a
id (Either String [ASN1] -> [ASN1]) -> Either String [ASN1] -> [ASN1]
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
(Int -> Extensions -> ShowS)
-> (Extensions -> String)
-> ([Extensions] -> ShowS)
-> Show Extensions
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
(Extensions -> Extensions -> Bool)
-> (Extensions -> Extensions -> Bool) -> Eq Extensions
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 -> [ASN1] -> [ASN1]
toASN1 (Extensions Maybe [ExtensionRaw]
Nothing) = \[ASN1]
xs -> [ASN1]
xs
    toASN1 (Extensions (Just [ExtensionRaw]
exts)) = \[ASN1]
xs ->
        ASN1ConstructionType -> [ASN1] -> [ASN1]
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
3) (ASN1ConstructionType -> [ASN1] -> [ASN1]
asn1Container ASN1ConstructionType
Sequence ((ExtensionRaw -> [ASN1]) -> [ExtensionRaw] -> [ASN1]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExtensionRaw -> [ASN1]
encodeExt [ExtensionRaw]
exts)) [ASN1] -> [ASN1] -> [ASN1]
forall a. [a] -> [a] -> [a]
++ [ASN1]
xs
    fromASN1 :: [ASN1] -> Either String (Extensions, [ASN1])
fromASN1 [ASN1]
s = ParseASN1 Extensions
-> [ASN1] -> Either String (Extensions, [ASN1])
forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
runParseASN1State (Maybe [ExtensionRaw] -> Extensions
Extensions (Maybe [ExtensionRaw] -> Extensions)
-> ParseASN1 (Maybe [ExtensionRaw]) -> ParseASN1 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 = ASN1ConstructionType
-> ParseASN1 [ExtensionRaw] -> ParseASN1 (Maybe [ExtensionRaw])
forall a.
ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
3) (ParseASN1 [ExtensionRaw] -> ParseASN1 (Maybe [ExtensionRaw]))
-> ParseASN1 [ExtensionRaw] -> ParseASN1 (Maybe [ExtensionRaw])
forall a b. (a -> b) -> a -> b
$
                              ASN1ConstructionType
-> ParseASN1 [ExtensionRaw] -> ParseASN1 [ExtensionRaw]
forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 ExtensionRaw -> ParseASN1 [ExtensionRaw]
forall a. ParseASN1 a -> ParseASN1 [a]
getMany ParseASN1 ExtensionRaw
forall a. ASN1Object a => ParseASN1 a
getObject)

instance ASN1Object ExtensionRaw where
    toASN1 :: ExtensionRaw -> [ASN1] -> [ASN1]
toASN1 ExtensionRaw
extraw = \[ASN1]
xs -> ExtensionRaw -> [ASN1]
encodeExt ExtensionRaw
extraw [ASN1] -> [ASN1] -> [ASN1]
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 -> (ExtensionRaw, [ASN1]) -> Either String (ExtensionRaw, [ASN1])
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           -> (ExtensionRaw, [ASN1]) -> Either String (ExtensionRaw, [ASN1])
forall a b. b -> Either a b
Right (OID -> Bool -> ByteString -> ExtensionRaw
ExtensionRaw OID
oid Bool
False ByteString
obj, [ASN1]
xs2)
            [ASN1]
_                                          -> String -> Either String (ExtensionRaw, [ASN1])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.ExtensionRaw: unknown format:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
xs)
    fromASN1 [ASN1]
l                                      =
        String -> Either String (ExtensionRaw, [ASN1])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.ExtensionRaw: unknown format:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
l)

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