{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Data.ASN1
( ASN1(..)
, ASN1Decode
, ASN1Encode
, ENUMERATED(..), Enumerated(..)
, IMPLICIT(..), implicit
, EXPLICIT(..), explicit
, OCTET_STRING
, NULL
, BOOLEAN
, BOOLEAN_DEFAULT_FALSE(..)
, OPTIONAL
, SET(..)
, SET1(..)
, toBinaryPut
, toBinaryGet
, retag, wraptag
, with'SEQUENCE
, enc'SEQUENCE
, enc'SEQUENCE_COMPS
, with'CHOICE
, dec'BoundedEnum
, enc'BoundedEnum
, dec'NULL
, enc'NULL
) where
import Common
import Data.ASN1.Prim
import Data.Int.Subtypes
import Data.Binary as Bin
import Data.Binary.Get as Bin
import Data.Binary.Put as Bin
import Data.Bool (bool)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as SBS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String (IsString)
import qualified Data.Text.Short as TS
class Enumerated x where
toEnumerated :: Int64 -> Maybe x
fromEnumerated :: x -> Int64
instance Enumerated Int64 where
toEnumerated = Just
fromEnumerated = id
instance Enumerated Int where
toEnumerated = intCastMaybe
fromEnumerated = fromIntegral
data ASN1Res x = Consumed ( Maybe TL) x
| Unexpected TL
| UnexpectedEOF
deriving (Show,Functor)
newtype ASN1Encode a = ASN1Encode (Maybe Tag -> PutM a)
empty'ASN1Encode :: ASN1Encode Word64
empty'ASN1Encode = ASN1Encode $ \case
Just _ -> error "empty'ASN1Encode: called with tag-override"
Nothing -> pure 0
toBinaryPut :: ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode body) = body Nothing
enc'SEQUENCE_COMPS :: [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS [] = empty'ASN1Encode
enc'SEQUENCE_COMPS xs0 = ASN1Encode $ \case
Just _ -> error "enc'SEQUENCE_COMPS: called with tag-override"
Nothing -> go xs0 0
where
go [] sz = pure sz
go (ASN1Encode x:xs) sz = do
n1 <- x Nothing
go xs (sz+n1)
enc'SEQUENCE :: [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE = wraptag (Universal 16) . enc'SEQUENCE_COMPS
enc'SET :: [ASN1Encode Word64] -> ASN1Encode Word64
enc'SET = retag (Universal 17) . enc'SEQUENCE
data ASN1Decode x = ASN1Decode { asn1dTags :: !(Set Tag)
, asn1dAny :: !Bool
, asn1dContent :: Maybe TL -> Get (ASN1Res x)
}
asn1DecodeSingleton :: Tag -> (TL -> Get x) -> ASN1Decode x
asn1DecodeSingleton t c = mempty { asn1dTags = Set.singleton t
, asn1dContent = \case
Just tl@(t',_,_) | t /= t' -> pure (Unexpected tl)
| otherwise -> Consumed Nothing <$> c tl
Nothing -> pure UnexpectedEOF
}
asn1DecodeSingleton' :: Tag -> (TL -> Get (ASN1Res x)) -> ASN1Decode x
asn1DecodeSingleton' t c = mempty { asn1dTags = Set.singleton t
, asn1dContent = \case
Just tl@(t',_,_) | t /= t' -> pure (Unexpected tl)
| otherwise -> c tl
Nothing -> pure UnexpectedEOF
}
asn1decodeIsSingleton :: ASN1Decode x -> Maybe Tag
asn1decodeIsSingleton (ASN1Decode {..})
| asn1dAny = Nothing
| [t1] <- Set.toList asn1dTags = Just t1
| otherwise = Nothing
with'OPTIONAL :: ASN1Decode x -> ASN1Decode (Maybe x)
with'OPTIONAL x = x { asn1dAny = True
, asn1dContent = \case
Nothing -> pure $ Consumed Nothing Nothing
Just tl -> g <$> asn1dContent x (Just tl)
}
where
g (Consumed mleftover v) = Consumed mleftover (Just v)
g (Unexpected leftover) = Consumed (Just leftover) Nothing
g UnexpectedEOF = Consumed Nothing Nothing
instance Semigroup (ASN1Decode x) where
x <> y
| asn1decodeIsEmpty x = y
| asn1decodeIsEmpty y = x
| otherwise = ASN1Decode
{ asn1dTags = asn1dTags x <> asn1dTags y
, asn1dAny = asn1dAny x || asn1dAny y
, asn1dContent = \case
tl@(Just (t,_,_)) -> case () of
_ | Set.member t (asn1dTags x) -> asn1dContent x tl
| Set.member t (asn1dTags y) -> asn1dContent y tl
| asn1dAny x -> asn1dContent x tl
| asn1dAny y -> asn1dContent y tl
| otherwise -> fail "asn1dContent called with unsupported Tag"
Nothing -> case () of
_ | asn1dAny x -> asn1dContent x Nothing
| asn1dAny y -> asn1dContent y Nothing
| otherwise -> pure UnexpectedEOF
}
asn1decodeIsEmpty :: ASN1Decode x -> Bool
asn1decodeIsEmpty ASN1Decode{..} = not asn1dAny && Set.null asn1dTags
instance Monoid (ASN1Decode x) where
mempty = ASN1Decode mempty False (pure . maybe UnexpectedEOF Unexpected)
mappend = (<>)
instance Functor ASN1Decode where
fmap f dec = dec { asn1dContent = \tl -> fmap f <$> asn1dContent dec tl }
instance Applicative ASN1Decode where
pure x = mempty { asn1dAny = True
, asn1dContent = \tl -> pure (Consumed tl x)
}
(<*>) = ap
instance Monad ASN1Decode where
return = pure
mx >>= k = ASN1Decode { asn1dAny = asn1dAny mx
, asn1dTags = asn1dTags mx
, asn1dContent = \mtl -> do
x0 <- getASN1Decode mx mtl
case x0 of
Consumed (Just tl') x -> do
getASN1Decode (k x) (Just tl')
Consumed Nothing x -> do
mtl' <- getTagLength BER
getASN1Decode (k x) mtl'
Unexpected (t,_,_) ->
fail ("ASN1Decode: Unexpected " ++ show t)
UnexpectedEOF ->
fail ("ASN1Decode: UnexpectedEOF")
}
asn1fail :: String -> ASN1Decode a
asn1fail s = mempty { asn1dAny = True
, asn1dContent = \_ -> fail s
}
toBinaryGet :: ASN1Decode x -> Get x
toBinaryGet dec
= getTagLength BER >>= getASN1Decode dec >>= \case
Unexpected tl -> fail ("ASN1Decode: unexpected " ++ show tl)
UnexpectedEOF -> fail "ASN1Decode: premature end of stream"
Consumed (Just tl) _ -> fail ("ASN1Decode: leftover " ++ show tl)
Consumed Nothing x -> pure x
getASN1Decode :: ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode (ASN1Decode{..}) Nothing
| asn1dAny = asn1dContent Nothing
| otherwise = pure UnexpectedEOF
getASN1Decode (ASN1Decode{..}) (Just tl@(t,_,_))
| asn1dAny || Set.member t asn1dTags = asn1dContent (Just tl)
| otherwise = pure (Unexpected tl)
transformVia :: ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
transformVia old f
= old { asn1dContent = \mtl -> do
asn1dContent old mtl >>= \case
Consumed lo x -> case f x of
Left e -> fail e
Right y -> pure (Consumed lo y)
Unexpected u -> pure (Unexpected u)
UnexpectedEOF -> pure UnexpectedEOF
}
explicit :: Tag -> ASN1Decode x -> ASN1Decode x
explicit t body = with'Constructed (show t ++ " EXPLICIT") t body
implicit :: Tag -> ASN1Decode x -> ASN1Decode x
implicit newtag old
| Just oldtag <- asn1decodeIsSingleton old
= mempty { asn1dTags = Set.singleton newtag
, asn1dContent = \case
Just tl@(curtag,_,_) | newtag /= curtag -> pure (Unexpected tl)
Just (_,pc,sz) -> asn1dContent old (Just (oldtag,pc,sz))
Nothing -> asn1dContent old Nothing
}
| otherwise = error "implicit applied to non-singleton ASN1Decode"
with'CHOICE :: [ASN1Decode x] -> ASN1Decode x
with'CHOICE = mconcat
with'Constructed :: forall x . String -> Tag -> ASN1Decode x -> ASN1Decode x
with'Constructed l tag body = asn1DecodeSingleton' tag go
where
go :: TL -> Get (ASN1Res x)
go (_,Primitive,_) = fail (l ++ " with primitive encoding")
go (_,Constructed,Nothing) = fail (l ++ " with indef length not supported yet")
go (_,Constructed,Just sz) = isolate64 sz $ do
tl' <- getTagLength BER
getASN1Decode body tl'
with'SEQUENCE :: forall x . ASN1Decode x -> ASN1Decode x
with'SEQUENCE = with'Constructed "SEQUENCE" (Universal 16)
with'SEQUENCE_OF :: forall x . ASN1Decode x -> ASN1Decode [x]
with'SEQUENCE_OF body = asn1DecodeSingleton' (Universal 16) go
where
go :: TL -> Get (ASN1Res [x])
go (_,Primitive,_) = fail "SEQUENCE OF with primitive encoding"
go (_,Constructed,Nothing) = fail "indef SEQUENCE OF not implemented yet"
go (_,Constructed,Just sz) = isolate64 sz $ do
let loop :: [x] -> Maybe TL -> Get [x]
loop acc tl0 = do
tl' <- case tl0 of
Just _ -> pure tl0
Nothing -> getTagLength BER
case tl' of
Nothing -> pure (reverse acc)
Just _ -> do
tmp <- getASN1Decode body tl'
case tmp of
Consumed tl'' v -> loop (v:acc) tl''
UnexpectedEOF -> fail "with'SEQUENCE_OF: unexpected EOF"
Unexpected t -> fail ("with'SEQUENCE_OF: unexpected " ++ show t)
Consumed Nothing <$> loop [] Nothing
with'SET_OF :: forall x . ASN1Decode x -> ASN1Decode [x]
with'SET_OF body = asn1DecodeSingleton' (Universal 17) go
where
go :: TL -> Get (ASN1Res [x])
go (_,Primitive,_) = fail "SET OF with primitive encoding"
go (_,Constructed,Nothing) = fail "indef SET OF not implemented yet"
go (_,Constructed,Just sz) = isolate64 sz $ do
let loop :: [x] -> Maybe TL -> Get [x]
loop acc tl0 = do
tl' <- case tl0 of
Just _ -> pure tl0
Nothing -> getTagLength BER
case tl' of
Nothing -> pure (reverse acc)
Just _ -> do
tmp <- getASN1Decode body tl'
case tmp of
Consumed tl'' v -> loop (v:acc) tl''
UnexpectedEOF -> fail "with'SET_OF: unexpected EOF"
Unexpected t -> fail ("with'SET_OF: unexpected " ++ show t)
Consumed Nothing <$> loop [] Nothing
dec'BOOLEAN :: ASN1Decode Bool
dec'BOOLEAN = asn1DecodeSingleton (Universal 1) $ asPrimitive go
where
go 1 = do
x <- getWord8
case x of
0x00 -> pure False
0xff -> pure True
_ -> fail "BOOLEAN must be encoded as either 0x00 or 0xFF"
go _ = fail "BOOLEAN with content-length not equal 1"
enc'BOOLEAN :: Bool -> ASN1Encode Word64
enc'BOOLEAN v = ASN1Encode $ \mt -> do
_ <- putTagLength (Universal 1 `fromMaybe` mt, Primitive, Just 1)
putWord8 (if v then 0xff else 0x00)
pure 3
dec'INTEGER :: ASN1Decode Integer
dec'INTEGER = asn1DecodeSingleton (Universal 2) $ asPrimitive getVarInteger
enc'INTEGER :: Integer -> ASN1Encode Word64
enc'INTEGER i = wrap'DEFINITE (Universal 2) Primitive (putVarInteger i)
dec'UInt :: forall lb ub t . (UIntBounds lb ub t, Num t) => ASN1Decode (UInt lb ub t)
dec'UInt = do
i <- dec'INTEGER
case uintFromInteger (toInteger i) of
Left Underflow -> asn1fail "INTEGER below lower bound"
Left Overflow -> asn1fail "INTEGER above upper bound"
Left _ -> asn1fail "INTEGER"
Right v -> pure v
enc'UInt :: forall lb ub t . (UIntBounds lb ub t, Num t, Integral t) => UInt lb ub t -> ASN1Encode Word64
enc'UInt = enc'INTEGER . toInteger . fromUInt
dec'Int64 :: ASN1Decode Int64
dec'Int64 = asn1DecodeSingleton (Universal 2) $ asPrimitive getVarInt64
enc'Int64 :: Int64 -> ASN1Encode Word64
enc'Int64 i = wrap'DEFINITE (Universal 2) Primitive (putVarInt64 i)
dec'ENUMERATED :: Enumerated enum => ASN1Decode enum
dec'ENUMERATED = asn1DecodeSingleton (Universal 10) $ asPrimitive $ \sz -> do
i <- go sz
maybe (fail "invalid ENUMERATED value") pure (toEnumerated i)
where
go 0 = fail "ENUMERATED with empty content"
go sz
| sz <= 8 = getVarInt64 sz
| otherwise = fail "invalid ENUMERATED value"
enc'ENUMERATED :: Enumerated enum => enum -> ASN1Encode Word64
enc'ENUMERATED = retag (Universal 10) . enc'Int64 . fromEnumerated
dec'BoundedEnum :: forall enum . (Bounded enum, Enum enum) => ASN1Decode enum
dec'BoundedEnum = do
i <- dec'ENUMERATED
unless (i `inside` (lb,ub)) $ asn1fail "invalid ENUMERATED value"
pure (toEnum i)
where
lb = fromEnum (minBound :: enum)
ub = fromEnum (maxBound :: enum)
enc'BoundedEnum :: Enum enum => enum -> ASN1Encode Word64
enc'BoundedEnum v = enc'ENUMERATED (fromIntegral (fromEnum v) :: Int64)
dec'NULL :: ASN1Decode ()
dec'NULL = asn1DecodeSingleton (Universal 5) $ asPrimitive go
where
go 0 = pure ()
go _ = fail "NULL with content-length not equal 0"
enc'NULL :: ASN1Encode Word64
enc'NULL = ASN1Encode $ \mt -> putTagLength (Universal 5 `fromMaybe` mt, Primitive, Just 0)
dec'OCTETSTRING :: ASN1Decode ByteString
dec'OCTETSTRING = asn1DecodeSingleton (Universal 4) $ asPrimitive go
where
go sz
| Just sz' <- intCastMaybe sz = Bin.getByteString sz'
| otherwise = fail "OCTET STRING too large for this implementation"
enc'OCTETSTRING :: ByteString -> ASN1Encode Word64
enc'OCTETSTRING bs = ASN1Encode $ \mt -> do
let cl = fromIntegral (BS.length bs)
hl <- putTagLength (Universal 4 `fromMaybe` mt, Primitive, Just cl)
Bin.putByteString bs
pure (hl + cl)
wrap'DEFINITE :: Tag -> TagPC -> PutM Word64 -> ASN1Encode Word64
wrap'DEFINITE t0 pc body = ASN1Encode $ \mt -> do
let (cl, lbs) = Bin.runPutM body
hl <- putTagLength (fromMaybe t0 mt, pc, Just cl)
Bin.putLazyByteString lbs
pure (hl+cl)
retag :: Tag -> ASN1Encode a -> ASN1Encode a
retag newtag (ASN1Encode old) = ASN1Encode (\mt -> old (mt <|> Just newtag))
wraptag :: Tag -> ASN1Encode Word64 -> ASN1Encode Word64
wraptag newtag (ASN1Encode old) = wrap'DEFINITE newtag Constructed (old Nothing)
newtype IMPLICIT (tag :: TagK) x = IMPLICIT x
deriving (Generic,NFData,IsString,Num,Show,Eq,Ord,Enum)
instance Newtype (IMPLICIT tag x) x
newtype EXPLICIT (tag :: TagK) x = EXPLICIT x
deriving (Generic,NFData,IsString,Num,Show,Eq,Ord,Enum)
instance Newtype (EXPLICIT tag x) x
newtype ENUMERATED x = ENUMERATED x
deriving (Generic,NFData,Num,Show,Eq,Ord,Enum)
instance Newtype (ENUMERATED x) x
class ASN1 t where
asn1decode :: ASN1Decode t
asn1decode = with'Constructed "SEQUENCE" (asn1defTag (Proxy :: Proxy t)) asn1decodeCompOf
asn1decodeCompOf :: ASN1Decode t
asn1decodeCompOf = asn1fail "asn1decodeCompOf not implemented for type"
asn1encode :: t -> ASN1Encode Word64
asn1encode = wraptag (asn1defTag (Proxy :: Proxy t)) . asn1encodeCompOf
asn1encodeCompOf :: t -> ASN1Encode Word64
asn1encodeCompOf = error "asn1encode(CompOf) not implemented for type"
asn1defTag :: Proxy t -> Tag
asn1defTag _ = Universal 16
{-# MINIMAL (asn1decode | asn1decodeCompOf), (asn1encode | asn1encodeCompOf) #-}
instance (ASN1 t1, ASN1 t2) => ASN1 (t1,t2) where
asn1encodeCompOf (v1,v2) = enc'SEQUENCE_COMPS [asn1encode v1, asn1encode v2]
asn1decodeCompOf = (,) <$> asn1decode <*> asn1decode
instance (ASN1 t1, ASN1 t2, ASN1 t3) => ASN1 (t1,t2,t3) where
asn1encodeCompOf (v1,v2,v3) = enc'SEQUENCE_COMPS [asn1encode v1, asn1encode v2, asn1encode v3]
asn1decodeCompOf = (,,) <$> asn1decode <*> asn1decode <*> asn1decode
instance (ASN1 t1, ASN1 t2, ASN1 t3, ASN1 t4) => ASN1 (t1,t2,t3,t4) where
asn1encodeCompOf (v1,v2,v3,v4) = enc'SEQUENCE_COMPS [asn1encode v1, asn1encode v2, asn1encode v3, asn1encode v4]
asn1decodeCompOf = (,,,) <$> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode
instance (ASN1 t1, ASN1 t2, ASN1 t3, ASN1 t4, ASN1 t5) => ASN1 (t1,t2,t3,t4,t5) where
asn1encodeCompOf (v1,v2,v3,v4,v5) = enc'SEQUENCE_COMPS [asn1encode v1, asn1encode v2, asn1encode v3, asn1encode v4, asn1encode v5]
asn1decodeCompOf = (,,,,) <$> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode
instance (ASN1 t1, ASN1 t2, ASN1 t3, ASN1 t4, ASN1 t5, ASN1 t6) => ASN1 (t1,t2,t3,t4,t5,t6) where
asn1encodeCompOf (v1,v2,v3,v4,v5,v6) = enc'SEQUENCE_COMPS [asn1encode v1, asn1encode v2, asn1encode v3, asn1encode v4, asn1encode v5, asn1encode v6]
asn1decodeCompOf = (,,,,,) <$> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode
instance (ASN1 t1, ASN1 t2, ASN1 t3, ASN1 t4, ASN1 t5, ASN1 t6, ASN1 t7) => ASN1 (t1,t2,t3,t4,t5,t6,t7) where
asn1encodeCompOf (v1,v2,v3,v4,v5,v6,v7) = enc'SEQUENCE_COMPS [asn1encode v1, asn1encode v2, asn1encode v3, asn1encode v4, asn1encode v5, asn1encode v6, asn1encode v7]
asn1decodeCompOf = (,,,,,,) <$> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode <*> asn1decode
type OCTET_STRING = ByteString
instance ASN1 ByteString where
asn1defTag _ = Universal 4
asn1decode = dec'OCTETSTRING
asn1encode = enc'OCTETSTRING
instance ASN1 SBS.ShortByteString where
asn1defTag _ = Universal 4
asn1decode = SBS.toShort <$> dec'OCTETSTRING
asn1encode = enc'OCTETSTRING . SBS.fromShort
instance ASN1 ShortText where
asn1defTag _ = Universal 4
asn1decode = do
bs <- dec'OCTETSTRING
maybe (asn1fail "OCTECT STRING contained invalid UTF-8") pure (TS.fromByteString bs)
asn1encode = asn1encode . TS.toShortByteString
type BOOLEAN = Bool
instance ASN1 Bool where
asn1defTag _ = Universal 1
asn1decode = dec'BOOLEAN
asn1encode = enc'BOOLEAN
type OPTIONAL x = Maybe x
instance ASN1 t => ASN1 (Maybe t) where
asn1defTag _ = asn1defTag (Proxy :: Proxy t)
asn1decode = with'OPTIONAL asn1decode
asn1encode Nothing = empty'ASN1Encode
asn1encode (Just v) = asn1encode v
instance Enumerated t => ASN1 (ENUMERATED t) where
asn1defTag _ = Universal 10
asn1decode = ENUMERATED <$> dec'ENUMERATED
asn1encode (ENUMERATED v) = enc'ENUMERATED v
instance ASN1 t => ASN1 [t] where
asn1decode = with'SEQUENCE_OF asn1decode
asn1encode = enc'SEQUENCE . map asn1encode
instance ASN1 t => ASN1 (NonEmpty t) where
asn1decode = asn1decode >>= \case
[] -> asn1fail "SEQUENCE must be non-empty"
x:xs -> pure (x :| xs)
asn1encode (x :| xs) = asn1encode (x:xs)
newtype SET1 x = SET1 (NonEmpty x)
deriving (Generic,NFData,Show,Eq,Ord)
instance Newtype (SET1 x) (NonEmpty x)
instance ASN1 t => ASN1 (SET1 t) where
asn1defTag _ = Universal 17
asn1decode = asn1decode >>= \case
SET [] -> asn1fail "SET must be non-empty"
SET (x:xs) -> pure (SET1 (x :| xs))
asn1encode (SET1 (x :| xs)) = asn1encode (SET (x:xs))
newtype SET x = SET [x]
deriving (Generic,NFData,Show,Eq,Ord)
instance Newtype (SET x) [x]
instance ASN1 t => ASN1 (SET t) where
asn1defTag _ = Universal 17
asn1decode = SET <$> with'SET_OF asn1decode
asn1encode (SET vs) = enc'SET (map asn1encode vs)
instance ASN1 Integer where
asn1defTag _ = Universal 2
asn1decode = dec'INTEGER
asn1encode = enc'INTEGER
instance ASN1 Int64 where
asn1defTag _ = Universal 2
asn1decode = dec'Int64
asn1encode = enc'Int64
instance (UIntBounds lb ub t, Integral t) => ASN1 (UInt lb ub t) where
asn1defTag _ = Universal 2
asn1decode = dec'UInt
asn1encode = enc'UInt
instance forall tag t . (KnownTag tag, ASN1 t) => ASN1 (IMPLICIT tag t) where
asn1defTag _ = tagVal (Proxy :: Proxy tag)
asn1decode = IMPLICIT <$> implicit (tagVal (Proxy :: Proxy tag)) asn1decode
asn1encode (IMPLICIT v) = retag (tagVal (Proxy :: Proxy tag)) (asn1encode v)
instance forall tag t . (KnownTag tag, ASN1 t) => ASN1 (EXPLICIT tag t) where
asn1defTag _ = tagVal (Proxy :: Proxy tag)
asn1decode = EXPLICIT <$> explicit (tagVal (Proxy :: Proxy tag)) asn1decode
asn1encode (EXPLICIT v) = wraptag (tagVal (Proxy :: Proxy tag)) (asn1encode v)
type NULL = ()
instance ASN1 () where
asn1defTag _ = Universal 5
asn1decode = dec'NULL
asn1encode () = enc'NULL
data BOOLEAN_DEFAULT_FALSE = BOOL_TRUE
deriving (Generic,Eq,Ord,Show)
instance NFData BOOLEAN_DEFAULT_FALSE where
rnf BOOL_TRUE = ()
instance ASN1 BOOLEAN_DEFAULT_FALSE where
asn1defTag _ = Universal 1
asn1decode = dec'BOOLEAN `transformVia`
bool (Left "FALSE encountered despite 'BOOLEAN DEFAULT FALSE'") (Right BOOL_TRUE)
asn1encode BOOL_TRUE = asn1encode True