    -- |
    -- Module      : Data.ASN1.Parse
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- A parser combinator for ASN1 Stream.
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE CPP #-}
    module Data.ASN1.Parse
        ( ParseASN1
        -- * run
        , runParseASN1State
        , runParseASN1
        , throwParseError
        -- * combinators
        , onNextContainer
        , onNextContainerMaybe
        , getNextContainer
        , getNextContainerMaybe
        , getNext
        , getNextMaybe
        , hasNext
        , getObject
        , getMany
        ) where

    import Data.ASN1.Types
    import Data.ASN1.Stream
    import Control.Applicative
    import Control.Arrow (first)
    import Control.Monad (liftM2)
    #if MIN_VERSION_base(4,9,0)
    import Control.Monad.Fail
    #endif

    newtype ParseASN1 a = P { forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP :: [ASN1] -> Either String (a, [ASN1]) }

    instance Functor ParseASN1 where
        fmap :: forall a b. (a -> b) -> ParseASN1 a -> ParseASN1 b
    fmap a -> b
    f ParseASN1 a
    m = ([ASN1] -> Either String (b, [ASN1])) -> ParseASN1 b
    forall a. ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    P ((String -> Either String (b, [ASN1]))
    -> ((a, [ASN1]) -> Either String (b, [ASN1]))
    -> Either String (a, [ASN1])
    -> Either String (b, [ASN1])
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> Either String (b, [ASN1])
    forall a b. a -> Either a b
    Left ((b, [ASN1]) -> Either String (b, [ASN1])
    forall a b. b -> Either a b
    Right ((b, [ASN1]) -> Either String (b, [ASN1]))
    -> ((a, [ASN1]) -> (b, [ASN1]))
    -> (a, [ASN1])
    -> Either String (b, [ASN1])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> b) -> (a, [ASN1]) -> (b, [ASN1])
    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, [ASN1]) -> Either String (b, [ASN1]))
    -> ([ASN1] -> Either String (a, [ASN1]))
    -> [ASN1]
    -> Either String (b, [ASN1])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP ParseASN1 a
    m)
    instance Applicative ParseASN1 where
        pure :: forall a. a -> ParseASN1 a
    pure a
    a = ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    forall a. ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    P (([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a)
    -> ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    forall a b. (a -> b) -> a -> b
    $ \[ASN1]
    s -> (a, [ASN1]) -> Either String (a, [ASN1])
    forall a b. b -> Either a b
    Right (a
    a, [ASN1]
    s)
        <*> :: forall a b. ParseASN1 (a -> b) -> ParseASN1 a -> ParseASN1 b
    (<*>) ParseASN1 (a -> b)
    mf ParseASN1 a
    ma = ([ASN1] -> Either String (b, [ASN1])) -> ParseASN1 b
    forall a. ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    P (([ASN1] -> Either String (b, [ASN1])) -> ParseASN1 b)
    -> ([ASN1] -> Either String (b, [ASN1])) -> ParseASN1 b
    forall a b. (a -> b) -> a -> b
    $ \[ASN1]
    s ->
            case ParseASN1 (a -> b) -> [ASN1] -> Either String (a -> b, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP ParseASN1 (a -> b)
    mf [ASN1]
    s of
                Left String
    err      -> String -> Either String (b, [ASN1])
    forall a b. a -> Either a b
    Left String
    err
                Right (a -> b
    f, [ASN1]
    s2) ->
                    case ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP ParseASN1 a
    ma [ASN1]
    s2 of
                        Left String
    err      -> String -> Either String (b, [ASN1])
    forall a b. a -> Either a b
    Left String
    err
                        Right (a
    a, [ASN1]
    s3) -> (b, [ASN1]) -> Either String (b, [ASN1])
    forall a b. b -> Either a b
    Right (a -> b
    f a
    a, [ASN1]
    s3)
    instance Monad ParseASN1 where
        return :: forall a. a -> ParseASN1 a
    return a
    a    = a -> ParseASN1 a
    forall a. a -> ParseASN1 a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    a
        >>= :: forall a b. ParseASN1 a -> (a -> ParseASN1 b) -> ParseASN1 b
    (>>=) ParseASN1 a
    m1 a -> ParseASN1 b
    m2 = ([ASN1] -> Either String (b, [ASN1])) -> ParseASN1 b
    forall a. ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    P (([ASN1] -> Either String (b, [ASN1])) -> ParseASN1 b)
    -> ([ASN1] -> Either String (b, [ASN1])) -> ParseASN1 b
    forall a b. (a -> b) -> a -> b
    $ \[ASN1]
    s ->
            case ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP ParseASN1 a
    m1 [ASN1]
    s of
                Left String
    err      -> String -> Either String (b, [ASN1])
    forall a b. a -> Either a b
    Left String
    err
                Right (a
    a, [ASN1]
    s2) -> ParseASN1 b -> [ASN1] -> Either String (b, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP (a -> ParseASN1 b
    m2 a
    a) [ASN1]
    s2
    instance Alternative ParseASN1 where
        empty :: forall a. ParseASN1 a
    empty = ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    forall a. ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    P (([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a)
    -> ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    forall a b. (a -> b) -> a -> b
    $ \[ASN1]
    _ -> String -> Either String (a, [ASN1])
    forall a b. a -> Either a b
    Left String
    "empty Alternative"
        <|> :: forall a. ParseASN1 a -> ParseASN1 a -> ParseASN1 a
    (<|>) ParseASN1 a
    m1 ParseASN1 a
    m2 = ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    forall a. ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    P (([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a)
    -> ([ASN1] -> Either String (a, [ASN1])) -> ParseASN1 a
    forall a b. (a -> b) -> a -> b
    $ \[ASN1]
    s ->
            case ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP ParseASN1 a
    m1 [ASN1]
    s of
                Left String
    _        -> ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP ParseASN1 a
    m2 [ASN1]
    s
                Right (a
    a, [ASN1]
    s2) -> (a, [ASN1]) -> Either String (a, [ASN1])
    forall a b. b -> Either a b
    Right (a
    a, [ASN1]
    s2)
    #if MIN_VERSION_base(4,9,0)
    instance MonadFail ParseASN1 where
        fail :: forall a. String -> ParseASN1 a
    fail = String -> ParseASN1 a
    forall a. String -> ParseASN1 a
    throwParseError
    #endif

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

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

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

    -- | 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]
    s = ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP ParseASN1 a
    f [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 :: ParseASN1 a -> [ASN1] -> Either String a
    runParseASN1 :: forall a. ParseASN1 a -> [ASN1] -> Either String a
    runParseASN1 ParseASN1 a
    f [ASN1]
    s =
        case ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runP ParseASN1 a
    f [ASN1]
    s of
            Left String
    err      -> String -> Either String a
    forall a b. a -> Either a b
    Left String
    err
            Right (a
    o, []) -> a -> Either String a
    forall a b. b -> Either a b
    Right a
    o
            Right (a
    _, [ASN1]
    er) -> 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]
    er)

    -- | get next object
    getObject :: ASN1Object a => ParseASN1 a
    getObject :: forall a. ASN1Object a => ParseASN1 a
    getObject = do
        l <- ParseASN1 [ASN1]
    get
        case fromASN1 l of
            Left String
    err     -> String -> ParseASN1 a
    forall a. String -> ParseASN1 a
    throwParseError String
    err
            Right (a
    a,[ASN1]
    l2) -> [ASN1] -> ParseASN1 ()
    put [ASN1]
    l2 ParseASN1 () -> ParseASN1 a -> ParseASN1 a
    forall a b. ParseASN1 a -> ParseASN1 b -> ParseASN1 b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> a -> ParseASN1 a
    forall a. a -> ParseASN1 a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

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

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

    -- | get next element from the stream maybe
    getNextMaybe :: (ASN1 -> Maybe a) -> ParseASN1 (Maybe a)
    getNextMaybe :: forall a. (ASN1 -> Maybe a) -> ParseASN1 (Maybe a)
    getNextMaybe ASN1 -> Maybe a
    f = do
        list <- ParseASN1 [ASN1]
    get
        case list of
            []    -> Maybe a -> ParseASN1 (Maybe a)
    forall a. a -> ParseASN1 a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
            (ASN1
    h:[ASN1]
    l) -> let r :: Maybe a
    r = ASN1 -> Maybe a
    f ASN1
    h
                      in do case Maybe a
    r of
                                Maybe a
    Nothing -> [ASN1] -> ParseASN1 ()
    put [ASN1]
    list
                                Just a
    _  -> [ASN1] -> ParseASN1 ()
    put [ASN1]
    l
                            Maybe a -> ParseASN1 (Maybe a)
    forall a. a -> ParseASN1 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 :: ASN1ConstructionType -> ParseASN1 [ASN1]
    getNextContainer :: ASN1ConstructionType -> ParseASN1 [ASN1]
    getNextContainer ASN1ConstructionType
    ty = do
        list <- ParseASN1 [ASN1]
    get
        case list of
            []                    -> String -> ParseASN1 [ASN1]
    forall a. String -> ParseASN1 a
    throwParseError String
    "empty"
            (ASN1
    h:[ASN1]
    l) | ASN1
    h ASN1 -> ASN1 -> Bool
    forall a. Eq a => a -> a -> Bool
    == ASN1ConstructionType -> ASN1
    Start ASN1ConstructionType
    ty -> do let ([ASN1]
    l1, [ASN1]
    l2) = Int -> [ASN1] -> ([ASN1], [ASN1])
    getConstructedEnd Int
    0 [ASN1]
    l
                                        [ASN1] -> ParseASN1 ()
    put [ASN1]
    l2 ParseASN1 () -> ParseASN1 [ASN1] -> ParseASN1 [ASN1]
    forall a b. ParseASN1 a -> ParseASN1 b -> ParseASN1 b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [ASN1] -> ParseASN1 [ASN1]
    forall a. a -> ParseASN1 a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ASN1]
    l1
                  | Bool
    otherwise     -> String -> ParseASN1 [ASN1]
    forall a. String -> ParseASN1 a
    throwParseError String
    "not an expected container"

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

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

    -- | just like onNextContainer, except it doesn't throw an error if the container doesn't exists.
    onNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
    onNextContainerMaybe :: forall a.
    ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
    onNextContainerMaybe ASN1ConstructionType
    ty ParseASN1 a
    f = do
        n <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
    getNextContainerMaybe ASN1ConstructionType
    ty
        case n of
            Just [ASN1]
    l  -> (String -> ParseASN1 (Maybe a))
    -> (a -> ParseASN1 (Maybe a))
    -> Either String a
    -> ParseASN1 (Maybe a)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> ParseASN1 (Maybe a)
    forall a. String -> ParseASN1 a
    throwParseError (Maybe a -> ParseASN1 (Maybe a)
    forall a. a -> ParseASN1 a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> ParseASN1 (Maybe a))
    -> (a -> Maybe a) -> a -> ParseASN1 (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 (Maybe a))
    -> Either String a -> ParseASN1 (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ ParseASN1 a -> [ASN1] -> Either String a
    forall a. ParseASN1 a -> [ASN1] -> Either String a
    runParseASN1 ParseASN1 a
    f [ASN1]
    l
            Maybe [ASN1]
    Nothing -> Maybe a -> ParseASN1 (Maybe a)
    forall a. a -> ParseASN1 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 Bool
    hasNext :: ParseASN1 Bool
    hasNext = Bool -> Bool
    not (Bool -> Bool) -> ([ASN1] -> Bool) -> [ASN1] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ASN1] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([ASN1] -> Bool) -> ParseASN1 [ASN1] -> ParseASN1 Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParseASN1 [ASN1]
    get