{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
module Data.ASN1.Parse
( ParseASN1
, runParseASN1State
, runParseASN1
, throwParseError
, 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 { ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
runP :: [ASN1] -> Either String (a, [ASN1]) }
instance Functor ParseASN1 where
fmap :: (a -> b) -> ParseASN1 a -> ParseASN1 b
fmap f :: a -> b
f m :: 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 (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 :: a -> ParseASN1 a
pure a :: 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
$ \s :: [ASN1]
s -> (a, [ASN1]) -> Either String (a, [ASN1])
forall a b. b -> Either a b
Right (a
a, [ASN1]
s)
<*> :: ParseASN1 (a -> b) -> ParseASN1 a -> ParseASN1 b
(<*>) mf :: ParseASN1 (a -> b)
mf ma :: 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
$ \s :: [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 err :: String
err -> String -> Either String (b, [ASN1])
forall a b. a -> Either a b
Left String
err
Right (f :: a -> b
f, s2 :: [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 err :: String
err -> String -> Either String (b, [ASN1])
forall a b. a -> Either a b
Left String
err
Right (a :: a
a, s3 :: [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 :: a -> ParseASN1 a
return a :: a
a = a -> ParseASN1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
>>= :: ParseASN1 a -> (a -> ParseASN1 b) -> ParseASN1 b
(>>=) m1 :: ParseASN1 a
m1 m2 :: 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
$ \s :: [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 err :: String
err -> String -> Either String (b, [ASN1])
forall a b. a -> Either a b
Left String
err
Right (a :: a
a, s2 :: [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 :: 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
$ \_ -> String -> Either String (a, [ASN1])
forall a b. a -> Either a b
Left "empty Alternative"
<|> :: ParseASN1 a -> ParseASN1 a -> ParseASN1 a
(<|>) m1 :: ParseASN1 a
m1 m2 :: 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
$ \s :: [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 _ -> 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
a, s2 :: [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 :: 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
$ \stream :: [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 stream :: [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]) -> Either String ((), [ASN1])
forall a b. b -> Either a b
Right ((), [ASN1]
stream)
throwParseError :: String -> ParseASN1 a
throwParseError :: String -> ParseASN1 a
throwParseError s :: 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
$ \_ -> String -> Either String (a, [ASN1])
forall a b. a -> Either a b
Left String
s
runParseASN1State :: ParseASN1 a -> [ASN1] -> Either String (a,[ASN1])
runParseASN1State :: ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
runParseASN1State f :: ParseASN1 a
f s :: [ASN1]
s = ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
runP ParseASN1 a
f [ASN1]
s
runParseASN1 :: ParseASN1 a -> [ASN1] -> Either String a
runParseASN1 :: ParseASN1 a -> [ASN1] -> Either String a
runParseASN1 f :: ParseASN1 a
f s :: [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 err :: String
err -> String -> Either String a
forall a b. a -> Either a b
Left String
err
Right (o :: a
o, []) -> a -> Either String a
forall a b. b -> Either a b
Right a
o
Right (_, er :: [ASN1]
er) -> String -> Either String a
forall a b. a -> Either a b
Left ("runParseASN1: remaining state " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
er)
getObject :: ASN1Object a => ParseASN1 a
getObject :: ParseASN1 a
getObject = do
[ASN1]
l <- ParseASN1 [ASN1]
get
case [ASN1] -> Either String (a, [ASN1])
forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 [ASN1]
l of
Left err :: String
err -> String -> ParseASN1 a
forall a. String -> ParseASN1 a
throwParseError String
err
Right (a :: a
a,l2 :: [ASN1]
l2) -> [ASN1] -> ParseASN1 ()
put [ASN1]
l2 ParseASN1 () -> ParseASN1 a -> ParseASN1 a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> ParseASN1 a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
getNext :: ParseASN1 ASN1
getNext :: ParseASN1 ASN1
getNext = do
[ASN1]
list <- ParseASN1 [ASN1]
get
case [ASN1]
list of
[] -> String -> ParseASN1 ASN1
forall a. String -> ParseASN1 a
throwParseError "empty"
(h :: ASN1
h:l :: [ASN1]
l) -> [ASN1] -> ParseASN1 ()
put [ASN1]
l ParseASN1 () -> ParseASN1 ASN1 -> ParseASN1 ASN1
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ASN1 -> ParseASN1 ASN1
forall (m :: * -> *) a. Monad m => a -> m a
return ASN1
h
getMany :: ParseASN1 a -> ParseASN1 [a]
getMany :: ParseASN1 a -> ParseASN1 [a]
getMany getOne :: ParseASN1 a
getOne = do
Bool
next <- ParseASN1 Bool
hasNext
if Bool
next
then (a -> [a] -> [a]) -> ParseASN1 a -> ParseASN1 [a] -> ParseASN1 [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ParseASN1 a
getOne (ParseASN1 a -> ParseASN1 [a]
forall a. ParseASN1 a -> ParseASN1 [a]
getMany ParseASN1 a
getOne)
else [a] -> ParseASN1 [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getNextMaybe :: (ASN1 -> Maybe a) -> ParseASN1 (Maybe a)
getNextMaybe :: (ASN1 -> Maybe a) -> ParseASN1 (Maybe a)
getNextMaybe f :: ASN1 -> Maybe a
f = do
[ASN1]
list <- ParseASN1 [ASN1]
get
case [ASN1]
list of
[] -> Maybe a -> ParseASN1 (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
(h :: ASN1
h:l :: [ASN1]
l) -> let r :: Maybe a
r = ASN1 -> Maybe a
f ASN1
h
in do case Maybe a
r of
Nothing -> [ASN1] -> ParseASN1 ()
put [ASN1]
list
Just _ -> [ASN1] -> ParseASN1 ()
put [ASN1]
l
Maybe a -> ParseASN1 (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
r
getNextContainer :: ASN1ConstructionType -> ParseASN1 [ASN1]
getNextContainer :: ASN1ConstructionType -> ParseASN1 [ASN1]
getNextContainer ty :: ASN1ConstructionType
ty = do
[ASN1]
list <- ParseASN1 [ASN1]
get
case [ASN1]
list of
[] -> String -> ParseASN1 [ASN1]
forall a. String -> ParseASN1 a
throwParseError "empty"
(h :: ASN1
h:l :: [ASN1]
l) | ASN1
h ASN1 -> ASN1 -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
ty -> do let (l1 :: [ASN1]
l1, l2 :: [ASN1]
l2) = Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd 0 [ASN1]
l
[ASN1] -> ParseASN1 ()
put [ASN1]
l2 ParseASN1 () -> ParseASN1 [ASN1] -> ParseASN1 [ASN1]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ASN1] -> ParseASN1 [ASN1]
forall (m :: * -> *) a. Monad m => a -> m a
return [ASN1]
l1
| Bool
otherwise -> String -> ParseASN1 [ASN1]
forall a. String -> ParseASN1 a
throwParseError "not an expected container"
onNextContainer :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ty :: ASN1ConstructionType
ty f :: ParseASN1 a
f = ASN1ConstructionType -> ParseASN1 [ASN1]
getNextContainer ASN1ConstructionType
ty ParseASN1 [ASN1] -> ([ASN1] -> ParseASN1 a) -> ParseASN1 a
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 (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
getNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe ty :: ASN1ConstructionType
ty = do
[ASN1]
list <- ParseASN1 [ASN1]
get
case [ASN1]
list of
[] -> Maybe [ASN1] -> ParseASN1 (Maybe [ASN1])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [ASN1]
forall a. Maybe a
Nothing
(h :: ASN1
h:l :: [ASN1]
l) | ASN1
h ASN1 -> ASN1 -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
ty -> do let (l1 :: [ASN1]
l1, l2 :: [ASN1]
l2) = Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd 0 [ASN1]
l
[ASN1] -> ParseASN1 ()
put [ASN1]
l2 ParseASN1 ()
-> ParseASN1 (Maybe [ASN1]) -> ParseASN1 (Maybe [ASN1])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe [ASN1] -> ParseASN1 (Maybe [ASN1])
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe [ASN1]
forall a. Maybe a
Nothing
onNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
onNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
onNextContainerMaybe ty :: ASN1ConstructionType
ty f :: ParseASN1 a
f = do
Maybe [ASN1]
n <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe ASN1ConstructionType
ty
case Maybe [ASN1]
n of
Just l :: [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 (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
Nothing -> Maybe a -> ParseASN1 (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
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 (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