-- |
-- Module      : Crypto.Store.ASN1.Parse
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- Parser combinators for ASN.1 stream.  Similar to "Data.ASN1.Parse" but
-- with the following additions:
--
-- * Parsed stream is annotated, i.e. parser input is @('ASN1', e)@ instead of
--   @'ASN1'@.  Main motivation is to allow to parse a sequence of 'ASN1Repr'
--   and hold the exact binary content that has been parsed.  As consequence,
--   no @getObject@ function is provided.  Function 'withAnnotations' runs
--   a parser and returns all annotations consumed in a monoid concatenation.
--
-- * The parser implements 'Alternative' and 'MonadPlus'.
--
-- * The 'fail' function returns a parse error so that pattern matching makes
--   monadic parsing code easier to write.
{-# LANGUAGE CPP #-}
module Crypto.Store.ASN1.Parse
    ( ParseASN1
    -- * run
    , runParseASN1State
    , runParseASN1State_
    , runParseASN1
    , runParseASN1_
    , throwParseError
    -- * combinators
    , onNextContainer
    , onNextContainerMaybe
    , getNextContainer
    , getNextContainerMaybe
    , getNext
    , getNextMaybe
    , hasNext
    , getMany
    , withAnnotations
    ) where

import Data.ASN1.Types
import Data.Monoid
import Control.Applicative
import Control.Arrow (first)
import Control.Monad (MonadPlus(..), liftM2)
#if !(MIN_VERSION_base(4,13,0))
import Control.Monad.Fail as Fail
#endif

data State e = State [(ASN1, e)] !e

-- | ASN1 parse monad
newtype ParseASN1 e a = P { forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP :: State e -> Either String (a, State e) }

instance Functor (ParseASN1 e) where
    fmap :: forall a b. (a -> b) -> ParseASN1 e a -> ParseASN1 e b
fmap a -> b
f ParseASN1 e a
m = (State e -> Either String (b, State e)) -> ParseASN1 e b
forall e a.
(State e -> Either String (a, State e)) -> ParseASN1 e a
P (((a, State e) -> (b, State e))
-> Either String (a, State e) -> Either String (b, State e)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, State e) -> (b, State e)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f) (Either String (a, State e) -> Either String (b, State e))
-> (State e -> Either String (a, State e))
-> State e
-> Either String (b, State e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseASN1 e a -> State e -> Either String (a, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP ParseASN1 e a
m)
instance Applicative (ParseASN1 e) where
    pure :: forall a. a -> ParseASN1 e a
pure a
a = (State e -> Either String (a, State e)) -> ParseASN1 e a
forall e a.
(State e -> Either String (a, State e)) -> ParseASN1 e a
P ((State e -> Either String (a, State e)) -> ParseASN1 e a)
-> (State e -> Either String (a, State e)) -> ParseASN1 e a
forall a b. (a -> b) -> a -> b
$ \State e
s -> (a, State e) -> Either String (a, State e)
forall a b. b -> Either a b
Right (a
a, State e
s)
    <*> :: forall a b. ParseASN1 e (a -> b) -> ParseASN1 e a -> ParseASN1 e b
(<*>) ParseASN1 e (a -> b)
mf ParseASN1 e a
ma = (State e -> Either String (b, State e)) -> ParseASN1 e b
forall e a.
(State e -> Either String (a, State e)) -> ParseASN1 e a
P ((State e -> Either String (b, State e)) -> ParseASN1 e b)
-> (State e -> Either String (b, State e)) -> ParseASN1 e b
forall a b. (a -> b) -> a -> b
$ \State e
s ->
        case ParseASN1 e (a -> b) -> State e -> Either String (a -> b, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP ParseASN1 e (a -> b)
mf State e
s of
            Left String
err      -> String -> Either String (b, State e)
forall a b. a -> Either a b
Left String
err
            Right (a -> b
f, State e
s2) ->
                case ParseASN1 e a -> State e -> Either String (a, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP ParseASN1 e a
ma State e
s2 of
                    Left String
err      -> String -> Either String (b, State e)
forall a b. a -> Either a b
Left String
err
                    Right (a
a, State e
s3) -> (b, State e) -> Either String (b, State e)
forall a b. b -> Either a b
Right (a -> b
f a
a, State e
s3)
instance Alternative (ParseASN1 e) where
    empty :: forall a. ParseASN1 e a
empty = String -> ParseASN1 e a
forall e a. String -> ParseASN1 e a
throwParseError String
"empty"
    <|> :: forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
(<|>) = ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance Monad (ParseASN1 e) where
    return :: forall a. a -> ParseASN1 e a
return      = a -> ParseASN1 e a
forall a. a -> ParseASN1 e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    >>= :: forall a b. ParseASN1 e a -> (a -> ParseASN1 e b) -> ParseASN1 e b
(>>=) ParseASN1 e a
m1 a -> ParseASN1 e b
m2 = (State e -> Either String (b, State e)) -> ParseASN1 e b
forall e a.
(State e -> Either String (a, State e)) -> ParseASN1 e a
P ((State e -> Either String (b, State e)) -> ParseASN1 e b)
-> (State e -> Either String (b, State e)) -> ParseASN1 e b
forall a b. (a -> b) -> a -> b
$ \State e
s ->
        case ParseASN1 e a -> State e -> Either String (a, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP ParseASN1 e a
m1 State e
s of
            Left String
err      -> String -> Either String (b, State e)
forall a b. a -> Either a b
Left String
err
            Right (a
a, State e
s2) -> ParseASN1 e b -> State e -> Either String (b, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP (a -> ParseASN1 e b
m2 a
a) State e
s2
#if !(MIN_VERSION_base(4,13,0))
    fail        = Fail.fail
#endif
instance MonadFail (ParseASN1 e) where
    fail :: forall a. String -> ParseASN1 e a
fail = String -> ParseASN1 e a
forall e a. String -> ParseASN1 e a
throwParseError
instance MonadPlus (ParseASN1 e) where
    mzero :: forall a. ParseASN1 e a
mzero = String -> ParseASN1 e a
forall e a. String -> ParseASN1 e a
throwParseError String
"mzero"
    mplus :: forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
mplus ParseASN1 e a
m1 ParseASN1 e a
m2 = (State e -> Either String (a, State e)) -> ParseASN1 e a
forall e a.
(State e -> Either String (a, State e)) -> ParseASN1 e a
P ((State e -> Either String (a, State e)) -> ParseASN1 e a)
-> (State e -> Either String (a, State e)) -> ParseASN1 e a
forall a b. (a -> b) -> a -> b
$ \State e
s ->
        case ParseASN1 e a -> State e -> Either String (a, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP ParseASN1 e a
m1 State e
s of
            Left  String
_ -> ParseASN1 e a -> State e -> Either String (a, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP ParseASN1 e a
m2 State e
s
            Either String (a, State e)
success -> Either String (a, State e)
success

get :: ParseASN1 e (State e)
get :: forall e. ParseASN1 e (State e)
get = (State e -> Either String (State e, State e))
-> ParseASN1 e (State e)
forall e a.
(State e -> Either String (a, State e)) -> ParseASN1 e a
P ((State e -> Either String (State e, State e))
 -> ParseASN1 e (State e))
-> (State e -> Either String (State e, State e))
-> ParseASN1 e (State e)
forall a b. (a -> b) -> a -> b
$ \State e
stream -> (State e, State e) -> Either String (State e, State e)
forall a b. b -> Either a b
Right (State e
stream, State e
stream)

put :: State e -> ParseASN1 e ()
put :: forall e. State e -> ParseASN1 e ()
put State e
stream = (State e -> Either String ((), State e)) -> ParseASN1 e ()
forall e a.
(State e -> Either String (a, State e)) -> ParseASN1 e a
P ((State e -> Either String ((), State e)) -> ParseASN1 e ())
-> (State e -> Either String ((), State e)) -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$ \State e
_ -> ((), State e) -> Either String ((), State e)
forall a b. b -> Either a b
Right ((), State e
stream)

-- | throw a parse error
throwParseError :: String -> ParseASN1 e a
throwParseError :: forall e a. String -> ParseASN1 e a
throwParseError String
s = (State e -> Either String (a, State e)) -> ParseASN1 e a
forall e a.
(State e -> Either String (a, State e)) -> ParseASN1 e a
P ((State e -> Either String (a, State e)) -> ParseASN1 e a)
-> (State e -> Either String (a, State e)) -> ParseASN1 e a
forall a b. (a -> b) -> a -> b
$ \State e
_ -> String -> Either String (a, State e)
forall a b. a -> Either a b
Left String
s

wrap :: ASN1 -> (ASN1, ())
wrap :: ASN1 -> (ASN1, ())
wrap ASN1
a = (ASN1
a, ())

unwrap :: (ASN1, ()) -> ASN1
unwrap :: (ASN1, ()) -> ASN1
unwrap (ASN1
a, ()) = ASN1
a

-- | run the parse monad over a stream and returns the result and the remaining ASN1 Stream.
runParseASN1State :: ParseASN1 () a -> [ASN1] -> Either String (a, [ASN1])
runParseASN1State :: forall a. ParseASN1 () a -> [ASN1] -> Either String (a, [ASN1])
runParseASN1State ParseASN1 () a
f [ASN1]
a = do
    (a
a', [(ASN1, ())]
list) <- ParseASN1 () a -> [(ASN1, ())] -> Either String (a, [(ASN1, ())])
forall e a.
Monoid e =>
ParseASN1 e a -> [(ASN1, e)] -> Either String (a, [(ASN1, e)])
runParseASN1State_ ParseASN1 () a
f ((ASN1 -> (ASN1, ())) -> [ASN1] -> [(ASN1, ())]
forall a b. (a -> b) -> [a] -> [b]
map ASN1 -> (ASN1, ())
wrap [ASN1]
a)
    (a, [ASN1]) -> Either String (a, [ASN1])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a', ((ASN1, ()) -> ASN1) -> [(ASN1, ())] -> [ASN1]
forall a b. (a -> b) -> [a] -> [b]
map (ASN1, ()) -> ASN1
unwrap [(ASN1, ())]
list)

-- | run the parse monad over a stream and returns the result and the remaining ASN1 Stream.
runParseASN1State_ :: Monoid e => ParseASN1 e a -> [(ASN1, e)] -> Either String (a, [(ASN1, e)])
runParseASN1State_ :: forall e a.
Monoid e =>
ParseASN1 e a -> [(ASN1, e)] -> Either String (a, [(ASN1, e)])
runParseASN1State_ ParseASN1 e a
f [(ASN1, e)]
a = do
    (a
r, State [(ASN1, e)]
a' e
_) <- ParseASN1 e a -> State e -> Either String (a, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP ParseASN1 e a
f ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
a e
forall a. Monoid a => a
mempty)
    (a, [(ASN1, e)]) -> Either String (a, [(ASN1, e)])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, [(ASN1, e)]
a')

-- | run the parse monad over a stream and returns the result.
--
-- If there's still some asn1 object in the state after calling f,
-- an error will be raised.
runParseASN1 :: ParseASN1 () a -> [ASN1] -> Either String a
runParseASN1 :: forall a. ParseASN1 () a -> [ASN1] -> Either String a
runParseASN1 ParseASN1 () a
f [ASN1]
s = ParseASN1 () a -> [(ASN1, ())] -> Either String a
forall e a.
Monoid e =>
ParseASN1 e a -> [(ASN1, e)] -> Either String a
runParseASN1_ ParseASN1 () a
f ((ASN1 -> (ASN1, ())) -> [ASN1] -> [(ASN1, ())]
forall a b. (a -> b) -> [a] -> [b]
map ASN1 -> (ASN1, ())
wrap [ASN1]
s)

-- | run the parse monad over a stream and returns the result.
--
-- If there's still some asn1 object in the state after calling f,
-- an error will be raised.
runParseASN1_ :: Monoid e => ParseASN1 e a -> [(ASN1, e)] -> Either String a
runParseASN1_ :: forall e a.
Monoid e =>
ParseASN1 e a -> [(ASN1, e)] -> Either String a
runParseASN1_ ParseASN1 e a
f [(ASN1, e)]
s =
    case ParseASN1 e a -> State e -> Either String (a, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP ParseASN1 e a
f ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
s e
forall a. Monoid a => a
mempty) of
        Left String
err              -> String -> Either String a
forall a b. a -> Either a b
Left String
err
        Right (a
o, State [] e
_) -> a -> Either String a
forall a b. b -> Either a b
Right a
o
        Right (a
_, State [(ASN1, e)]
er e
_) ->
            String -> Either String a
forall a b. a -> Either a b
Left (String
"runParseASN1_: remaining state " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show (((ASN1, e) -> ASN1) -> [(ASN1, e)] -> [ASN1]
forall a b. (a -> b) -> [a] -> [b]
map (ASN1, e) -> ASN1
forall a b. (a, b) -> a
fst [(ASN1, e)]
er))

-- | get next element from the stream
getNext :: Monoid e => ParseASN1 e ASN1
getNext :: forall e. Monoid e => ParseASN1 e ASN1
getNext = do
    State e
list <- ParseASN1 e (State e)
forall e. ParseASN1 e (State e)
get
    case State e
list of
        State []        e
_  -> String -> ParseASN1 e ASN1
forall e a. String -> ParseASN1 e a
throwParseError String
"empty"
        State ((ASN1
h,e
e):[(ASN1, e)]
l) e
es -> State e -> ParseASN1 e ()
forall e. State e -> ParseASN1 e ()
put ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
l (e
es e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e)) ParseASN1 e () -> ParseASN1 e ASN1 -> ParseASN1 e ASN1
forall a b. ParseASN1 e a -> ParseASN1 e b -> ParseASN1 e b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ASN1 -> ParseASN1 e ASN1
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return ASN1
h

-- | get many elements until there's nothing left
getMany :: ParseASN1 e a -> ParseASN1 e [a]
getMany :: forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany ParseASN1 e a
getOne = do
    Bool
next <- ParseASN1 e Bool
forall e. ParseASN1 e Bool
hasNext
    if Bool
next
        then (a -> [a] -> [a])
-> ParseASN1 e a -> ParseASN1 e [a] -> ParseASN1 e [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ParseASN1 e a
getOne (ParseASN1 e a -> ParseASN1 e [a]
forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany ParseASN1 e a
getOne)
        else [a] -> ParseASN1 e [a]
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | get next element from the stream maybe
getNextMaybe :: Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe :: forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe a
f = do
    State e
list <- ParseASN1 e (State e)
forall e. ParseASN1 e (State e)
get
    case State e
list of
        State []        e
_  -> Maybe a -> ParseASN1 e (Maybe a)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        State ((ASN1
h,e
e):[(ASN1, e)]
l) e
es -> let r :: Maybe a
r = ASN1 -> Maybe a
f ASN1
h
                               in do case Maybe a
r of
                                         Maybe a
Nothing -> State e -> ParseASN1 e ()
forall e. State e -> ParseASN1 e ()
put State e
list
                                         Just a
_  -> State e -> ParseASN1 e ()
forall e. State e -> ParseASN1 e ()
put ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
l (e
es e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e))
                                     Maybe a -> ParseASN1 e (Maybe a)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
r

-- | get next container of specified type and return all its elements
getNextContainer :: Monoid e => ASN1ConstructionType -> ParseASN1 e [(ASN1, e)]
getNextContainer :: forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [(ASN1, e)]
getNextContainer ASN1ConstructionType
ty = do
    State e
list <- ParseASN1 e (State e)
forall e. ParseASN1 e (State e)
get
    case State e
list of
        State []        e
_                  -> String -> ParseASN1 e [(ASN1, e)]
forall e a. String -> ParseASN1 e a
throwParseError String
"empty"
        State ((ASN1
h,e
e):[(ASN1, e)]
l) e
es | ASN1
h ASN1 -> ASN1 -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
ty -> do let ([(ASN1, e)]
l1, State e
l2) = Int -> State e -> ([(ASN1, e)], State e)
forall e. Monoid e => Int -> State e -> ([(ASN1, e)], State e)
getConstructedEnd Int
0 ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
l (e
es e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e))
                                                 State e -> ParseASN1 e ()
forall e. State e -> ParseASN1 e ()
put State e
l2 ParseASN1 e ()
-> ParseASN1 e [(ASN1, e)] -> ParseASN1 e [(ASN1, e)]
forall a b. ParseASN1 e a -> ParseASN1 e b -> ParseASN1 e b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(ASN1, e)] -> ParseASN1 e [(ASN1, e)]
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return [(ASN1, e)]
l1
                           | Bool
otherwise     -> String -> ParseASN1 e [(ASN1, e)]
forall e a. String -> ParseASN1 e a
throwParseError String
"not an expected container"


-- | run a function of the next elements of a container of specified type
onNextContainer :: Monoid e => ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer :: forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
ty ParseASN1 e a
f = ASN1ConstructionType -> ParseASN1 e [(ASN1, e)]
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [(ASN1, e)]
getNextContainer ASN1ConstructionType
ty ParseASN1 e [(ASN1, e)]
-> ([(ASN1, e)] -> ParseASN1 e a) -> ParseASN1 e a
forall a b. ParseASN1 e a -> (a -> ParseASN1 e b) -> ParseASN1 e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> ParseASN1 e a)
-> (a -> ParseASN1 e a) -> Either String a -> ParseASN1 e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParseASN1 e a
forall e a. String -> ParseASN1 e a
throwParseError a -> ParseASN1 e a
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> ParseASN1 e a)
-> ([(ASN1, e)] -> Either String a) -> [(ASN1, e)] -> ParseASN1 e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseASN1 e a -> [(ASN1, e)] -> Either String a
forall e a.
Monoid e =>
ParseASN1 e a -> [(ASN1, e)] -> Either String a
runParseASN1_ ParseASN1 e a
f

-- | just like getNextContainer, except it doesn't throw an error if the container doesn't exists.
getNextContainerMaybe :: Monoid e => ASN1ConstructionType -> ParseASN1 e (Maybe [(ASN1, e)])
getNextContainerMaybe :: forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e (Maybe [(ASN1, e)])
getNextContainerMaybe ASN1ConstructionType
ty = do
    State e
list <- ParseASN1 e (State e)
forall e. ParseASN1 e (State e)
get
    case State e
list of
        State []        e
_                  -> Maybe [(ASN1, e)] -> ParseASN1 e (Maybe [(ASN1, e)])
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(ASN1, e)]
forall a. Maybe a
Nothing
        State ((ASN1
h,e
e):[(ASN1, e)]
l) e
es | ASN1
h ASN1 -> ASN1 -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
ty -> do let ([(ASN1, e)]
l1, State e
l2) = Int -> State e -> ([(ASN1, e)], State e)
forall e. Monoid e => Int -> State e -> ([(ASN1, e)], State e)
getConstructedEnd Int
0 ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
l (e
es e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e))
                                                 State e -> ParseASN1 e ()
forall e. State e -> ParseASN1 e ()
put State e
l2 ParseASN1 e ()
-> ParseASN1 e (Maybe [(ASN1, e)])
-> ParseASN1 e (Maybe [(ASN1, e)])
forall a b. ParseASN1 e a -> ParseASN1 e b -> ParseASN1 e b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe [(ASN1, e)] -> ParseASN1 e (Maybe [(ASN1, e)])
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ASN1, e)] -> Maybe [(ASN1, e)]
forall a. a -> Maybe a
Just [(ASN1, e)]
l1)
                           | Bool
otherwise     -> Maybe [(ASN1, e)] -> ParseASN1 e (Maybe [(ASN1, e)])
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(ASN1, e)]
forall a. Maybe a
Nothing

-- | just like onNextContainer, except it doesn't throw an error if the container doesn't exists.
onNextContainerMaybe :: Monoid e => ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe :: forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe ASN1ConstructionType
ty ParseASN1 e a
f = do
    Maybe [(ASN1, e)]
n <- ASN1ConstructionType -> ParseASN1 e (Maybe [(ASN1, e)])
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e (Maybe [(ASN1, e)])
getNextContainerMaybe ASN1ConstructionType
ty
    case Maybe [(ASN1, e)]
n of
        Just [(ASN1, e)]
l  -> (String -> ParseASN1 e (Maybe a))
-> (a -> ParseASN1 e (Maybe a))
-> Either String a
-> ParseASN1 e (Maybe a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParseASN1 e (Maybe a)
forall e a. String -> ParseASN1 e a
throwParseError (Maybe a -> ParseASN1 e (Maybe a)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> ParseASN1 e (Maybe a))
-> (a -> Maybe a) -> a -> ParseASN1 e (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) (Either String a -> ParseASN1 e (Maybe a))
-> Either String a -> ParseASN1 e (Maybe a)
forall a b. (a -> b) -> a -> b
$ ParseASN1 e a -> [(ASN1, e)] -> Either String a
forall e a.
Monoid e =>
ParseASN1 e a -> [(ASN1, e)] -> Either String a
runParseASN1_ ParseASN1 e a
f [(ASN1, e)]
l
        Maybe [(ASN1, e)]
Nothing -> Maybe a -> ParseASN1 e (Maybe a)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | returns if there's more elements in the stream.
hasNext :: ParseASN1 e Bool
hasNext :: forall e. ParseASN1 e Bool
hasNext = do State [(ASN1, e)]
l e
_ <- ParseASN1 e (State e)
forall e. ParseASN1 e (State e)
get; Bool -> ParseASN1 e Bool
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ParseASN1 e Bool)
-> ([(ASN1, e)] -> Bool) -> [(ASN1, e)] -> ParseASN1 e Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> ([(ASN1, e)] -> Bool) -> [(ASN1, e)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ASN1, e)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(ASN1, e)] -> ParseASN1 e Bool)
-> [(ASN1, e)] -> ParseASN1 e Bool
forall a b. (a -> b) -> a -> b
$ [(ASN1, e)]
l

-- | run a parser and return its result as well as all annotations that were used
withAnnotations :: Monoid e => ParseASN1 e a -> ParseASN1 e (a, e)
withAnnotations :: forall e a. Monoid e => ParseASN1 e a -> ParseASN1 e (a, e)
withAnnotations ParseASN1 e a
f = do
    State [(ASN1, e)]
l e
es <- ParseASN1 e (State e)
forall e. ParseASN1 e (State e)
get
    case ParseASN1 e a -> State e -> Either String (a, State e)
forall e a. ParseASN1 e a -> State e -> Either String (a, State e)
runP ParseASN1 e a
f ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
l e
forall a. Monoid a => a
mempty) of
        Left String
err                -> String -> ParseASN1 e (a, e)
forall e a. String -> ParseASN1 e a
throwParseError String
err
        Right (a
a, State [(ASN1, e)]
l' e
es') -> do State e -> ParseASN1 e ()
forall e. State e -> ParseASN1 e ()
put ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
l' (e
es e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
es'))
                                      (a, e) -> ParseASN1 e (a, e)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, e
es')

getConstructedEnd :: Monoid e => Int -> State e -> ([(ASN1, e)], State e)
getConstructedEnd :: forall e. Monoid e => Int -> State e -> ([(ASN1, e)], State e)
getConstructedEnd Int
_ xs :: State e
xs@(State [] e
_)                = ([], State e
xs)
getConstructedEnd Int
i (State (x :: (ASN1, e)
x@(Start ASN1ConstructionType
_, e
e):[(ASN1, e)]
xs) e
es) = let ([(ASN1, e)]
yz, State e
zs) = Int -> State e -> ([(ASN1, e)], State e)
forall e. Monoid e => Int -> State e -> ([(ASN1, e)], State e)
getConstructedEnd (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
xs (e
es e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e)) in ((ASN1, e)
x(ASN1, e) -> [(ASN1, e)] -> [(ASN1, e)]
forall a. a -> [a] -> [a]
:[(ASN1, e)]
yz, State e
zs)
getConstructedEnd Int
i (State (x :: (ASN1, e)
x@(End ASN1ConstructionType
_, e
e):[(ASN1, e)]
xs) e
es)
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = ([], [(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
xs (e
es e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e))
    | Bool
otherwise = let ([(ASN1, e)]
ys, State e
zs) = Int -> State e -> ([(ASN1, e)], State e)
forall e. Monoid e => Int -> State e -> ([(ASN1, e)], State e)
getConstructedEnd (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
xs (e
es e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e)) in ((ASN1, e)
x(ASN1, e) -> [(ASN1, e)] -> [(ASN1, e)]
forall a. a -> [a] -> [a]
:[(ASN1, e)]
ys, State e
zs)
getConstructedEnd Int
i (State (x :: (ASN1, e)
x@(ASN1
_, e
e):[(ASN1, e)]
xs) e
es)       = let ([(ASN1, e)]
ys, State e
zs) = Int -> State e -> ([(ASN1, e)], State e)
forall e. Monoid e => Int -> State e -> ([(ASN1, e)], State e)
getConstructedEnd Int
i ([(ASN1, e)] -> e -> State e
forall e. [(ASN1, e)] -> e -> State e
State [(ASN1, e)]
xs (e
es e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e)) in ((ASN1, e)
x(ASN1, e) -> [(ASN1, e)] -> [(ASN1, e)]
forall a. a -> [a] -> [a]
:[(ASN1, e)]
ys, State e
zs)