-- Copyright (c) 2018-2019  Herbert Valerio Riedel <hvr@gnu.org>
--
--  This file is free software: you may copy, redistribute and/or modify it
--  under the terms of the GNU General Public License as published by the
--  Free Software Foundation, either version 2 of the License, or (at your
--  option) any later version.
--
--  This file is distributed in the hope that it will be useful, but
--  WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program (see `LICENSE`).  If not, see
--  <https://www.gnu.org/licenses/old-licenses/gpl-2.0.html>.

{-# 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 :: Int64 -> Maybe Int64
toEnumerated = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just
  fromEnumerated :: Int64 -> Int64
fromEnumerated = Int64 -> Int64
forall a. a -> a
id

instance Enumerated Int where
  toEnumerated :: Int64 -> Maybe Int
toEnumerated = Int64 -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
intCastMaybe
  fromEnumerated :: Int -> Int64
fromEnumerated = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

----------------------------------------------------------------------------

data ASN1Res x = Consumed ({- leftover -} Maybe TL) x
               | Unexpected {- leftover -} TL
               | UnexpectedEOF
               deriving (Int -> ASN1Res x -> ShowS
[ASN1Res x] -> ShowS
ASN1Res x -> String
(Int -> ASN1Res x -> ShowS)
-> (ASN1Res x -> String)
-> ([ASN1Res x] -> ShowS)
-> Show (ASN1Res x)
forall x. Show x => Int -> ASN1Res x -> ShowS
forall x. Show x => [ASN1Res x] -> ShowS
forall x. Show x => ASN1Res x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ASN1Res x] -> ShowS
$cshowList :: forall x. Show x => [ASN1Res x] -> ShowS
show :: ASN1Res x -> String
$cshow :: forall x. Show x => ASN1Res x -> String
showsPrec :: Int -> ASN1Res x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> ASN1Res x -> ShowS
Show,a -> ASN1Res b -> ASN1Res a
(a -> b) -> ASN1Res a -> ASN1Res b
(forall a b. (a -> b) -> ASN1Res a -> ASN1Res b)
-> (forall a b. a -> ASN1Res b -> ASN1Res a) -> Functor ASN1Res
forall a b. a -> ASN1Res b -> ASN1Res a
forall a b. (a -> b) -> ASN1Res a -> ASN1Res b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ASN1Res b -> ASN1Res a
$c<$ :: forall a b. a -> ASN1Res b -> ASN1Res a
fmap :: (a -> b) -> ASN1Res a -> ASN1Res b
$cfmap :: forall a b. (a -> b) -> ASN1Res a -> ASN1Res b
Functor)

newtype ASN1Encode a = ASN1Encode (Maybe Tag -> PutM a)

empty'ASN1Encode :: ASN1Encode Word64
empty'ASN1Encode :: ASN1Encode Word64
empty'ASN1Encode = (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a. (Maybe Tag -> PutM a) -> ASN1Encode a
ASN1Encode ((Maybe Tag -> PutM Word64) -> ASN1Encode Word64)
-> (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a b. (a -> b) -> a -> b
$ \case
  Just _  -> String -> PutM Word64
forall a. HasCallStack => String -> a
error "empty'ASN1Encode: called with tag-override"
  Nothing -> Word64 -> PutM Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0

toBinaryPut :: ASN1Encode a -> PutM a
toBinaryPut :: ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode body :: Maybe Tag -> PutM a
body) = Maybe Tag -> PutM a
body Maybe Tag
forall a. Maybe a
Nothing

enc'SEQUENCE_COMPS :: [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS :: [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS [] = ASN1Encode Word64
empty'ASN1Encode
enc'SEQUENCE_COMPS xs0 :: [ASN1Encode Word64]
xs0 = (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a. (Maybe Tag -> PutM a) -> ASN1Encode a
ASN1Encode ((Maybe Tag -> PutM Word64) -> ASN1Encode Word64)
-> (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a b. (a -> b) -> a -> b
$ \case
    Just _  -> String -> PutM Word64
forall a. HasCallStack => String -> a
error "enc'SEQUENCE_COMPS: called with tag-override"
    Nothing -> [ASN1Encode Word64] -> Word64 -> PutM Word64
forall t. Num t => [ASN1Encode t] -> t -> PutM t
go [ASN1Encode Word64]
xs0 0
  where
    go :: [ASN1Encode t] -> t -> PutM t
go [] sz :: t
sz = t -> PutM t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
sz
    go (ASN1Encode x :: Maybe Tag -> PutM t
x:xs :: [ASN1Encode t]
xs) sz :: t
sz = do
      t
n1 <- Maybe Tag -> PutM t
x Maybe Tag
forall a. Maybe a
Nothing
      [ASN1Encode t] -> t -> PutM t
go [ASN1Encode t]
xs (t
szt -> t -> t
forall a. Num a => a -> a -> a
+t
n1)

enc'SEQUENCE :: [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE :: [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE = Tag -> ASN1Encode Word64 -> ASN1Encode Word64
wraptag (Word64 -> Tag
Universal 16) (ASN1Encode Word64 -> ASN1Encode Word64)
-> ([ASN1Encode Word64] -> ASN1Encode Word64)
-> [ASN1Encode Word64]
-> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS

enc'SET :: [ASN1Encode Word64] -> ASN1Encode Word64
enc'SET :: [ASN1Encode Word64] -> ASN1Encode Word64
enc'SET = Tag -> ASN1Encode Word64 -> ASN1Encode Word64
forall a. Tag -> ASN1Encode a -> ASN1Encode a
retag (Word64 -> Tag
Universal 17) (ASN1Encode Word64 -> ASN1Encode Word64)
-> ([ASN1Encode Word64] -> ASN1Encode Word64)
-> [ASN1Encode Word64]
-> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE

data ASN1Decode x = ASN1Decode { ASN1Decode x -> Set Tag
asn1dTags    :: !(Set Tag)
                               , ASN1Decode x -> Bool
asn1dAny     :: !Bool
                               , ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent :: Maybe TL {- Nothing == EOF -} -> Get (ASN1Res x)
                               }




asn1DecodeSingleton :: Tag -> (TL -> Get x) -> ASN1Decode x
asn1DecodeSingleton :: Tag -> (TL -> Get x) -> ASN1Decode x
asn1DecodeSingleton t :: Tag
t c :: TL -> Get x
c = ASN1Decode Any
forall a. Monoid a => a
mempty { asn1dTags :: Set Tag
asn1dTags    = Tag -> Set Tag
forall a. a -> Set a
Set.singleton Tag
t
                                 , asn1dContent :: Maybe TL -> Get (ASN1Res x)
asn1dContent = \case
                                     Just tl :: TL
tl@(t' :: Tag
t',_,_) | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
/= Tag
t' -> ASN1Res x -> Get (ASN1Res x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TL -> ASN1Res x
forall x. TL -> ASN1Res x
Unexpected TL
tl)
                                                      | Bool
otherwise -> Maybe TL -> x -> ASN1Res x
forall x. Maybe TL -> x -> ASN1Res x
Consumed Maybe TL
forall a. Maybe a
Nothing (x -> ASN1Res x) -> Get x -> Get (ASN1Res x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TL -> Get x
c TL
tl
                                     Nothing -> ASN1Res x -> Get (ASN1Res x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ASN1Res x
forall x. ASN1Res x
UnexpectedEOF
                                 }


asn1DecodeSingleton' :: Tag -> (TL -> Get (ASN1Res x)) -> ASN1Decode x
asn1DecodeSingleton' :: Tag -> (TL -> Get (ASN1Res x)) -> ASN1Decode x
asn1DecodeSingleton' t :: Tag
t c :: TL -> Get (ASN1Res x)
c = ASN1Decode Any
forall a. Monoid a => a
mempty { asn1dTags :: Set Tag
asn1dTags    = Tag -> Set Tag
forall a. a -> Set a
Set.singleton Tag
t
                                  , asn1dContent :: Maybe TL -> Get (ASN1Res x)
asn1dContent = \case
                                      Just tl :: TL
tl@(t' :: Tag
t',_,_) | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
/= Tag
t' -> ASN1Res x -> Get (ASN1Res x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TL -> ASN1Res x
forall x. TL -> ASN1Res x
Unexpected TL
tl)
                                                       | Bool
otherwise -> TL -> Get (ASN1Res x)
c TL
tl
                                      Nothing -> ASN1Res x -> Get (ASN1Res x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ASN1Res x
forall x. ASN1Res x
UnexpectedEOF
                                  }


asn1decodeIsSingleton :: ASN1Decode x -> Maybe Tag
asn1decodeIsSingleton :: ASN1Decode x -> Maybe Tag
asn1decodeIsSingleton (ASN1Decode {..})
  | Bool
asn1dAny                     = Maybe Tag
forall a. Maybe a
Nothing
  | [t1 :: Tag
t1] <- Set Tag -> [Tag]
forall a. Set a -> [a]
Set.toList Set Tag
asn1dTags = Tag -> Maybe Tag
forall a. a -> Maybe a
Just Tag
t1
  | Bool
otherwise                    = Maybe Tag
forall a. Maybe a
Nothing

with'OPTIONAL :: ASN1Decode x -> ASN1Decode (Maybe x)
with'OPTIONAL :: ASN1Decode x -> ASN1Decode (Maybe x)
with'OPTIONAL x :: ASN1Decode x
x = ASN1Decode x
x { asn1dAny :: Bool
asn1dAny = Bool
True
                    , asn1dContent :: Maybe TL -> Get (ASN1Res (Maybe x))
asn1dContent = \case
                        Nothing -> ASN1Res (Maybe x) -> Get (ASN1Res (Maybe x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ASN1Res (Maybe x) -> Get (ASN1Res (Maybe x)))
-> ASN1Res (Maybe x) -> Get (ASN1Res (Maybe x))
forall a b. (a -> b) -> a -> b
$ Maybe TL -> Maybe x -> ASN1Res (Maybe x)
forall x. Maybe TL -> x -> ASN1Res x
Consumed Maybe TL
forall a. Maybe a
Nothing Maybe x
forall a. Maybe a
Nothing
                        Just tl :: TL
tl -> ASN1Res x -> ASN1Res (Maybe x)
forall a. ASN1Res a -> ASN1Res (Maybe a)
g (ASN1Res x -> ASN1Res (Maybe x))
-> Get (ASN1Res x) -> Get (ASN1Res (Maybe x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
x (TL -> Maybe TL
forall a. a -> Maybe a
Just TL
tl)
                    }
  where
    g :: ASN1Res a -> ASN1Res (Maybe a)
g (Consumed mleftover :: Maybe TL
mleftover v :: a
v) = Maybe TL -> Maybe a -> ASN1Res (Maybe a)
forall x. Maybe TL -> x -> ASN1Res x
Consumed Maybe TL
mleftover (a -> Maybe a
forall a. a -> Maybe a
Just a
v)
    g (Unexpected leftover :: TL
leftover)  = Maybe TL -> Maybe a -> ASN1Res (Maybe a)
forall x. Maybe TL -> x -> ASN1Res x
Consumed (TL -> Maybe TL
forall a. a -> Maybe a
Just TL
leftover) Maybe a
forall a. Maybe a
Nothing
    g UnexpectedEOF          = Maybe TL -> Maybe a -> ASN1Res (Maybe a)
forall x. Maybe TL -> x -> ASN1Res x
Consumed Maybe TL
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing

-- | Left-biased "CHOICE" join (TODO: verify specific-match-first semantics are sane in presence of ANYs)
instance Semigroup (ASN1Decode x) where
  x :: ASN1Decode x
x <> :: ASN1Decode x -> ASN1Decode x -> ASN1Decode x
<> y :: ASN1Decode x
y
    | ASN1Decode x -> Bool
forall x. ASN1Decode x -> Bool
asn1decodeIsEmpty ASN1Decode x
x = ASN1Decode x
y
    | ASN1Decode x -> Bool
forall x. ASN1Decode x -> Bool
asn1decodeIsEmpty ASN1Decode x
y = ASN1Decode x
x
    | Bool
otherwise = $WASN1Decode :: forall x.
Set Tag -> Bool -> (Maybe TL -> Get (ASN1Res x)) -> ASN1Decode x
ASN1Decode
                  { asn1dTags :: Set Tag
asn1dTags = ASN1Decode x -> Set Tag
forall x. ASN1Decode x -> Set Tag
asn1dTags ASN1Decode x
x Set Tag -> Set Tag -> Set Tag
forall a. Semigroup a => a -> a -> a
<> ASN1Decode x -> Set Tag
forall x. ASN1Decode x -> Set Tag
asn1dTags ASN1Decode x
y
                  , asn1dAny :: Bool
asn1dAny  = ASN1Decode x -> Bool
forall x. ASN1Decode x -> Bool
asn1dAny ASN1Decode x
x Bool -> Bool -> Bool
|| ASN1Decode x -> Bool
forall x. ASN1Decode x -> Bool
asn1dAny ASN1Decode x
y
                  , asn1dContent :: Maybe TL -> Get (ASN1Res x)
asn1dContent = \case
                          tl :: Maybe TL
tl@(Just (t :: Tag
t,_,_)) -> case () of
                            _ | Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
t (ASN1Decode x -> Set Tag
forall x. ASN1Decode x -> Set Tag
asn1dTags ASN1Decode x
x) -> ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
x Maybe TL
tl
                              | Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
t (ASN1Decode x -> Set Tag
forall x. ASN1Decode x -> Set Tag
asn1dTags ASN1Decode x
y) -> ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
y Maybe TL
tl
                              | ASN1Decode x -> Bool
forall x. ASN1Decode x -> Bool
asn1dAny ASN1Decode x
x -> ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
x Maybe TL
tl
                              | ASN1Decode x -> Bool
forall x. ASN1Decode x -> Bool
asn1dAny ASN1Decode x
y -> ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
y Maybe TL
tl
                              | Bool
otherwise  -> String -> Get (ASN1Res x)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "asn1dContent called with unsupported Tag" -- internal error
                          Nothing -> case () of
                            _ | ASN1Decode x -> Bool
forall x. ASN1Decode x -> Bool
asn1dAny ASN1Decode x
x -> ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
x Maybe TL
forall a. Maybe a
Nothing
                              | ASN1Decode x -> Bool
forall x. ASN1Decode x -> Bool
asn1dAny ASN1Decode x
y -> ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
y Maybe TL
forall a. Maybe a
Nothing
                              | Bool
otherwise  -> ASN1Res x -> Get (ASN1Res x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ASN1Res x
forall x. ASN1Res x
UnexpectedEOF
                  }

-- | Test whether 'mempty'
asn1decodeIsEmpty :: ASN1Decode x -> Bool
asn1decodeIsEmpty :: ASN1Decode x -> Bool
asn1decodeIsEmpty ASN1Decode{..} = Bool -> Bool
not Bool
asn1dAny Bool -> Bool -> Bool
&& Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
asn1dTags

instance Monoid (ASN1Decode x) where
  mempty :: ASN1Decode x
mempty = Set Tag -> Bool -> (Maybe TL -> Get (ASN1Res x)) -> ASN1Decode x
forall x.
Set Tag -> Bool -> (Maybe TL -> Get (ASN1Res x)) -> ASN1Decode x
ASN1Decode Set Tag
forall a. Monoid a => a
mempty Bool
False (ASN1Res x -> Get (ASN1Res x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ASN1Res x -> Get (ASN1Res x))
-> (Maybe TL -> ASN1Res x) -> Maybe TL -> Get (ASN1Res x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Res x -> (TL -> ASN1Res x) -> Maybe TL -> ASN1Res x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ASN1Res x
forall x. ASN1Res x
UnexpectedEOF TL -> ASN1Res x
forall x. TL -> ASN1Res x
Unexpected)
  mappend :: ASN1Decode x -> ASN1Decode x -> ASN1Decode x
mappend = ASN1Decode x -> ASN1Decode x -> ASN1Decode x
forall a. Semigroup a => a -> a -> a
(<>)
  -- TODO: optimized mconcat

instance Functor ASN1Decode where
  fmap :: (a -> b) -> ASN1Decode a -> ASN1Decode b
fmap f :: a -> b
f dec :: ASN1Decode a
dec = ASN1Decode a
dec { asn1dContent :: Maybe TL -> Get (ASN1Res b)
asn1dContent = \tl :: Maybe TL
tl -> (a -> b) -> ASN1Res a -> ASN1Res b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ASN1Res a -> ASN1Res b) -> Get (ASN1Res a) -> Get (ASN1Res b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode a -> Maybe TL -> Get (ASN1Res a)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode a
dec Maybe TL
tl }

instance Applicative ASN1Decode where
  pure :: a -> ASN1Decode a
pure x :: a
x = ASN1Decode Any
forall a. Monoid a => a
mempty { asn1dAny :: Bool
asn1dAny = Bool
True
                  , asn1dContent :: Maybe TL -> Get (ASN1Res a)
asn1dContent = \tl :: Maybe TL
tl -> ASN1Res a -> Get (ASN1Res a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TL -> a -> ASN1Res a
forall x. Maybe TL -> x -> ASN1Res x
Consumed Maybe TL
tl a
x)
                  }
  <*> :: ASN1Decode (a -> b) -> ASN1Decode a -> ASN1Decode b
(<*>) = ASN1Decode (a -> b) -> ASN1Decode a -> ASN1Decode b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad ASN1Decode where
  return :: a -> ASN1Decode a
return = a -> ASN1Decode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure -- redundant for base >= 4.8

  mx :: ASN1Decode a
mx >>= :: ASN1Decode a -> (a -> ASN1Decode b) -> ASN1Decode b
>>= k :: a -> ASN1Decode b
k = $WASN1Decode :: forall x.
Set Tag -> Bool -> (Maybe TL -> Get (ASN1Res x)) -> ASN1Decode x
ASN1Decode { asn1dAny :: Bool
asn1dAny = ASN1Decode a -> Bool
forall x. ASN1Decode x -> Bool
asn1dAny ASN1Decode a
mx
                        , asn1dTags :: Set Tag
asn1dTags = ASN1Decode a -> Set Tag
forall x. ASN1Decode x -> Set Tag
asn1dTags ASN1Decode a
mx
                        , asn1dContent :: Maybe TL -> Get (ASN1Res b)
asn1dContent = \mtl :: Maybe TL
mtl -> do
                            ASN1Res a
x0 <- ASN1Decode a -> Maybe TL -> Get (ASN1Res a)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode ASN1Decode a
mx Maybe TL
mtl
                            case ASN1Res a
x0 of
                              Consumed (Just tl' :: TL
tl') x :: a
x -> do
                                ASN1Decode b -> Maybe TL -> Get (ASN1Res b)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode (a -> ASN1Decode b
k a
x) (TL -> Maybe TL
forall a. a -> Maybe a
Just TL
tl')
                              Consumed Nothing x :: a
x -> do
                                Maybe TL
mtl' <- EncodingRule -> Get (Maybe TL)
getTagLength EncodingRule
BER
                                ASN1Decode b -> Maybe TL -> Get (ASN1Res b)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode (a -> ASN1Decode b
k a
x) Maybe TL
mtl'
                              Unexpected (t :: Tag
t,_,_) ->
                                String -> Get (ASN1Res b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("ASN1Decode: Unexpected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tag -> String
forall a. Show a => a -> String
show Tag
t)
                              UnexpectedEOF ->
                                String -> Get (ASN1Res b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("ASN1Decode: UnexpectedEOF")
                        }

-- instance MonadFail ASN1Decode where
--   fail = asn1fail

asn1fail :: String -> ASN1Decode a
asn1fail :: String -> ASN1Decode a
asn1fail s :: String
s = ASN1Decode Any
forall a. Monoid a => a
mempty { asn1dAny :: Bool
asn1dAny = Bool
True
                    , asn1dContent :: Maybe TL -> Get (ASN1Res a)
asn1dContent = \_ -> String -> Get (ASN1Res a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s
                    }

toBinaryGet :: ASN1Decode x -> Get x
toBinaryGet :: ASN1Decode x -> Get x
toBinaryGet dec :: ASN1Decode x
dec
  = EncodingRule -> Get (Maybe TL)
getTagLength EncodingRule
BER Get (Maybe TL) -> (Maybe TL -> Get (ASN1Res x)) -> Get (ASN1Res x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode ASN1Decode x
dec Get (ASN1Res x) -> (ASN1Res x -> Get x) -> Get x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Unexpected tl :: TL
tl -> String -> Get x
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("ASN1Decode: unexpected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TL -> String
forall a. Show a => a -> String
show TL
tl)
      UnexpectedEOF -> String -> Get x
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "ASN1Decode: premature end of stream"
      Consumed (Just tl :: TL
tl) _ -> String -> Get x
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("ASN1Decode: leftover " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TL -> String
forall a. Show a => a -> String
show TL
tl)
      Consumed Nothing x :: x
x -> x -> Get x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x

getASN1Decode :: ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode :: ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode (ASN1Decode{..}) Nothing
  | Bool
asn1dAny  = Maybe TL -> Get (ASN1Res x)
asn1dContent Maybe TL
forall a. Maybe a
Nothing
  | Bool
otherwise = ASN1Res x -> Get (ASN1Res x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ASN1Res x
forall x. ASN1Res x
UnexpectedEOF
getASN1Decode (ASN1Decode{..}) (Just tl :: TL
tl@(t :: Tag
t,_,_))
  | Bool
asn1dAny Bool -> Bool -> Bool
|| Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
t Set Tag
asn1dTags  = Maybe TL -> Get (ASN1Res x)
asn1dContent (TL -> Maybe TL
forall a. a -> Maybe a
Just TL
tl)
  | Bool
otherwise                           = ASN1Res x -> Get (ASN1Res x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TL -> ASN1Res x
forall x. TL -> ASN1Res x
Unexpected TL
tl)

----------------------------------------------------------------------------
-- simple ASN.1 EDSL

-- bind-like transform
transformVia :: ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
transformVia :: ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
transformVia old :: ASN1Decode x
old f :: x -> Either String y
f
  = ASN1Decode x
old { asn1dContent :: Maybe TL -> Get (ASN1Res y)
asn1dContent = \mtl :: Maybe TL
mtl -> do
            ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
old Maybe TL
mtl Get (ASN1Res x)
-> (ASN1Res x -> Get (ASN1Res y)) -> Get (ASN1Res y)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Consumed lo :: Maybe TL
lo x :: x
x -> case x -> Either String y
f x
x of
                                 Left e :: String
e  -> String -> Get (ASN1Res y)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
                                 Right y :: y
y -> ASN1Res y -> Get (ASN1Res y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TL -> y -> ASN1Res y
forall x. Maybe TL -> x -> ASN1Res x
Consumed Maybe TL
lo y
y)
              Unexpected u :: TL
u  -> ASN1Res y -> Get (ASN1Res y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TL -> ASN1Res y
forall x. TL -> ASN1Res x
Unexpected TL
u)
              UnexpectedEOF -> ASN1Res y -> Get (ASN1Res y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ASN1Res y
forall x. ASN1Res x
UnexpectedEOF
        }

explicit :: Tag -> ASN1Decode x -> ASN1Decode x
explicit :: Tag -> ASN1Decode x -> ASN1Decode x
explicit t :: Tag
t body :: ASN1Decode x
body = String -> Tag -> ASN1Decode x -> ASN1Decode x
forall x. String -> Tag -> ASN1Decode x -> ASN1Decode x
with'Constructed (Tag -> String
forall a. Show a => a -> String
show Tag
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ " EXPLICIT") Tag
t ASN1Decode x
body

implicit :: Tag -> ASN1Decode x -> ASN1Decode x
implicit :: Tag -> ASN1Decode x -> ASN1Decode x
implicit newtag :: Tag
newtag old :: ASN1Decode x
old
  | Just oldtag :: Tag
oldtag <- ASN1Decode x -> Maybe Tag
forall x. ASN1Decode x -> Maybe Tag
asn1decodeIsSingleton ASN1Decode x
old
  = ASN1Decode Any
forall a. Monoid a => a
mempty { asn1dTags :: Set Tag
asn1dTags    = Tag -> Set Tag
forall a. a -> Set a
Set.singleton Tag
newtag
           , asn1dContent :: Maybe TL -> Get (ASN1Res x)
asn1dContent = \case
               Just tl :: TL
tl@(curtag :: Tag
curtag,_,_) | Tag
newtag Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
/= Tag
curtag -> ASN1Res x -> Get (ASN1Res x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TL -> ASN1Res x
forall x. TL -> ASN1Res x
Unexpected TL
tl)
               Just (_,pc :: TagPC
pc,sz :: Maybe Word64
sz) -> ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
old (TL -> Maybe TL
forall a. a -> Maybe a
Just (Tag
oldtag,TagPC
pc,Maybe Word64
sz))
               Nothing        -> ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
asn1dContent ASN1Decode x
old Maybe TL
forall a. Maybe a
Nothing
           }
  | Bool
otherwise = String -> ASN1Decode x
forall a. HasCallStack => String -> a
error "implicit applied to non-singleton ASN1Decode"

with'CHOICE :: [ASN1Decode x] -> ASN1Decode x
with'CHOICE :: [ASN1Decode x] -> ASN1Decode x
with'CHOICE = [ASN1Decode x] -> ASN1Decode x
forall a. Monoid a => [a] -> a
mconcat

with'Constructed :: forall x . String -> Tag -> ASN1Decode x -> ASN1Decode x
with'Constructed :: String -> Tag -> ASN1Decode x -> ASN1Decode x
with'Constructed l :: String
l tag :: Tag
tag body :: ASN1Decode x
body = Tag -> (TL -> Get (ASN1Res x)) -> ASN1Decode x
forall x. Tag -> (TL -> Get (ASN1Res x)) -> ASN1Decode x
asn1DecodeSingleton' Tag
tag TL -> Get (ASN1Res x)
go
  where
    go :: TL -> Get (ASN1Res x)
    go :: TL -> Get (ASN1Res x)
go (_,Primitive,_) = String -> Get (ASN1Res x)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ " with primitive encoding")
    go (_,Constructed,Nothing) = String -> Get (ASN1Res x)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ " with indef length not supported yet")
    go (_,Constructed,Just sz :: Word64
sz) = Word64 -> Get (ASN1Res x) -> Get (ASN1Res x)
forall a. Word64 -> Get a -> Get a
isolate64 Word64
sz (Get (ASN1Res x) -> Get (ASN1Res x))
-> Get (ASN1Res x) -> Get (ASN1Res x)
forall a b. (a -> b) -> a -> b
$ do
          Maybe TL
tl' <- EncodingRule -> Get (Maybe TL)
getTagLength EncodingRule
BER
          ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode ASN1Decode x
body Maybe TL
tl'

with'SEQUENCE :: forall x . ASN1Decode x -> ASN1Decode x
with'SEQUENCE :: ASN1Decode x -> ASN1Decode x
with'SEQUENCE = String -> Tag -> ASN1Decode x -> ASN1Decode x
forall x. String -> Tag -> ASN1Decode x -> ASN1Decode x
with'Constructed "SEQUENCE" (Word64 -> Tag
Universal 16)

with'SEQUENCE_OF :: forall x . ASN1Decode x -> ASN1Decode [x]
with'SEQUENCE_OF :: ASN1Decode x -> ASN1Decode [x]
with'SEQUENCE_OF body :: ASN1Decode x
body = Tag -> (TL -> Get (ASN1Res [x])) -> ASN1Decode [x]
forall x. Tag -> (TL -> Get (ASN1Res x)) -> ASN1Decode x
asn1DecodeSingleton' (Word64 -> Tag
Universal 16) TL -> Get (ASN1Res [x])
go
  where
    go :: TL -> Get (ASN1Res [x])
    go :: TL -> Get (ASN1Res [x])
go (_,Primitive,_)         = String -> Get (ASN1Res [x])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "SEQUENCE OF with primitive encoding"
    go (_,Constructed,Nothing) = String -> Get (ASN1Res [x])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "indef SEQUENCE OF not implemented yet"
    go (_,Constructed,Just sz :: Word64
sz) = Word64 -> Get (ASN1Res [x]) -> Get (ASN1Res [x])
forall a. Word64 -> Get a -> Get a
isolate64 Word64
sz (Get (ASN1Res [x]) -> Get (ASN1Res [x]))
-> Get (ASN1Res [x]) -> Get (ASN1Res [x])
forall a b. (a -> b) -> a -> b
$ do
          -- NB: Get Monad
          let loop :: [x] -> Maybe TL -> Get [x]
              loop :: [x] -> Maybe TL -> Get [x]
loop acc :: [x]
acc tl0 :: Maybe TL
tl0 = do
                Maybe TL
tl' <- case Maybe TL
tl0 of
                         Just _  -> Maybe TL -> Get (Maybe TL)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TL
tl0
                         Nothing -> EncodingRule -> Get (Maybe TL)
getTagLength EncodingRule
BER
                case Maybe TL
tl' of
                  Nothing -> [x] -> Get [x]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([x] -> [x]
forall a. [a] -> [a]
reverse [x]
acc)
                  Just _  -> do
                    ASN1Res x
tmp <- ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode ASN1Decode x
body Maybe TL
tl'
                    case ASN1Res x
tmp of
                      Consumed tl'' :: Maybe TL
tl'' v :: x
v -> [x] -> Maybe TL -> Get [x]
loop (x
vx -> [x] -> [x]
forall a. a -> [a] -> [a]
:[x]
acc) Maybe TL
tl''
                      UnexpectedEOF   -> String -> Get [x]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "with'SEQUENCE_OF: unexpected EOF"
                      Unexpected t :: TL
t    -> String -> Get [x]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("with'SEQUENCE_OF: unexpected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TL -> String
forall a. Show a => a -> String
show TL
t)

          Maybe TL -> [x] -> ASN1Res [x]
forall x. Maybe TL -> x -> ASN1Res x
Consumed Maybe TL
forall a. Maybe a
Nothing ([x] -> ASN1Res [x]) -> Get [x] -> Get (ASN1Res [x])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [x] -> Maybe TL -> Get [x]
loop [] Maybe TL
forall a. Maybe a
Nothing


with'SET_OF :: forall x . ASN1Decode x -> ASN1Decode [x]
with'SET_OF :: ASN1Decode x -> ASN1Decode [x]
with'SET_OF body :: ASN1Decode x
body = Tag -> (TL -> Get (ASN1Res [x])) -> ASN1Decode [x]
forall x. Tag -> (TL -> Get (ASN1Res x)) -> ASN1Decode x
asn1DecodeSingleton' (Word64 -> Tag
Universal 17) TL -> Get (ASN1Res [x])
go
  where
    go :: TL -> Get (ASN1Res [x])
    go :: TL -> Get (ASN1Res [x])
go (_,Primitive,_)         = String -> Get (ASN1Res [x])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "SET OF with primitive encoding"
    go (_,Constructed,Nothing) = String -> Get (ASN1Res [x])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "indef SET OF not implemented yet"
    go (_,Constructed,Just sz :: Word64
sz) = Word64 -> Get (ASN1Res [x]) -> Get (ASN1Res [x])
forall a. Word64 -> Get a -> Get a
isolate64 Word64
sz (Get (ASN1Res [x]) -> Get (ASN1Res [x]))
-> Get (ASN1Res [x]) -> Get (ASN1Res [x])
forall a b. (a -> b) -> a -> b
$ do
          -- NB: Get Monad
          let loop :: [x] -> Maybe TL -> Get [x]
              loop :: [x] -> Maybe TL -> Get [x]
loop acc :: [x]
acc tl0 :: Maybe TL
tl0 = do
                Maybe TL
tl' <- case Maybe TL
tl0 of
                         Just _  -> Maybe TL -> Get (Maybe TL)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TL
tl0
                         Nothing -> EncodingRule -> Get (Maybe TL)
getTagLength EncodingRule
BER
                case Maybe TL
tl' of
                  Nothing -> [x] -> Get [x]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([x] -> [x]
forall a. [a] -> [a]
reverse [x]
acc)
                  Just _  -> do
                    ASN1Res x
tmp <- ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
forall x. ASN1Decode x -> Maybe TL -> Get (ASN1Res x)
getASN1Decode ASN1Decode x
body Maybe TL
tl'
                    case ASN1Res x
tmp of
                      Consumed tl'' :: Maybe TL
tl'' v :: x
v -> [x] -> Maybe TL -> Get [x]
loop (x
vx -> [x] -> [x]
forall a. a -> [a] -> [a]
:[x]
acc) Maybe TL
tl''
                      UnexpectedEOF   -> String -> Get [x]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "with'SET_OF: unexpected EOF"
                      Unexpected t :: TL
t    -> String -> Get [x]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("with'SET_OF: unexpected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TL -> String
forall a. Show a => a -> String
show TL
t)

          Maybe TL -> [x] -> ASN1Res [x]
forall x. Maybe TL -> x -> ASN1Res x
Consumed Maybe TL
forall a. Maybe a
Nothing ([x] -> ASN1Res [x]) -> Get [x] -> Get (ASN1Res [x])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [x] -> Maybe TL -> Get [x]
loop [] Maybe TL
forall a. Maybe a
Nothing



dec'BOOLEAN :: ASN1Decode Bool
dec'BOOLEAN :: ASN1Decode Bool
dec'BOOLEAN = Tag -> (TL -> Get Bool) -> ASN1Decode Bool
forall x. Tag -> (TL -> Get x) -> ASN1Decode x
asn1DecodeSingleton (Word64 -> Tag
Universal 1) ((TL -> Get Bool) -> ASN1Decode Bool)
-> (TL -> Get Bool) -> ASN1Decode Bool
forall a b. (a -> b) -> a -> b
$ (Word64 -> Get Bool) -> TL -> Get Bool
forall x. (Word64 -> Get x) -> TL -> Get x
asPrimitive Word64 -> Get Bool
forall a. (Eq a, Num a) => a -> Get Bool
go
  where
    go :: a -> Get Bool
go 1 = do
      Word8
x <- Get Word8
getWord8
      case Word8
x of
        0x00 -> Bool -> Get Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        0xff -> Bool -> Get Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        _    -> String -> Get Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "BOOLEAN must be encoded as either 0x00 or 0xFF" -- enforce DER/DER rules here
    go _ = String -> Get Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "BOOLEAN with content-length not equal 1"

enc'BOOLEAN :: Bool -> ASN1Encode Word64
enc'BOOLEAN :: Bool -> ASN1Encode Word64
enc'BOOLEAN v :: Bool
v = (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a. (Maybe Tag -> PutM a) -> ASN1Encode a
ASN1Encode ((Maybe Tag -> PutM Word64) -> ASN1Encode Word64)
-> (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a b. (a -> b) -> a -> b
$ \mt :: Maybe Tag
mt -> do
  Word64
_ <- TL -> PutM Word64
putTagLength (Word64 -> Tag
Universal 1 Tag -> Maybe Tag -> Tag
forall a. a -> Maybe a -> a
`fromMaybe` Maybe Tag
mt, TagPC
Primitive, Word64 -> Maybe Word64
forall a. a -> Maybe a
Just 1)
  Word8 -> Put
putWord8 (if Bool
v then 0xff else 0x00)
  Word64 -> PutM Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure 3

{- TODO
getPrim'Boolean :: EncodingRule -> Word64 -> Get Bool
getPrim'Boolean r sz
  | sz /= 1 = fail "boolean content shall be a single octet"
  | otherwise = do
      x <- getWord8
      case (r,x) of
        (_,0x00)   -> pure False
        (BER,_)    -> pure True
        (CER,0xff) -> pure True
        (CER,_)    -> fail "all bits shall be set in boolean TRUE encoding for CER"
        (DER,0xff) -> pure True
        (DER,_)    -> fail "all bits shall be set in boolean TRUE encoding for DER"
-}

dec'INTEGER :: ASN1Decode Integer
dec'INTEGER :: ASN1Decode Integer
dec'INTEGER = Tag -> (TL -> Get Integer) -> ASN1Decode Integer
forall x. Tag -> (TL -> Get x) -> ASN1Decode x
asn1DecodeSingleton (Word64 -> Tag
Universal 2) ((TL -> Get Integer) -> ASN1Decode Integer)
-> (TL -> Get Integer) -> ASN1Decode Integer
forall a b. (a -> b) -> a -> b
$ (Word64 -> Get Integer) -> TL -> Get Integer
forall x. (Word64 -> Get x) -> TL -> Get x
asPrimitive Word64 -> Get Integer
getVarInteger

enc'INTEGER :: Integer -> ASN1Encode Word64
enc'INTEGER :: Integer -> ASN1Encode Word64
enc'INTEGER i :: Integer
i = Tag -> TagPC -> PutM Word64 -> ASN1Encode Word64
wrap'DEFINITE (Word64 -> Tag
Universal 2) TagPC
Primitive (Integer -> PutM Word64
putVarInteger Integer
i)

dec'UInt :: forall lb ub t . (UIntBounds lb ub t, Num t) => ASN1Decode (UInt lb ub t)
dec'UInt :: ASN1Decode (UInt lb ub t)
dec'UInt = do
  Integer
i <- ASN1Decode Integer
dec'INTEGER -- TODO: size-hint
  case Integer -> Either ArithException (UInt lb ub t)
forall (lb :: Nat) (ub :: Nat) t.
(UIntBounds lb ub t, Num t) =>
Integer -> Either ArithException (UInt lb ub t)
uintFromInteger (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
i) of
    Left Underflow -> String -> ASN1Decode (UInt lb ub t)
forall a. String -> ASN1Decode a
asn1fail "INTEGER below lower bound"
    Left Overflow  -> String -> ASN1Decode (UInt lb ub t)
forall a. String -> ASN1Decode a
asn1fail "INTEGER above upper bound"
    Left _         -> String -> ASN1Decode (UInt lb ub t)
forall a. String -> ASN1Decode a
asn1fail "INTEGER"
    Right v :: UInt lb ub t
v        -> UInt lb ub t -> ASN1Decode (UInt lb ub t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure UInt lb ub t
v

enc'UInt :: forall lb ub t . (UIntBounds lb ub t, Num t, Integral t) => UInt lb ub t -> ASN1Encode Word64
enc'UInt :: UInt lb ub t -> ASN1Encode Word64
enc'UInt = Integer -> ASN1Encode Word64
enc'INTEGER (Integer -> ASN1Encode Word64)
-> (UInt lb ub t -> Integer) -> UInt lb ub t -> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Integer
forall a. Integral a => a -> Integer
toInteger (t -> Integer) -> (UInt lb ub t -> t) -> UInt lb ub t -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt lb ub t -> t
forall (lb :: Nat) (ub :: Nat) t. UInt lb ub t -> t
fromUInt

dec'Int64 :: ASN1Decode Int64
dec'Int64 :: ASN1Decode Int64
dec'Int64 = Tag -> (TL -> Get Int64) -> ASN1Decode Int64
forall x. Tag -> (TL -> Get x) -> ASN1Decode x
asn1DecodeSingleton (Word64 -> Tag
Universal 2) ((TL -> Get Int64) -> ASN1Decode Int64)
-> (TL -> Get Int64) -> ASN1Decode Int64
forall a b. (a -> b) -> a -> b
$ (Word64 -> Get Int64) -> TL -> Get Int64
forall x. (Word64 -> Get x) -> TL -> Get x
asPrimitive Word64 -> Get Int64
getVarInt64

enc'Int64 :: Int64 -> ASN1Encode Word64
enc'Int64 :: Int64 -> ASN1Encode Word64
enc'Int64 i :: Int64
i = Tag -> TagPC -> PutM Word64 -> ASN1Encode Word64
wrap'DEFINITE (Word64 -> Tag
Universal 2) TagPC
Primitive (Int64 -> PutM Word64
putVarInt64 Int64
i)

dec'ENUMERATED :: Enumerated enum => ASN1Decode enum
dec'ENUMERATED :: ASN1Decode enum
dec'ENUMERATED = Tag -> (TL -> Get enum) -> ASN1Decode enum
forall x. Tag -> (TL -> Get x) -> ASN1Decode x
asn1DecodeSingleton (Word64 -> Tag
Universal 10) ((TL -> Get enum) -> ASN1Decode enum)
-> (TL -> Get enum) -> ASN1Decode enum
forall a b. (a -> b) -> a -> b
$ (Word64 -> Get enum) -> TL -> Get enum
forall x. (Word64 -> Get x) -> TL -> Get x
asPrimitive ((Word64 -> Get enum) -> TL -> Get enum)
-> (Word64 -> Get enum) -> TL -> Get enum
forall a b. (a -> b) -> a -> b
$ \sz :: Word64
sz -> do
    Int64
i <- Word64 -> Get Int64
go Word64
sz
    Get enum -> (enum -> Get enum) -> Maybe enum -> Get enum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get enum
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid ENUMERATED value") enum -> Get enum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Maybe enum
forall x. Enumerated x => Int64 -> Maybe x
toEnumerated Int64
i)
  where
    go :: Word64 -> Get Int64
go 0 = String -> Get Int64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "ENUMERATED with empty content"
    go sz :: Word64
sz
      | Word64
sz Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 8   = Word64 -> Get Int64
getVarInt64 Word64
sz
      | Bool
otherwise = String -> Get Int64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid ENUMERATED value"

enc'ENUMERATED :: Enumerated enum => enum -> ASN1Encode Word64
enc'ENUMERATED :: enum -> ASN1Encode Word64
enc'ENUMERATED = Tag -> ASN1Encode Word64 -> ASN1Encode Word64
forall a. Tag -> ASN1Encode a -> ASN1Encode a
retag (Word64 -> Tag
Universal 10) (ASN1Encode Word64 -> ASN1Encode Word64)
-> (enum -> ASN1Encode Word64) -> enum -> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ASN1Encode Word64
enc'Int64 (Int64 -> ASN1Encode Word64)
-> (enum -> Int64) -> enum -> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. enum -> Int64
forall x. Enumerated x => x -> Int64
fromEnumerated

-- | Only for non-sparse 'Enum's
dec'BoundedEnum :: forall enum . (Bounded enum, Enum enum) => ASN1Decode enum
dec'BoundedEnum :: ASN1Decode enum
dec'BoundedEnum = do
    Int
i <- ASN1Decode Int
forall enum. Enumerated enum => ASN1Decode enum
dec'ENUMERATED
    Bool -> ASN1Decode () -> ASN1Decode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> (Int, Int) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` (Int
lb,Int
ub)) (ASN1Decode () -> ASN1Decode ()) -> ASN1Decode () -> ASN1Decode ()
forall a b. (a -> b) -> a -> b
$ String -> ASN1Decode ()
forall a. String -> ASN1Decode a
asn1fail "invalid ENUMERATED value"
    enum -> ASN1Decode enum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> enum
forall a. Enum a => Int -> a
toEnum Int
i)
  where
    lb :: Int
lb = enum -> Int
forall a. Enum a => a -> Int
fromEnum (enum
forall a. Bounded a => a
minBound :: enum)
    ub :: Int
ub = enum -> Int
forall a. Enum a => a -> Int
fromEnum (enum
forall a. Bounded a => a
maxBound :: enum)

enc'BoundedEnum :: Enum enum => enum -> ASN1Encode Word64
enc'BoundedEnum :: enum -> ASN1Encode Word64
enc'BoundedEnum v :: enum
v = Int64 -> ASN1Encode Word64
forall enum. Enumerated enum => enum -> ASN1Encode Word64
enc'ENUMERATED (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (enum -> Int
forall a. Enum a => a -> Int
fromEnum enum
v) :: Int64)

dec'NULL :: ASN1Decode ()
dec'NULL :: ASN1Decode ()
dec'NULL = Tag -> (TL -> Get ()) -> ASN1Decode ()
forall x. Tag -> (TL -> Get x) -> ASN1Decode x
asn1DecodeSingleton (Word64 -> Tag
Universal 5) ((TL -> Get ()) -> ASN1Decode ())
-> (TL -> Get ()) -> ASN1Decode ()
forall a b. (a -> b) -> a -> b
$ (Word64 -> Get ()) -> TL -> Get ()
forall x. (Word64 -> Get x) -> TL -> Get x
asPrimitive Word64 -> Get ()
forall a (f :: * -> *). (Eq a, Num a, MonadFail f) => a -> f ()
go
  where
    go :: a -> f ()
go 0 = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    go _ = String -> f ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "NULL with content-length not equal 0"

enc'NULL :: ASN1Encode Word64
enc'NULL :: ASN1Encode Word64
enc'NULL = (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a. (Maybe Tag -> PutM a) -> ASN1Encode a
ASN1Encode ((Maybe Tag -> PutM Word64) -> ASN1Encode Word64)
-> (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a b. (a -> b) -> a -> b
$ \mt :: Maybe Tag
mt -> TL -> PutM Word64
putTagLength (Word64 -> Tag
Universal 5 Tag -> Maybe Tag -> Tag
forall a. a -> Maybe a -> a
`fromMaybe` Maybe Tag
mt, TagPC
Primitive, Word64 -> Maybe Word64
forall a. a -> Maybe a
Just 0)


dec'OCTETSTRING :: ASN1Decode ByteString
dec'OCTETSTRING :: ASN1Decode ByteString
dec'OCTETSTRING = Tag -> (TL -> Get ByteString) -> ASN1Decode ByteString
forall x. Tag -> (TL -> Get x) -> ASN1Decode x
asn1DecodeSingleton (Word64 -> Tag
Universal 4) ((TL -> Get ByteString) -> ASN1Decode ByteString)
-> (TL -> Get ByteString) -> ASN1Decode ByteString
forall a b. (a -> b) -> a -> b
$ (Word64 -> Get ByteString) -> TL -> Get ByteString
forall x. (Word64 -> Get x) -> TL -> Get x
asPrimitive Word64 -> Get ByteString
forall a. (Integral a, Bits a) => a -> Get ByteString
go
  where
    go :: a -> Get ByteString
go sz :: a
sz
      | Just sz' :: Int
sz' <- a -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
intCastMaybe a
sz = Int -> Get ByteString
Bin.getByteString Int
sz'
      | Bool
otherwise = String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "OCTET STRING too large for this implementation"

enc'OCTETSTRING :: ByteString -> ASN1Encode Word64
enc'OCTETSTRING :: ByteString -> ASN1Encode Word64
enc'OCTETSTRING bs :: ByteString
bs = (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a. (Maybe Tag -> PutM a) -> ASN1Encode a
ASN1Encode ((Maybe Tag -> PutM Word64) -> ASN1Encode Word64)
-> (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a b. (a -> b) -> a -> b
$ \mt :: Maybe Tag
mt -> do
  let cl :: Word64
cl = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)
  Word64
hl <- TL -> PutM Word64
putTagLength (Word64 -> Tag
Universal 4 Tag -> Maybe Tag -> Tag
forall a. a -> Maybe a -> a
`fromMaybe` Maybe Tag
mt, TagPC
Primitive, Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
cl)
  ByteString -> Put
Bin.putByteString ByteString
bs
  Word64 -> PutM Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
hl Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
cl)

wrap'DEFINITE :: Tag -> TagPC -> PutM Word64 -> ASN1Encode Word64
wrap'DEFINITE :: Tag -> TagPC -> PutM Word64 -> ASN1Encode Word64
wrap'DEFINITE t0 :: Tag
t0 pc :: TagPC
pc body :: PutM Word64
body = (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a. (Maybe Tag -> PutM a) -> ASN1Encode a
ASN1Encode ((Maybe Tag -> PutM Word64) -> ASN1Encode Word64)
-> (Maybe Tag -> PutM Word64) -> ASN1Encode Word64
forall a b. (a -> b) -> a -> b
$ \mt :: Maybe Tag
mt -> do
  let (cl :: Word64
cl, lbs :: ByteString
lbs) = PutM Word64 -> (Word64, ByteString)
forall a. PutM a -> (a, ByteString)
Bin.runPutM PutM Word64
body
  Word64
hl <- TL -> PutM Word64
putTagLength (Tag -> Maybe Tag -> Tag
forall a. a -> Maybe a -> a
fromMaybe Tag
t0 Maybe Tag
mt, TagPC
pc, Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
cl)
  ByteString -> Put
Bin.putLazyByteString ByteString
lbs
  Word64 -> PutM Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
hlWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
cl)


retag :: Tag -> ASN1Encode a -> ASN1Encode a
retag :: Tag -> ASN1Encode a -> ASN1Encode a
retag newtag :: Tag
newtag (ASN1Encode old :: Maybe Tag -> PutM a
old) = (Maybe Tag -> PutM a) -> ASN1Encode a
forall a. (Maybe Tag -> PutM a) -> ASN1Encode a
ASN1Encode (\mt :: Maybe Tag
mt -> Maybe Tag -> PutM a
old (Maybe Tag
mt Maybe Tag -> Maybe Tag -> Maybe Tag
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tag -> Maybe Tag
forall a. a -> Maybe a
Just Tag
newtag))

wraptag :: Tag -> ASN1Encode Word64 -> ASN1Encode Word64
wraptag :: Tag -> ASN1Encode Word64 -> ASN1Encode Word64
wraptag newtag :: Tag
newtag (ASN1Encode old :: Maybe Tag -> PutM Word64
old) = Tag -> TagPC -> PutM Word64 -> ASN1Encode Word64
wrap'DEFINITE Tag
newtag TagPC
Constructed (Maybe Tag -> PutM Word64
old Maybe Tag
forall a. Maybe a
Nothing)

----------------------------------------------------------------------------

-- | ASN.1 @IMPLICIT@ Annotation
newtype IMPLICIT (tag :: TagK) x = IMPLICIT x
  deriving ((forall x. IMPLICIT tag x -> Rep (IMPLICIT tag x) x)
-> (forall x. Rep (IMPLICIT tag x) x -> IMPLICIT tag x)
-> Generic (IMPLICIT tag x)
forall x. Rep (IMPLICIT tag x) x -> IMPLICIT tag x
forall x. IMPLICIT tag x -> Rep (IMPLICIT tag x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (tag :: TagK) x x. Rep (IMPLICIT tag x) x -> IMPLICIT tag x
forall (tag :: TagK) x x. IMPLICIT tag x -> Rep (IMPLICIT tag x) x
$cto :: forall (tag :: TagK) x x. Rep (IMPLICIT tag x) x -> IMPLICIT tag x
$cfrom :: forall (tag :: TagK) x x. IMPLICIT tag x -> Rep (IMPLICIT tag x) x
Generic,IMPLICIT tag x -> ()
(IMPLICIT tag x -> ()) -> NFData (IMPLICIT tag x)
forall a. (a -> ()) -> NFData a
forall (tag :: TagK) x. NFData x => IMPLICIT tag x -> ()
rnf :: IMPLICIT tag x -> ()
$crnf :: forall (tag :: TagK) x. NFData x => IMPLICIT tag x -> ()
NFData,String -> IMPLICIT tag x
(String -> IMPLICIT tag x) -> IsString (IMPLICIT tag x)
forall a. (String -> a) -> IsString a
forall (tag :: TagK) x. IsString x => String -> IMPLICIT tag x
fromString :: String -> IMPLICIT tag x
$cfromString :: forall (tag :: TagK) x. IsString x => String -> IMPLICIT tag x
IsString,Integer -> IMPLICIT tag x
IMPLICIT tag x -> IMPLICIT tag x
IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
(IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x)
-> (IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x)
-> (IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x)
-> (IMPLICIT tag x -> IMPLICIT tag x)
-> (IMPLICIT tag x -> IMPLICIT tag x)
-> (IMPLICIT tag x -> IMPLICIT tag x)
-> (Integer -> IMPLICIT tag x)
-> Num (IMPLICIT tag x)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (tag :: TagK) x. Num x => Integer -> IMPLICIT tag x
forall (tag :: TagK) x. Num x => IMPLICIT tag x -> IMPLICIT tag x
forall (tag :: TagK) x.
Num x =>
IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
fromInteger :: Integer -> IMPLICIT tag x
$cfromInteger :: forall (tag :: TagK) x. Num x => Integer -> IMPLICIT tag x
signum :: IMPLICIT tag x -> IMPLICIT tag x
$csignum :: forall (tag :: TagK) x. Num x => IMPLICIT tag x -> IMPLICIT tag x
abs :: IMPLICIT tag x -> IMPLICIT tag x
$cabs :: forall (tag :: TagK) x. Num x => IMPLICIT tag x -> IMPLICIT tag x
negate :: IMPLICIT tag x -> IMPLICIT tag x
$cnegate :: forall (tag :: TagK) x. Num x => IMPLICIT tag x -> IMPLICIT tag x
* :: IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
$c* :: forall (tag :: TagK) x.
Num x =>
IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
- :: IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
$c- :: forall (tag :: TagK) x.
Num x =>
IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
+ :: IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
$c+ :: forall (tag :: TagK) x.
Num x =>
IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
Num,Int -> IMPLICIT tag x -> ShowS
[IMPLICIT tag x] -> ShowS
IMPLICIT tag x -> String
(Int -> IMPLICIT tag x -> ShowS)
-> (IMPLICIT tag x -> String)
-> ([IMPLICIT tag x] -> ShowS)
-> Show (IMPLICIT tag x)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (tag :: TagK) x. Show x => Int -> IMPLICIT tag x -> ShowS
forall (tag :: TagK) x. Show x => [IMPLICIT tag x] -> ShowS
forall (tag :: TagK) x. Show x => IMPLICIT tag x -> String
showList :: [IMPLICIT tag x] -> ShowS
$cshowList :: forall (tag :: TagK) x. Show x => [IMPLICIT tag x] -> ShowS
show :: IMPLICIT tag x -> String
$cshow :: forall (tag :: TagK) x. Show x => IMPLICIT tag x -> String
showsPrec :: Int -> IMPLICIT tag x -> ShowS
$cshowsPrec :: forall (tag :: TagK) x. Show x => Int -> IMPLICIT tag x -> ShowS
Show,IMPLICIT tag x -> IMPLICIT tag x -> Bool
(IMPLICIT tag x -> IMPLICIT tag x -> Bool)
-> (IMPLICIT tag x -> IMPLICIT tag x -> Bool)
-> Eq (IMPLICIT tag x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (tag :: TagK) x.
Eq x =>
IMPLICIT tag x -> IMPLICIT tag x -> Bool
/= :: IMPLICIT tag x -> IMPLICIT tag x -> Bool
$c/= :: forall (tag :: TagK) x.
Eq x =>
IMPLICIT tag x -> IMPLICIT tag x -> Bool
== :: IMPLICIT tag x -> IMPLICIT tag x -> Bool
$c== :: forall (tag :: TagK) x.
Eq x =>
IMPLICIT tag x -> IMPLICIT tag x -> Bool
Eq,Eq (IMPLICIT tag x)
Eq (IMPLICIT tag x) =>
(IMPLICIT tag x -> IMPLICIT tag x -> Ordering)
-> (IMPLICIT tag x -> IMPLICIT tag x -> Bool)
-> (IMPLICIT tag x -> IMPLICIT tag x -> Bool)
-> (IMPLICIT tag x -> IMPLICIT tag x -> Bool)
-> (IMPLICIT tag x -> IMPLICIT tag x -> Bool)
-> (IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x)
-> (IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x)
-> Ord (IMPLICIT tag x)
IMPLICIT tag x -> IMPLICIT tag x -> Bool
IMPLICIT tag x -> IMPLICIT tag x -> Ordering
IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (tag :: TagK) x. Ord x => Eq (IMPLICIT tag x)
forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> Bool
forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> Ordering
forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
min :: IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
$cmin :: forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
max :: IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
$cmax :: forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> IMPLICIT tag x
>= :: IMPLICIT tag x -> IMPLICIT tag x -> Bool
$c>= :: forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> Bool
> :: IMPLICIT tag x -> IMPLICIT tag x -> Bool
$c> :: forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> Bool
<= :: IMPLICIT tag x -> IMPLICIT tag x -> Bool
$c<= :: forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> Bool
< :: IMPLICIT tag x -> IMPLICIT tag x -> Bool
$c< :: forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> Bool
compare :: IMPLICIT tag x -> IMPLICIT tag x -> Ordering
$ccompare :: forall (tag :: TagK) x.
Ord x =>
IMPLICIT tag x -> IMPLICIT tag x -> Ordering
$cp1Ord :: forall (tag :: TagK) x. Ord x => Eq (IMPLICIT tag x)
Ord,Int -> IMPLICIT tag x
IMPLICIT tag x -> Int
IMPLICIT tag x -> [IMPLICIT tag x]
IMPLICIT tag x -> IMPLICIT tag x
IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
IMPLICIT tag x
-> IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
(IMPLICIT tag x -> IMPLICIT tag x)
-> (IMPLICIT tag x -> IMPLICIT tag x)
-> (Int -> IMPLICIT tag x)
-> (IMPLICIT tag x -> Int)
-> (IMPLICIT tag x -> [IMPLICIT tag x])
-> (IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x])
-> (IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x])
-> (IMPLICIT tag x
    -> IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x])
-> Enum (IMPLICIT tag x)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall (tag :: TagK) x. Enum x => Int -> IMPLICIT tag x
forall (tag :: TagK) x. Enum x => IMPLICIT tag x -> Int
forall (tag :: TagK) x.
Enum x =>
IMPLICIT tag x -> [IMPLICIT tag x]
forall (tag :: TagK) x. Enum x => IMPLICIT tag x -> IMPLICIT tag x
forall (tag :: TagK) x.
Enum x =>
IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
forall (tag :: TagK) x.
Enum x =>
IMPLICIT tag x
-> IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
enumFromThenTo :: IMPLICIT tag x
-> IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
$cenumFromThenTo :: forall (tag :: TagK) x.
Enum x =>
IMPLICIT tag x
-> IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
enumFromTo :: IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
$cenumFromTo :: forall (tag :: TagK) x.
Enum x =>
IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
enumFromThen :: IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
$cenumFromThen :: forall (tag :: TagK) x.
Enum x =>
IMPLICIT tag x -> IMPLICIT tag x -> [IMPLICIT tag x]
enumFrom :: IMPLICIT tag x -> [IMPLICIT tag x]
$cenumFrom :: forall (tag :: TagK) x.
Enum x =>
IMPLICIT tag x -> [IMPLICIT tag x]
fromEnum :: IMPLICIT tag x -> Int
$cfromEnum :: forall (tag :: TagK) x. Enum x => IMPLICIT tag x -> Int
toEnum :: Int -> IMPLICIT tag x
$ctoEnum :: forall (tag :: TagK) x. Enum x => Int -> IMPLICIT tag x
pred :: IMPLICIT tag x -> IMPLICIT tag x
$cpred :: forall (tag :: TagK) x. Enum x => IMPLICIT tag x -> IMPLICIT tag x
succ :: IMPLICIT tag x -> IMPLICIT tag x
$csucc :: forall (tag :: TagK) x. Enum x => IMPLICIT tag x -> IMPLICIT tag x
Enum)

instance Newtype (IMPLICIT tag x) x

-- | ASN.1 @EXPLICIT@ Annotation
newtype EXPLICIT (tag :: TagK) x = EXPLICIT x
  deriving ((forall x. EXPLICIT tag x -> Rep (EXPLICIT tag x) x)
-> (forall x. Rep (EXPLICIT tag x) x -> EXPLICIT tag x)
-> Generic (EXPLICIT tag x)
forall x. Rep (EXPLICIT tag x) x -> EXPLICIT tag x
forall x. EXPLICIT tag x -> Rep (EXPLICIT tag x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (tag :: TagK) x x. Rep (EXPLICIT tag x) x -> EXPLICIT tag x
forall (tag :: TagK) x x. EXPLICIT tag x -> Rep (EXPLICIT tag x) x
$cto :: forall (tag :: TagK) x x. Rep (EXPLICIT tag x) x -> EXPLICIT tag x
$cfrom :: forall (tag :: TagK) x x. EXPLICIT tag x -> Rep (EXPLICIT tag x) x
Generic,EXPLICIT tag x -> ()
(EXPLICIT tag x -> ()) -> NFData (EXPLICIT tag x)
forall a. (a -> ()) -> NFData a
forall (tag :: TagK) x. NFData x => EXPLICIT tag x -> ()
rnf :: EXPLICIT tag x -> ()
$crnf :: forall (tag :: TagK) x. NFData x => EXPLICIT tag x -> ()
NFData,String -> EXPLICIT tag x
(String -> EXPLICIT tag x) -> IsString (EXPLICIT tag x)
forall a. (String -> a) -> IsString a
forall (tag :: TagK) x. IsString x => String -> EXPLICIT tag x
fromString :: String -> EXPLICIT tag x
$cfromString :: forall (tag :: TagK) x. IsString x => String -> EXPLICIT tag x
IsString,Integer -> EXPLICIT tag x
EXPLICIT tag x -> EXPLICIT tag x
EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
(EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x)
-> (EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x)
-> (EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x)
-> (EXPLICIT tag x -> EXPLICIT tag x)
-> (EXPLICIT tag x -> EXPLICIT tag x)
-> (EXPLICIT tag x -> EXPLICIT tag x)
-> (Integer -> EXPLICIT tag x)
-> Num (EXPLICIT tag x)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (tag :: TagK) x. Num x => Integer -> EXPLICIT tag x
forall (tag :: TagK) x. Num x => EXPLICIT tag x -> EXPLICIT tag x
forall (tag :: TagK) x.
Num x =>
EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
fromInteger :: Integer -> EXPLICIT tag x
$cfromInteger :: forall (tag :: TagK) x. Num x => Integer -> EXPLICIT tag x
signum :: EXPLICIT tag x -> EXPLICIT tag x
$csignum :: forall (tag :: TagK) x. Num x => EXPLICIT tag x -> EXPLICIT tag x
abs :: EXPLICIT tag x -> EXPLICIT tag x
$cabs :: forall (tag :: TagK) x. Num x => EXPLICIT tag x -> EXPLICIT tag x
negate :: EXPLICIT tag x -> EXPLICIT tag x
$cnegate :: forall (tag :: TagK) x. Num x => EXPLICIT tag x -> EXPLICIT tag x
* :: EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
$c* :: forall (tag :: TagK) x.
Num x =>
EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
- :: EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
$c- :: forall (tag :: TagK) x.
Num x =>
EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
+ :: EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
$c+ :: forall (tag :: TagK) x.
Num x =>
EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
Num,Int -> EXPLICIT tag x -> ShowS
[EXPLICIT tag x] -> ShowS
EXPLICIT tag x -> String
(Int -> EXPLICIT tag x -> ShowS)
-> (EXPLICIT tag x -> String)
-> ([EXPLICIT tag x] -> ShowS)
-> Show (EXPLICIT tag x)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (tag :: TagK) x. Show x => Int -> EXPLICIT tag x -> ShowS
forall (tag :: TagK) x. Show x => [EXPLICIT tag x] -> ShowS
forall (tag :: TagK) x. Show x => EXPLICIT tag x -> String
showList :: [EXPLICIT tag x] -> ShowS
$cshowList :: forall (tag :: TagK) x. Show x => [EXPLICIT tag x] -> ShowS
show :: EXPLICIT tag x -> String
$cshow :: forall (tag :: TagK) x. Show x => EXPLICIT tag x -> String
showsPrec :: Int -> EXPLICIT tag x -> ShowS
$cshowsPrec :: forall (tag :: TagK) x. Show x => Int -> EXPLICIT tag x -> ShowS
Show,EXPLICIT tag x -> EXPLICIT tag x -> Bool
(EXPLICIT tag x -> EXPLICIT tag x -> Bool)
-> (EXPLICIT tag x -> EXPLICIT tag x -> Bool)
-> Eq (EXPLICIT tag x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (tag :: TagK) x.
Eq x =>
EXPLICIT tag x -> EXPLICIT tag x -> Bool
/= :: EXPLICIT tag x -> EXPLICIT tag x -> Bool
$c/= :: forall (tag :: TagK) x.
Eq x =>
EXPLICIT tag x -> EXPLICIT tag x -> Bool
== :: EXPLICIT tag x -> EXPLICIT tag x -> Bool
$c== :: forall (tag :: TagK) x.
Eq x =>
EXPLICIT tag x -> EXPLICIT tag x -> Bool
Eq,Eq (EXPLICIT tag x)
Eq (EXPLICIT tag x) =>
(EXPLICIT tag x -> EXPLICIT tag x -> Ordering)
-> (EXPLICIT tag x -> EXPLICIT tag x -> Bool)
-> (EXPLICIT tag x -> EXPLICIT tag x -> Bool)
-> (EXPLICIT tag x -> EXPLICIT tag x -> Bool)
-> (EXPLICIT tag x -> EXPLICIT tag x -> Bool)
-> (EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x)
-> (EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x)
-> Ord (EXPLICIT tag x)
EXPLICIT tag x -> EXPLICIT tag x -> Bool
EXPLICIT tag x -> EXPLICIT tag x -> Ordering
EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (tag :: TagK) x. Ord x => Eq (EXPLICIT tag x)
forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> Bool
forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> Ordering
forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
min :: EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
$cmin :: forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
max :: EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
$cmax :: forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> EXPLICIT tag x
>= :: EXPLICIT tag x -> EXPLICIT tag x -> Bool
$c>= :: forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> Bool
> :: EXPLICIT tag x -> EXPLICIT tag x -> Bool
$c> :: forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> Bool
<= :: EXPLICIT tag x -> EXPLICIT tag x -> Bool
$c<= :: forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> Bool
< :: EXPLICIT tag x -> EXPLICIT tag x -> Bool
$c< :: forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> Bool
compare :: EXPLICIT tag x -> EXPLICIT tag x -> Ordering
$ccompare :: forall (tag :: TagK) x.
Ord x =>
EXPLICIT tag x -> EXPLICIT tag x -> Ordering
$cp1Ord :: forall (tag :: TagK) x. Ord x => Eq (EXPLICIT tag x)
Ord,Int -> EXPLICIT tag x
EXPLICIT tag x -> Int
EXPLICIT tag x -> [EXPLICIT tag x]
EXPLICIT tag x -> EXPLICIT tag x
EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
EXPLICIT tag x
-> EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
(EXPLICIT tag x -> EXPLICIT tag x)
-> (EXPLICIT tag x -> EXPLICIT tag x)
-> (Int -> EXPLICIT tag x)
-> (EXPLICIT tag x -> Int)
-> (EXPLICIT tag x -> [EXPLICIT tag x])
-> (EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x])
-> (EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x])
-> (EXPLICIT tag x
    -> EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x])
-> Enum (EXPLICIT tag x)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall (tag :: TagK) x. Enum x => Int -> EXPLICIT tag x
forall (tag :: TagK) x. Enum x => EXPLICIT tag x -> Int
forall (tag :: TagK) x.
Enum x =>
EXPLICIT tag x -> [EXPLICIT tag x]
forall (tag :: TagK) x. Enum x => EXPLICIT tag x -> EXPLICIT tag x
forall (tag :: TagK) x.
Enum x =>
EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
forall (tag :: TagK) x.
Enum x =>
EXPLICIT tag x
-> EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
enumFromThenTo :: EXPLICIT tag x
-> EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
$cenumFromThenTo :: forall (tag :: TagK) x.
Enum x =>
EXPLICIT tag x
-> EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
enumFromTo :: EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
$cenumFromTo :: forall (tag :: TagK) x.
Enum x =>
EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
enumFromThen :: EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
$cenumFromThen :: forall (tag :: TagK) x.
Enum x =>
EXPLICIT tag x -> EXPLICIT tag x -> [EXPLICIT tag x]
enumFrom :: EXPLICIT tag x -> [EXPLICIT tag x]
$cenumFrom :: forall (tag :: TagK) x.
Enum x =>
EXPLICIT tag x -> [EXPLICIT tag x]
fromEnum :: EXPLICIT tag x -> Int
$cfromEnum :: forall (tag :: TagK) x. Enum x => EXPLICIT tag x -> Int
toEnum :: Int -> EXPLICIT tag x
$ctoEnum :: forall (tag :: TagK) x. Enum x => Int -> EXPLICIT tag x
pred :: EXPLICIT tag x -> EXPLICIT tag x
$cpred :: forall (tag :: TagK) x. Enum x => EXPLICIT tag x -> EXPLICIT tag x
succ :: EXPLICIT tag x -> EXPLICIT tag x
$csucc :: forall (tag :: TagK) x. Enum x => EXPLICIT tag x -> EXPLICIT tag x
Enum)

instance Newtype (EXPLICIT tag x) x

-- | ASN.1 @ENUMERATED@ Annotation
newtype ENUMERATED x = ENUMERATED x
  deriving ((forall x. ENUMERATED x -> Rep (ENUMERATED x) x)
-> (forall x. Rep (ENUMERATED x) x -> ENUMERATED x)
-> Generic (ENUMERATED x)
forall x. Rep (ENUMERATED x) x -> ENUMERATED x
forall x. ENUMERATED x -> Rep (ENUMERATED x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (ENUMERATED x) x -> ENUMERATED x
forall x x. ENUMERATED x -> Rep (ENUMERATED x) x
$cto :: forall x x. Rep (ENUMERATED x) x -> ENUMERATED x
$cfrom :: forall x x. ENUMERATED x -> Rep (ENUMERATED x) x
Generic,ENUMERATED x -> ()
(ENUMERATED x -> ()) -> NFData (ENUMERATED x)
forall x. NFData x => ENUMERATED x -> ()
forall a. (a -> ()) -> NFData a
rnf :: ENUMERATED x -> ()
$crnf :: forall x. NFData x => ENUMERATED x -> ()
NFData,Integer -> ENUMERATED x
ENUMERATED x -> ENUMERATED x
ENUMERATED x -> ENUMERATED x -> ENUMERATED x
(ENUMERATED x -> ENUMERATED x -> ENUMERATED x)
-> (ENUMERATED x -> ENUMERATED x -> ENUMERATED x)
-> (ENUMERATED x -> ENUMERATED x -> ENUMERATED x)
-> (ENUMERATED x -> ENUMERATED x)
-> (ENUMERATED x -> ENUMERATED x)
-> (ENUMERATED x -> ENUMERATED x)
-> (Integer -> ENUMERATED x)
-> Num (ENUMERATED x)
forall x. Num x => Integer -> ENUMERATED x
forall x. Num x => ENUMERATED x -> ENUMERATED x
forall x. Num x => ENUMERATED x -> ENUMERATED x -> ENUMERATED x
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ENUMERATED x
$cfromInteger :: forall x. Num x => Integer -> ENUMERATED x
signum :: ENUMERATED x -> ENUMERATED x
$csignum :: forall x. Num x => ENUMERATED x -> ENUMERATED x
abs :: ENUMERATED x -> ENUMERATED x
$cabs :: forall x. Num x => ENUMERATED x -> ENUMERATED x
negate :: ENUMERATED x -> ENUMERATED x
$cnegate :: forall x. Num x => ENUMERATED x -> ENUMERATED x
* :: ENUMERATED x -> ENUMERATED x -> ENUMERATED x
$c* :: forall x. Num x => ENUMERATED x -> ENUMERATED x -> ENUMERATED x
- :: ENUMERATED x -> ENUMERATED x -> ENUMERATED x
$c- :: forall x. Num x => ENUMERATED x -> ENUMERATED x -> ENUMERATED x
+ :: ENUMERATED x -> ENUMERATED x -> ENUMERATED x
$c+ :: forall x. Num x => ENUMERATED x -> ENUMERATED x -> ENUMERATED x
Num,Int -> ENUMERATED x -> ShowS
[ENUMERATED x] -> ShowS
ENUMERATED x -> String
(Int -> ENUMERATED x -> ShowS)
-> (ENUMERATED x -> String)
-> ([ENUMERATED x] -> ShowS)
-> Show (ENUMERATED x)
forall x. Show x => Int -> ENUMERATED x -> ShowS
forall x. Show x => [ENUMERATED x] -> ShowS
forall x. Show x => ENUMERATED x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ENUMERATED x] -> ShowS
$cshowList :: forall x. Show x => [ENUMERATED x] -> ShowS
show :: ENUMERATED x -> String
$cshow :: forall x. Show x => ENUMERATED x -> String
showsPrec :: Int -> ENUMERATED x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> ENUMERATED x -> ShowS
Show,ENUMERATED x -> ENUMERATED x -> Bool
(ENUMERATED x -> ENUMERATED x -> Bool)
-> (ENUMERATED x -> ENUMERATED x -> Bool) -> Eq (ENUMERATED x)
forall x. Eq x => ENUMERATED x -> ENUMERATED x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ENUMERATED x -> ENUMERATED x -> Bool
$c/= :: forall x. Eq x => ENUMERATED x -> ENUMERATED x -> Bool
== :: ENUMERATED x -> ENUMERATED x -> Bool
$c== :: forall x. Eq x => ENUMERATED x -> ENUMERATED x -> Bool
Eq,Eq (ENUMERATED x)
Eq (ENUMERATED x) =>
(ENUMERATED x -> ENUMERATED x -> Ordering)
-> (ENUMERATED x -> ENUMERATED x -> Bool)
-> (ENUMERATED x -> ENUMERATED x -> Bool)
-> (ENUMERATED x -> ENUMERATED x -> Bool)
-> (ENUMERATED x -> ENUMERATED x -> Bool)
-> (ENUMERATED x -> ENUMERATED x -> ENUMERATED x)
-> (ENUMERATED x -> ENUMERATED x -> ENUMERATED x)
-> Ord (ENUMERATED x)
ENUMERATED x -> ENUMERATED x -> Bool
ENUMERATED x -> ENUMERATED x -> Ordering
ENUMERATED x -> ENUMERATED x -> ENUMERATED x
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x. Ord x => Eq (ENUMERATED x)
forall x. Ord x => ENUMERATED x -> ENUMERATED x -> Bool
forall x. Ord x => ENUMERATED x -> ENUMERATED x -> Ordering
forall x. Ord x => ENUMERATED x -> ENUMERATED x -> ENUMERATED x
min :: ENUMERATED x -> ENUMERATED x -> ENUMERATED x
$cmin :: forall x. Ord x => ENUMERATED x -> ENUMERATED x -> ENUMERATED x
max :: ENUMERATED x -> ENUMERATED x -> ENUMERATED x
$cmax :: forall x. Ord x => ENUMERATED x -> ENUMERATED x -> ENUMERATED x
>= :: ENUMERATED x -> ENUMERATED x -> Bool
$c>= :: forall x. Ord x => ENUMERATED x -> ENUMERATED x -> Bool
> :: ENUMERATED x -> ENUMERATED x -> Bool
$c> :: forall x. Ord x => ENUMERATED x -> ENUMERATED x -> Bool
<= :: ENUMERATED x -> ENUMERATED x -> Bool
$c<= :: forall x. Ord x => ENUMERATED x -> ENUMERATED x -> Bool
< :: ENUMERATED x -> ENUMERATED x -> Bool
$c< :: forall x. Ord x => ENUMERATED x -> ENUMERATED x -> Bool
compare :: ENUMERATED x -> ENUMERATED x -> Ordering
$ccompare :: forall x. Ord x => ENUMERATED x -> ENUMERATED x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (ENUMERATED x)
Ord,Int -> ENUMERATED x
ENUMERATED x -> Int
ENUMERATED x -> [ENUMERATED x]
ENUMERATED x -> ENUMERATED x
ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
ENUMERATED x -> ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
(ENUMERATED x -> ENUMERATED x)
-> (ENUMERATED x -> ENUMERATED x)
-> (Int -> ENUMERATED x)
-> (ENUMERATED x -> Int)
-> (ENUMERATED x -> [ENUMERATED x])
-> (ENUMERATED x -> ENUMERATED x -> [ENUMERATED x])
-> (ENUMERATED x -> ENUMERATED x -> [ENUMERATED x])
-> (ENUMERATED x -> ENUMERATED x -> ENUMERATED x -> [ENUMERATED x])
-> Enum (ENUMERATED x)
forall x. Enum x => Int -> ENUMERATED x
forall x. Enum x => ENUMERATED x -> Int
forall x. Enum x => ENUMERATED x -> [ENUMERATED x]
forall x. Enum x => ENUMERATED x -> ENUMERATED x
forall x. Enum x => ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
forall x.
Enum x =>
ENUMERATED x -> ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ENUMERATED x -> ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
$cenumFromThenTo :: forall x.
Enum x =>
ENUMERATED x -> ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
enumFromTo :: ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
$cenumFromTo :: forall x. Enum x => ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
enumFromThen :: ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
$cenumFromThen :: forall x. Enum x => ENUMERATED x -> ENUMERATED x -> [ENUMERATED x]
enumFrom :: ENUMERATED x -> [ENUMERATED x]
$cenumFrom :: forall x. Enum x => ENUMERATED x -> [ENUMERATED x]
fromEnum :: ENUMERATED x -> Int
$cfromEnum :: forall x. Enum x => ENUMERATED x -> Int
toEnum :: Int -> ENUMERATED x
$ctoEnum :: forall x. Enum x => Int -> ENUMERATED x
pred :: ENUMERATED x -> ENUMERATED x
$cpred :: forall x. Enum x => ENUMERATED x -> ENUMERATED x
succ :: ENUMERATED x -> ENUMERATED x
$csucc :: forall x. Enum x => ENUMERATED x -> ENUMERATED x
Enum)

instance Newtype (ENUMERATED x) x

----------------------------------------------------------------------------

class ASN1 t where
  asn1decode :: ASN1Decode t
  asn1decode = String -> Tag -> ASN1Decode t -> ASN1Decode t
forall x. String -> Tag -> ASN1Decode x -> ASN1Decode x
with'Constructed "SEQUENCE" (Proxy t -> Tag
forall t. ASN1 t => Proxy t -> Tag
asn1defTag (Proxy t
forall k (t :: k). Proxy t
Proxy :: Proxy t)) ASN1Decode t
forall t. ASN1 t => ASN1Decode t
asn1decodeCompOf

  asn1decodeCompOf :: ASN1Decode t
  asn1decodeCompOf = String -> ASN1Decode t
forall a. String -> ASN1Decode a
asn1fail "asn1decodeCompOf not implemented for type"

  asn1encode :: t -> ASN1Encode Word64
  asn1encode = Tag -> ASN1Encode Word64 -> ASN1Encode Word64
wraptag (Proxy t -> Tag
forall t. ASN1 t => Proxy t -> Tag
asn1defTag (Proxy t
forall k (t :: k). Proxy t
Proxy :: Proxy t)) (ASN1Encode Word64 -> ASN1Encode Word64)
-> (t -> ASN1Encode Word64) -> t -> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encodeCompOf

  -- constructed contents
  asn1encodeCompOf :: t -> ASN1Encode Word64
  asn1encodeCompOf = String -> t -> ASN1Encode Word64
forall a. HasCallStack => String -> a
error "asn1encode(CompOf) not implemented for type"

  -- default-tag
  asn1defTag :: Proxy t -> Tag
  asn1defTag _ = Word64 -> Tag
Universal 16

  {-# MINIMAL (asn1decode | asn1decodeCompOf), (asn1encode | asn1encodeCompOf) #-}

instance (ASN1 t1, ASN1 t2) => ASN1 (t1,t2) where
  asn1encodeCompOf :: (t1, t2) -> ASN1Encode Word64
asn1encodeCompOf (v1 :: t1
v1,v2 :: t2
v2) = [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS [t1 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t1
v1, t2 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t2
v2]
  asn1decodeCompOf :: ASN1Decode (t1, t2)
asn1decodeCompOf = (,) (t1 -> t2 -> (t1, t2))
-> ASN1Decode t1 -> ASN1Decode (t2 -> (t1, t2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode t1
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t2 -> (t1, t2)) -> ASN1Decode t2 -> ASN1Decode (t1, t2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t2
forall t. ASN1 t => ASN1Decode t
asn1decode

instance (ASN1 t1, ASN1 t2, ASN1 t3) => ASN1 (t1,t2,t3) where
  asn1encodeCompOf :: (t1, t2, t3) -> ASN1Encode Word64
asn1encodeCompOf (v1 :: t1
v1,v2 :: t2
v2,v3 :: t3
v3) = [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS [t1 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t1
v1, t2 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t2
v2, t3 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t3
v3]
  asn1decodeCompOf :: ASN1Decode (t1, t2, t3)
asn1decodeCompOf = (,,) (t1 -> t2 -> t3 -> (t1, t2, t3))
-> ASN1Decode t1 -> ASN1Decode (t2 -> t3 -> (t1, t2, t3))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode t1
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t2 -> t3 -> (t1, t2, t3))
-> ASN1Decode t2 -> ASN1Decode (t3 -> (t1, t2, t3))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t2
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t3 -> (t1, t2, t3))
-> ASN1Decode t3 -> ASN1Decode (t1, t2, t3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t3
forall t. ASN1 t => ASN1Decode t
asn1decode

instance (ASN1 t1, ASN1 t2, ASN1 t3, ASN1 t4) => ASN1 (t1,t2,t3,t4) where
  asn1encodeCompOf :: (t1, t2, t3, t4) -> ASN1Encode Word64
asn1encodeCompOf (v1 :: t1
v1,v2 :: t2
v2,v3 :: t3
v3,v4 :: t4
v4) = [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS [t1 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t1
v1, t2 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t2
v2, t3 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t3
v3, t4 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t4
v4]
  asn1decodeCompOf :: ASN1Decode (t1, t2, t3, t4)
asn1decodeCompOf = (,,,) (t1 -> t2 -> t3 -> t4 -> (t1, t2, t3, t4))
-> ASN1Decode t1 -> ASN1Decode (t2 -> t3 -> t4 -> (t1, t2, t3, t4))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode t1
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t2 -> t3 -> t4 -> (t1, t2, t3, t4))
-> ASN1Decode t2 -> ASN1Decode (t3 -> t4 -> (t1, t2, t3, t4))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t2
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t3 -> t4 -> (t1, t2, t3, t4))
-> ASN1Decode t3 -> ASN1Decode (t4 -> (t1, t2, t3, t4))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t3
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t4 -> (t1, t2, t3, t4))
-> ASN1Decode t4 -> ASN1Decode (t1, t2, t3, t4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t4
forall t. ASN1 t => ASN1Decode t
asn1decode

instance (ASN1 t1, ASN1 t2, ASN1 t3, ASN1 t4, ASN1 t5) => ASN1 (t1,t2,t3,t4,t5) where
  asn1encodeCompOf :: (t1, t2, t3, t4, t5) -> ASN1Encode Word64
asn1encodeCompOf (v1 :: t1
v1,v2 :: t2
v2,v3 :: t3
v3,v4 :: t4
v4,v5 :: t5
v5) = [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS [t1 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t1
v1, t2 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t2
v2, t3 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t3
v3, t4 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t4
v4, t5 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t5
v5]
  asn1decodeCompOf :: ASN1Decode (t1, t2, t3, t4, t5)
asn1decodeCompOf = (,,,,) (t1 -> t2 -> t3 -> t4 -> t5 -> (t1, t2, t3, t4, t5))
-> ASN1Decode t1
-> ASN1Decode (t2 -> t3 -> t4 -> t5 -> (t1, t2, t3, t4, t5))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode t1
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t2 -> t3 -> t4 -> t5 -> (t1, t2, t3, t4, t5))
-> ASN1Decode t2
-> ASN1Decode (t3 -> t4 -> t5 -> (t1, t2, t3, t4, t5))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t2
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t3 -> t4 -> t5 -> (t1, t2, t3, t4, t5))
-> ASN1Decode t3 -> ASN1Decode (t4 -> t5 -> (t1, t2, t3, t4, t5))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t3
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t4 -> t5 -> (t1, t2, t3, t4, t5))
-> ASN1Decode t4 -> ASN1Decode (t5 -> (t1, t2, t3, t4, t5))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t4
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t5 -> (t1, t2, t3, t4, t5))
-> ASN1Decode t5 -> ASN1Decode (t1, t2, t3, t4, t5)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t5
forall t. ASN1 t => ASN1Decode t
asn1decode

instance (ASN1 t1, ASN1 t2, ASN1 t3, ASN1 t4, ASN1 t5, ASN1 t6) => ASN1 (t1,t2,t3,t4,t5,t6) where
  asn1encodeCompOf :: (t1, t2, t3, t4, t5, t6) -> ASN1Encode Word64
asn1encodeCompOf (v1 :: t1
v1,v2 :: t2
v2,v3 :: t3
v3,v4 :: t4
v4,v5 :: t5
v5,v6 :: t6
v6) = [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS [t1 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t1
v1, t2 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t2
v2, t3 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t3
v3, t4 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t4
v4, t5 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t5
v5, t6 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t6
v6]
  asn1decodeCompOf :: ASN1Decode (t1, t2, t3, t4, t5, t6)
asn1decodeCompOf = (,,,,,) (t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> (t1, t2, t3, t4, t5, t6))
-> ASN1Decode t1
-> ASN1Decode
     (t2 -> t3 -> t4 -> t5 -> t6 -> (t1, t2, t3, t4, t5, t6))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode t1
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t2 -> t3 -> t4 -> t5 -> t6 -> (t1, t2, t3, t4, t5, t6))
-> ASN1Decode t2
-> ASN1Decode (t3 -> t4 -> t5 -> t6 -> (t1, t2, t3, t4, t5, t6))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t2
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t3 -> t4 -> t5 -> t6 -> (t1, t2, t3, t4, t5, t6))
-> ASN1Decode t3
-> ASN1Decode (t4 -> t5 -> t6 -> (t1, t2, t3, t4, t5, t6))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t3
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t4 -> t5 -> t6 -> (t1, t2, t3, t4, t5, t6))
-> ASN1Decode t4
-> ASN1Decode (t5 -> t6 -> (t1, t2, t3, t4, t5, t6))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t4
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t5 -> t6 -> (t1, t2, t3, t4, t5, t6))
-> ASN1Decode t5 -> ASN1Decode (t6 -> (t1, t2, t3, t4, t5, t6))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t5
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t6 -> (t1, t2, t3, t4, t5, t6))
-> ASN1Decode t6 -> ASN1Decode (t1, t2, t3, t4, t5, t6)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t6
forall t. ASN1 t => ASN1Decode t
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 :: (t1, t2, t3, t4, t5, t6, t7) -> ASN1Encode Word64
asn1encodeCompOf (v1 :: t1
v1,v2 :: t2
v2,v3 :: t3
v3,v4 :: t4
v4,v5 :: t5
v5,v6 :: t6
v6,v7 :: t7
v7) = [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE_COMPS [t1 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t1
v1, t2 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t2
v2, t3 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t3
v3, t4 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t4
v4, t5 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t5
v5, t6 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t6
v6, t7 -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t7
v7]
  asn1decodeCompOf :: ASN1Decode (t1, t2, t3, t4, t5, t6, t7)
asn1decodeCompOf = (,,,,,,) (t1
 -> t2
 -> t3
 -> t4
 -> t5
 -> t6
 -> t7
 -> (t1, t2, t3, t4, t5, t6, t7))
-> ASN1Decode t1
-> ASN1Decode
     (t2 -> t3 -> t4 -> t5 -> t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode t1
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode
  (t2 -> t3 -> t4 -> t5 -> t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
-> ASN1Decode t2
-> ASN1Decode
     (t3 -> t4 -> t5 -> t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t2
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode
  (t3 -> t4 -> t5 -> t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
-> ASN1Decode t3
-> ASN1Decode
     (t4 -> t5 -> t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t3
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t4 -> t5 -> t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
-> ASN1Decode t4
-> ASN1Decode (t5 -> t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t4
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t5 -> t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
-> ASN1Decode t5
-> ASN1Decode (t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t5
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t6 -> t7 -> (t1, t2, t3, t4, t5, t6, t7))
-> ASN1Decode t6 -> ASN1Decode (t7 -> (t1, t2, t3, t4, t5, t6, t7))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t6
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (t7 -> (t1, t2, t3, t4, t5, t6, t7))
-> ASN1Decode t7 -> ASN1Decode (t1, t2, t3, t4, t5, t6, t7)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASN1Decode t7
forall t. ASN1 t => ASN1Decode t
asn1decode

-- | ASN.1 @OCTET STRING@ type
type OCTET_STRING = ByteString

instance ASN1 ByteString where
  asn1defTag :: Proxy ByteString -> Tag
asn1defTag _ = Word64 -> Tag
Universal 4
  asn1decode :: ASN1Decode ByteString
asn1decode = ASN1Decode ByteString
dec'OCTETSTRING
  asn1encode :: ByteString -> ASN1Encode Word64
asn1encode = ByteString -> ASN1Encode Word64
enc'OCTETSTRING

instance ASN1 SBS.ShortByteString where
  asn1defTag :: Proxy ShortByteString -> Tag
asn1defTag _ = Word64 -> Tag
Universal 4
  asn1decode :: ASN1Decode ShortByteString
asn1decode = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> ASN1Decode ByteString -> ASN1Decode ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode ByteString
dec'OCTETSTRING
  asn1encode :: ShortByteString -> ASN1Encode Word64
asn1encode = ByteString -> ASN1Encode Word64
enc'OCTETSTRING (ByteString -> ASN1Encode Word64)
-> (ShortByteString -> ByteString)
-> ShortByteString
-> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort -- TODO: optimize

instance ASN1 ShortText where
  asn1defTag :: Proxy ShortText -> Tag
asn1defTag _ = Word64 -> Tag
Universal 4
  asn1decode :: ASN1Decode ShortText
asn1decode = do
    ByteString
bs <- ASN1Decode ByteString
dec'OCTETSTRING
    ASN1Decode ShortText
-> (ShortText -> ASN1Decode ShortText)
-> Maybe ShortText
-> ASN1Decode ShortText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ASN1Decode ShortText
forall a. String -> ASN1Decode a
asn1fail "OCTECT STRING contained invalid UTF-8") ShortText -> ASN1Decode ShortText
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ShortText
TS.fromByteString ByteString
bs)
  asn1encode :: ShortText -> ASN1Encode Word64
asn1encode = ShortByteString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ShortByteString -> ASN1Encode Word64)
-> (ShortText -> ShortByteString) -> ShortText -> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ShortByteString
TS.toShortByteString

type BOOLEAN = Bool

instance ASN1 Bool where
  asn1defTag :: Proxy Bool -> Tag
asn1defTag _ = Word64 -> Tag
Universal 1
  asn1decode :: ASN1Decode Bool
asn1decode = ASN1Decode Bool
dec'BOOLEAN
  asn1encode :: Bool -> ASN1Encode Word64
asn1encode = Bool -> ASN1Encode Word64
enc'BOOLEAN

type OPTIONAL x = Maybe x

instance ASN1 t => ASN1 (Maybe t) where
  asn1defTag :: Proxy (Maybe t) -> Tag
asn1defTag _ = Proxy t -> Tag
forall t. ASN1 t => Proxy t -> Tag
asn1defTag (Proxy t
forall k (t :: k). Proxy t
Proxy :: Proxy t)
  asn1decode :: ASN1Decode (Maybe t)
asn1decode = ASN1Decode t -> ASN1Decode (Maybe t)
forall x. ASN1Decode x -> ASN1Decode (Maybe x)
with'OPTIONAL ASN1Decode t
forall t. ASN1 t => ASN1Decode t
asn1decode

  asn1encode :: Maybe t -> ASN1Encode Word64
asn1encode Nothing  = ASN1Encode Word64
empty'ASN1Encode
  asn1encode (Just v :: t
v) = t -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t
v

instance Enumerated t => ASN1 (ENUMERATED t) where
  asn1defTag :: Proxy (ENUMERATED t) -> Tag
asn1defTag _ = Word64 -> Tag
Universal 10
  asn1decode :: ASN1Decode (ENUMERATED t)
asn1decode = t -> ENUMERATED t
forall x. x -> ENUMERATED x
ENUMERATED (t -> ENUMERATED t) -> ASN1Decode t -> ASN1Decode (ENUMERATED t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode t
forall enum. Enumerated enum => ASN1Decode enum
dec'ENUMERATED
  asn1encode :: ENUMERATED t -> ASN1Encode Word64
asn1encode (ENUMERATED v :: t
v) = t -> ASN1Encode Word64
forall enum. Enumerated enum => enum -> ASN1Encode Word64
enc'ENUMERATED t
v

instance ASN1 t => ASN1 [t] where
  asn1decode :: ASN1Decode [t]
asn1decode = ASN1Decode t -> ASN1Decode [t]
forall x. ASN1Decode x -> ASN1Decode [x]
with'SEQUENCE_OF ASN1Decode t
forall t. ASN1 t => ASN1Decode t
asn1decode
  asn1encode :: [t] -> ASN1Encode Word64
asn1encode = [ASN1Encode Word64] -> ASN1Encode Word64
enc'SEQUENCE ([ASN1Encode Word64] -> ASN1Encode Word64)
-> ([t] -> [ASN1Encode Word64]) -> [t] -> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> ASN1Encode Word64) -> [t] -> [ASN1Encode Word64]
forall a b. (a -> b) -> [a] -> [b]
map t -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode

-- | @SEQUENCE SIZE (1..MAX) OF@
instance ASN1 t => ASN1 (NonEmpty t) where
  asn1decode :: ASN1Decode (NonEmpty t)
asn1decode = ASN1Decode [t]
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode [t]
-> ([t] -> ASN1Decode (NonEmpty t)) -> ASN1Decode (NonEmpty t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                 []   -> String -> ASN1Decode (NonEmpty t)
forall a. String -> ASN1Decode a
asn1fail "SEQUENCE must be non-empty"
                 x :: t
x:xs :: [t]
xs -> NonEmpty t -> ASN1Decode (NonEmpty t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
x t -> [t] -> NonEmpty t
forall a. a -> [a] -> NonEmpty a
:| [t]
xs)

  asn1encode :: NonEmpty t -> ASN1Encode Word64
asn1encode (x :: t
x :| xs :: [t]
xs) = [t] -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
xs)

-- | ASN.1 @SET SIZE (1..MAX) OF@ type
newtype SET1 x = SET1 (NonEmpty x)
  deriving ((forall x. SET1 x -> Rep (SET1 x) x)
-> (forall x. Rep (SET1 x) x -> SET1 x) -> Generic (SET1 x)
forall x. Rep (SET1 x) x -> SET1 x
forall x. SET1 x -> Rep (SET1 x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (SET1 x) x -> SET1 x
forall x x. SET1 x -> Rep (SET1 x) x
$cto :: forall x x. Rep (SET1 x) x -> SET1 x
$cfrom :: forall x x. SET1 x -> Rep (SET1 x) x
Generic,SET1 x -> ()
(SET1 x -> ()) -> NFData (SET1 x)
forall x. NFData x => SET1 x -> ()
forall a. (a -> ()) -> NFData a
rnf :: SET1 x -> ()
$crnf :: forall x. NFData x => SET1 x -> ()
NFData,Int -> SET1 x -> ShowS
[SET1 x] -> ShowS
SET1 x -> String
(Int -> SET1 x -> ShowS)
-> (SET1 x -> String) -> ([SET1 x] -> ShowS) -> Show (SET1 x)
forall x. Show x => Int -> SET1 x -> ShowS
forall x. Show x => [SET1 x] -> ShowS
forall x. Show x => SET1 x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SET1 x] -> ShowS
$cshowList :: forall x. Show x => [SET1 x] -> ShowS
show :: SET1 x -> String
$cshow :: forall x. Show x => SET1 x -> String
showsPrec :: Int -> SET1 x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> SET1 x -> ShowS
Show,SET1 x -> SET1 x -> Bool
(SET1 x -> SET1 x -> Bool)
-> (SET1 x -> SET1 x -> Bool) -> Eq (SET1 x)
forall x. Eq x => SET1 x -> SET1 x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SET1 x -> SET1 x -> Bool
$c/= :: forall x. Eq x => SET1 x -> SET1 x -> Bool
== :: SET1 x -> SET1 x -> Bool
$c== :: forall x. Eq x => SET1 x -> SET1 x -> Bool
Eq,Eq (SET1 x)
Eq (SET1 x) =>
(SET1 x -> SET1 x -> Ordering)
-> (SET1 x -> SET1 x -> Bool)
-> (SET1 x -> SET1 x -> Bool)
-> (SET1 x -> SET1 x -> Bool)
-> (SET1 x -> SET1 x -> Bool)
-> (SET1 x -> SET1 x -> SET1 x)
-> (SET1 x -> SET1 x -> SET1 x)
-> Ord (SET1 x)
SET1 x -> SET1 x -> Bool
SET1 x -> SET1 x -> Ordering
SET1 x -> SET1 x -> SET1 x
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x. Ord x => Eq (SET1 x)
forall x. Ord x => SET1 x -> SET1 x -> Bool
forall x. Ord x => SET1 x -> SET1 x -> Ordering
forall x. Ord x => SET1 x -> SET1 x -> SET1 x
min :: SET1 x -> SET1 x -> SET1 x
$cmin :: forall x. Ord x => SET1 x -> SET1 x -> SET1 x
max :: SET1 x -> SET1 x -> SET1 x
$cmax :: forall x. Ord x => SET1 x -> SET1 x -> SET1 x
>= :: SET1 x -> SET1 x -> Bool
$c>= :: forall x. Ord x => SET1 x -> SET1 x -> Bool
> :: SET1 x -> SET1 x -> Bool
$c> :: forall x. Ord x => SET1 x -> SET1 x -> Bool
<= :: SET1 x -> SET1 x -> Bool
$c<= :: forall x. Ord x => SET1 x -> SET1 x -> Bool
< :: SET1 x -> SET1 x -> Bool
$c< :: forall x. Ord x => SET1 x -> SET1 x -> Bool
compare :: SET1 x -> SET1 x -> Ordering
$ccompare :: forall x. Ord x => SET1 x -> SET1 x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (SET1 x)
Ord)

instance Newtype (SET1 x) (NonEmpty x)

instance ASN1 t => ASN1 (SET1 t) where
  asn1defTag :: Proxy (SET1 t) -> Tag
asn1defTag _ = Word64 -> Tag
Universal 17
  asn1decode :: ASN1Decode (SET1 t)
asn1decode = ASN1Decode (SET t)
forall t. ASN1 t => ASN1Decode t
asn1decode ASN1Decode (SET t)
-> (SET t -> ASN1Decode (SET1 t)) -> ASN1Decode (SET1 t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                 SET [] -> String -> ASN1Decode (SET1 t)
forall a. String -> ASN1Decode a
asn1fail "SET must be non-empty"
                 SET (x :: t
x:xs :: [t]
xs) -> SET1 t -> ASN1Decode (SET1 t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty t -> SET1 t
forall x. NonEmpty x -> SET1 x
SET1 (t
x t -> [t] -> NonEmpty t
forall a. a -> [a] -> NonEmpty a
:| [t]
xs))

  asn1encode :: SET1 t -> ASN1Encode Word64
asn1encode (SET1 (x :: t
x :| xs :: [t]
xs)) = SET t -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode ([t] -> SET t
forall x. [x] -> SET x
SET (t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
xs))

-- | ASN.1 @SET OF@ type
newtype SET x = SET [x]
  deriving ((forall x. SET x -> Rep (SET x) x)
-> (forall x. Rep (SET x) x -> SET x) -> Generic (SET x)
forall x. Rep (SET x) x -> SET x
forall x. SET x -> Rep (SET x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (SET x) x -> SET x
forall x x. SET x -> Rep (SET x) x
$cto :: forall x x. Rep (SET x) x -> SET x
$cfrom :: forall x x. SET x -> Rep (SET x) x
Generic,SET x -> ()
(SET x -> ()) -> NFData (SET x)
forall x. NFData x => SET x -> ()
forall a. (a -> ()) -> NFData a
rnf :: SET x -> ()
$crnf :: forall x. NFData x => SET x -> ()
NFData,Int -> SET x -> ShowS
[SET x] -> ShowS
SET x -> String
(Int -> SET x -> ShowS)
-> (SET x -> String) -> ([SET x] -> ShowS) -> Show (SET x)
forall x. Show x => Int -> SET x -> ShowS
forall x. Show x => [SET x] -> ShowS
forall x. Show x => SET x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SET x] -> ShowS
$cshowList :: forall x. Show x => [SET x] -> ShowS
show :: SET x -> String
$cshow :: forall x. Show x => SET x -> String
showsPrec :: Int -> SET x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> SET x -> ShowS
Show,SET x -> SET x -> Bool
(SET x -> SET x -> Bool) -> (SET x -> SET x -> Bool) -> Eq (SET x)
forall x. Eq x => SET x -> SET x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SET x -> SET x -> Bool
$c/= :: forall x. Eq x => SET x -> SET x -> Bool
== :: SET x -> SET x -> Bool
$c== :: forall x. Eq x => SET x -> SET x -> Bool
Eq,Eq (SET x)
Eq (SET x) =>
(SET x -> SET x -> Ordering)
-> (SET x -> SET x -> Bool)
-> (SET x -> SET x -> Bool)
-> (SET x -> SET x -> Bool)
-> (SET x -> SET x -> Bool)
-> (SET x -> SET x -> SET x)
-> (SET x -> SET x -> SET x)
-> Ord (SET x)
SET x -> SET x -> Bool
SET x -> SET x -> Ordering
SET x -> SET x -> SET x
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x. Ord x => Eq (SET x)
forall x. Ord x => SET x -> SET x -> Bool
forall x. Ord x => SET x -> SET x -> Ordering
forall x. Ord x => SET x -> SET x -> SET x
min :: SET x -> SET x -> SET x
$cmin :: forall x. Ord x => SET x -> SET x -> SET x
max :: SET x -> SET x -> SET x
$cmax :: forall x. Ord x => SET x -> SET x -> SET x
>= :: SET x -> SET x -> Bool
$c>= :: forall x. Ord x => SET x -> SET x -> Bool
> :: SET x -> SET x -> Bool
$c> :: forall x. Ord x => SET x -> SET x -> Bool
<= :: SET x -> SET x -> Bool
$c<= :: forall x. Ord x => SET x -> SET x -> Bool
< :: SET x -> SET x -> Bool
$c< :: forall x. Ord x => SET x -> SET x -> Bool
compare :: SET x -> SET x -> Ordering
$ccompare :: forall x. Ord x => SET x -> SET x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (SET x)
Ord)

instance Newtype (SET x) [x]

instance ASN1 t => ASN1 (SET t) where
  asn1defTag :: Proxy (SET t) -> Tag
asn1defTag _ = Word64 -> Tag
Universal 17
  asn1decode :: ASN1Decode (SET t)
asn1decode = [t] -> SET t
forall x. [x] -> SET x
SET ([t] -> SET t) -> ASN1Decode [t] -> ASN1Decode (SET t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode t -> ASN1Decode [t]
forall x. ASN1Decode x -> ASN1Decode [x]
with'SET_OF ASN1Decode t
forall t. ASN1 t => ASN1Decode t
asn1decode
  asn1encode :: SET t -> ASN1Encode Word64
asn1encode (SET vs :: [t]
vs) = [ASN1Encode Word64] -> ASN1Encode Word64
enc'SET ((t -> ASN1Encode Word64) -> [t] -> [ASN1Encode Word64]
forall a b. (a -> b) -> [a] -> [b]
map t -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode [t]
vs)

instance ASN1 Integer where
  asn1defTag :: Proxy Integer -> Tag
asn1defTag _ = Word64 -> Tag
Universal 2
  asn1decode :: ASN1Decode Integer
asn1decode = ASN1Decode Integer
dec'INTEGER
  asn1encode :: Integer -> ASN1Encode Word64
asn1encode = Integer -> ASN1Encode Word64
enc'INTEGER

instance ASN1 Int64 where
  asn1defTag :: Proxy Int64 -> Tag
asn1defTag _ = Word64 -> Tag
Universal 2
  asn1decode :: ASN1Decode Int64
asn1decode = ASN1Decode Int64
dec'Int64
  asn1encode :: Int64 -> ASN1Encode Word64
asn1encode = Int64 -> ASN1Encode Word64
enc'Int64

instance (UIntBounds lb ub t, Integral t) => ASN1 (UInt lb ub t) where
  asn1defTag :: Proxy (UInt lb ub t) -> Tag
asn1defTag _ = Word64 -> Tag
Universal 2
  asn1decode :: ASN1Decode (UInt lb ub t)
asn1decode = ASN1Decode (UInt lb ub t)
forall (lb :: Nat) (ub :: Nat) t.
(UIntBounds lb ub t, Num t) =>
ASN1Decode (UInt lb ub t)
dec'UInt
  asn1encode :: UInt lb ub t -> ASN1Encode Word64
asn1encode = UInt lb ub t -> ASN1Encode Word64
forall (lb :: Nat) (ub :: Nat) t.
(UIntBounds lb ub t, Num t, Integral t) =>
UInt lb ub t -> ASN1Encode Word64
enc'UInt

instance forall tag t . (KnownTag tag, ASN1 t) => ASN1 (IMPLICIT tag t) where
  asn1defTag :: Proxy (IMPLICIT tag t) -> Tag
asn1defTag _ = Proxy tag -> Tag
forall (tag :: TagK). KnownTag tag => Proxy tag -> Tag
tagVal (Proxy tag
forall k (t :: k). Proxy t
Proxy :: Proxy tag)
  asn1decode :: ASN1Decode (IMPLICIT tag t)
asn1decode = t -> IMPLICIT tag t
forall (tag :: TagK) x. x -> IMPLICIT tag x
IMPLICIT (t -> IMPLICIT tag t)
-> ASN1Decode t -> ASN1Decode (IMPLICIT tag t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tag -> ASN1Decode t -> ASN1Decode t
forall x. Tag -> ASN1Decode x -> ASN1Decode x
implicit (Proxy tag -> Tag
forall (tag :: TagK). KnownTag tag => Proxy tag -> Tag
tagVal (Proxy tag
forall k (t :: k). Proxy t
Proxy :: Proxy tag)) ASN1Decode t
forall t. ASN1 t => ASN1Decode t
asn1decode
  asn1encode :: IMPLICIT tag t -> ASN1Encode Word64
asn1encode (IMPLICIT v :: t
v) = Tag -> ASN1Encode Word64 -> ASN1Encode Word64
forall a. Tag -> ASN1Encode a -> ASN1Encode a
retag (Proxy tag -> Tag
forall (tag :: TagK). KnownTag tag => Proxy tag -> Tag
tagVal (Proxy tag
forall k (t :: k). Proxy t
Proxy :: Proxy tag)) (t -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t
v)

instance forall tag t . (KnownTag tag, ASN1 t) => ASN1 (EXPLICIT tag t) where
  asn1defTag :: Proxy (EXPLICIT tag t) -> Tag
asn1defTag _ = Proxy tag -> Tag
forall (tag :: TagK). KnownTag tag => Proxy tag -> Tag
tagVal (Proxy tag
forall k (t :: k). Proxy t
Proxy :: Proxy tag)
  asn1decode :: ASN1Decode (EXPLICIT tag t)
asn1decode = t -> EXPLICIT tag t
forall (tag :: TagK) x. x -> EXPLICIT tag x
EXPLICIT (t -> EXPLICIT tag t)
-> ASN1Decode t -> ASN1Decode (EXPLICIT tag t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tag -> ASN1Decode t -> ASN1Decode t
forall x. Tag -> ASN1Decode x -> ASN1Decode x
explicit (Proxy tag -> Tag
forall (tag :: TagK). KnownTag tag => Proxy tag -> Tag
tagVal (Proxy tag
forall k (t :: k). Proxy t
Proxy :: Proxy tag)) ASN1Decode t
forall t. ASN1 t => ASN1Decode t
asn1decode
  asn1encode :: EXPLICIT tag t -> ASN1Encode Word64
asn1encode (EXPLICIT v :: t
v) = Tag -> ASN1Encode Word64 -> ASN1Encode Word64
wraptag (Proxy tag -> Tag
forall (tag :: TagK). KnownTag tag => Proxy tag -> Tag
tagVal (Proxy tag
forall k (t :: k). Proxy t
Proxy :: Proxy tag)) (t -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode t
v)

-- | ASN.1 @NULL@ type
type NULL = ()

-- | denotes @NULL@
instance ASN1 () where
  asn1defTag :: Proxy () -> Tag
asn1defTag _ = Word64 -> Tag
Universal 5
  asn1decode :: ASN1Decode ()
asn1decode = ASN1Decode ()
dec'NULL
  asn1encode :: () -> ASN1Encode Word64
asn1encode () = ASN1Encode Word64
enc'NULL

-- | This represents a @BOOLEAN DEFAULT FALSE@ that is only ever serialized as 'True' (hence why its only inhabitant is a /true/ value)
--
-- This must be 'Maybe'-wrapped to make any sense; the table below shows the mapping between 'Bool' values and this construct.
--
-- +---------+-----------------------------------+
-- | 'Bool'  | @'Maybe' 'BOOLEAN_DEFAULT_FALSE'@ |
-- +=========+===================================+
-- | 'False' | 'Nothing'                         |
-- +---------+-----------------------------------+
-- | 'True'  | @'Just' 'BOOL_TRUE'@              |
-- +---------+-----------------------------------+
--
data BOOLEAN_DEFAULT_FALSE = BOOL_TRUE
  deriving ((forall x. BOOLEAN_DEFAULT_FALSE -> Rep BOOLEAN_DEFAULT_FALSE x)
-> (forall x. Rep BOOLEAN_DEFAULT_FALSE x -> BOOLEAN_DEFAULT_FALSE)
-> Generic BOOLEAN_DEFAULT_FALSE
forall x. Rep BOOLEAN_DEFAULT_FALSE x -> BOOLEAN_DEFAULT_FALSE
forall x. BOOLEAN_DEFAULT_FALSE -> Rep BOOLEAN_DEFAULT_FALSE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BOOLEAN_DEFAULT_FALSE x -> BOOLEAN_DEFAULT_FALSE
$cfrom :: forall x. BOOLEAN_DEFAULT_FALSE -> Rep BOOLEAN_DEFAULT_FALSE x
Generic,BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
(BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool)
-> (BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool)
-> Eq BOOLEAN_DEFAULT_FALSE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
$c/= :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
== :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
$c== :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
Eq,Eq BOOLEAN_DEFAULT_FALSE
Eq BOOLEAN_DEFAULT_FALSE =>
(BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Ordering)
-> (BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool)
-> (BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool)
-> (BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool)
-> (BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool)
-> (BOOLEAN_DEFAULT_FALSE
    -> BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE)
-> (BOOLEAN_DEFAULT_FALSE
    -> BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE)
-> Ord BOOLEAN_DEFAULT_FALSE
BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Ordering
BOOLEAN_DEFAULT_FALSE
-> BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BOOLEAN_DEFAULT_FALSE
-> BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE
$cmin :: BOOLEAN_DEFAULT_FALSE
-> BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE
max :: BOOLEAN_DEFAULT_FALSE
-> BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE
$cmax :: BOOLEAN_DEFAULT_FALSE
-> BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE
>= :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
$c>= :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
> :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
$c> :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
<= :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
$c<= :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
< :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
$c< :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Bool
compare :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Ordering
$ccompare :: BOOLEAN_DEFAULT_FALSE -> BOOLEAN_DEFAULT_FALSE -> Ordering
$cp1Ord :: Eq BOOLEAN_DEFAULT_FALSE
Ord,Int -> BOOLEAN_DEFAULT_FALSE -> ShowS
[BOOLEAN_DEFAULT_FALSE] -> ShowS
BOOLEAN_DEFAULT_FALSE -> String
(Int -> BOOLEAN_DEFAULT_FALSE -> ShowS)
-> (BOOLEAN_DEFAULT_FALSE -> String)
-> ([BOOLEAN_DEFAULT_FALSE] -> ShowS)
-> Show BOOLEAN_DEFAULT_FALSE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BOOLEAN_DEFAULT_FALSE] -> ShowS
$cshowList :: [BOOLEAN_DEFAULT_FALSE] -> ShowS
show :: BOOLEAN_DEFAULT_FALSE -> String
$cshow :: BOOLEAN_DEFAULT_FALSE -> String
showsPrec :: Int -> BOOLEAN_DEFAULT_FALSE -> ShowS
$cshowsPrec :: Int -> BOOLEAN_DEFAULT_FALSE -> ShowS
Show)

instance NFData BOOLEAN_DEFAULT_FALSE where
  rnf :: BOOLEAN_DEFAULT_FALSE -> ()
rnf BOOL_TRUE = ()

instance ASN1 BOOLEAN_DEFAULT_FALSE where
  asn1defTag :: Proxy BOOLEAN_DEFAULT_FALSE -> Tag
asn1defTag _ = Word64 -> Tag
Universal 1 -- not used
  asn1decode :: ASN1Decode BOOLEAN_DEFAULT_FALSE
asn1decode = ASN1Decode Bool
dec'BOOLEAN ASN1Decode Bool
-> (Bool -> Either String BOOLEAN_DEFAULT_FALSE)
-> ASN1Decode BOOLEAN_DEFAULT_FALSE
forall x y. ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
`transformVia`
               Either String BOOLEAN_DEFAULT_FALSE
-> Either String BOOLEAN_DEFAULT_FALSE
-> Bool
-> Either String BOOLEAN_DEFAULT_FALSE
forall a. a -> a -> Bool -> a
bool (String -> Either String BOOLEAN_DEFAULT_FALSE
forall a b. a -> Either a b
Left "FALSE encountered despite 'BOOLEAN DEFAULT FALSE'") (BOOLEAN_DEFAULT_FALSE -> Either String BOOLEAN_DEFAULT_FALSE
forall a b. b -> Either a b
Right BOOLEAN_DEFAULT_FALSE
BOOL_TRUE)
  asn1encode :: BOOLEAN_DEFAULT_FALSE -> ASN1Encode Word64
asn1encode BOOL_TRUE = Bool -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode Bool
True