diff --git a/Data/ASN1/Parse.hs b/Data/ASN1/Parse.hs new file mode 100644 --- /dev/null +++ b/Data/ASN1/Parse.hs @@ -0,0 +1,116 @@ +-- | +-- Module : Data.ASN1.Parse +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Data.ASN1.Parse + ( ParseASN1 + , runParseASN1State + , runParseASN1 + , onNextContainer + , onNextContainerMaybe + , getNextContainer + , getNextContainerMaybe + , getNext + , getNextMaybe + , hasNext + , getObject + , getMany + ) where + +import Data.ASN1.Types +import Data.ASN1.Stream +import Control.Monad.State +import Control.Monad.Error +import Control.Applicative (Applicative, (<$>)) + +-- | Parse ASN1 Monad +newtype ParseASN1 a = P { runP :: ErrorT String (State [ASN1]) a } + deriving (Functor, Applicative, Monad, MonadError String) + +-- | 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 f s = + case runState (runErrorT (runP f)) s of + (Left err, _) -> Left err + (Right r, l) -> Right (r,l) + +-- | run the parse monad over a stream and returns the result. +runParseASN1 :: ParseASN1 a -> [ASN1] -> Either String a +runParseASN1 f s = either Left (Right . fst) $ runParseASN1State f s + +-- | get next object +getObject :: ASN1Object a => ParseASN1 a +getObject = do + l <- P (lift get) + case fromASN1 l of + Left err -> throwError err + Right (a,l2) -> P (lift (put l2)) >> return a + +-- | get next element from the stream +getNext :: ParseASN1 ASN1 +getNext = do + list <- P (lift get) + case list of + [] -> throwError "empty" + (h:l) -> P (lift (put l)) >> return h + +-- | get many elements until there's nothing left +getMany :: ParseASN1 a -> ParseASN1 [a] +getMany getOne = do + next <- 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 f = do + list <- P (lift get) + case list of + [] -> return Nothing + (h:l) -> let r = f h + in do case r of + Nothing -> P (lift (put list)) + Just _ -> P (lift (put l)) + return r + +-- | get next container of specified type and return all its elements +getNextContainer :: ASN1ConstructionType -> ParseASN1 [ASN1] +getNextContainer ty = do + list <- P (lift get) + case list of + [] -> throwError "empty" + (h:l) | h == Start ty -> do let (l1, l2) = getConstructedEnd 0 l + P (lift $ put l2) >> return l1 + | otherwise -> throwError "not an expected container" + + +-- | run a function of the next elements of a container of specified type +onNextContainer :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a +onNextContainer ty f = getNextContainer ty >>= either throwError return . runParseASN1 f + +-- | just like getNextContainer, except it doesn't throw an error if the container doesn't exists. +getNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 (Maybe [ASN1]) +getNextContainerMaybe ty = do + list <- P (lift get) + case list of + [] -> return Nothing + (h:l) | h == Start ty -> do let (l1, l2) = getConstructedEnd 0 l + P (lift $ put l2) >> return (Just l1) + | otherwise -> return Nothing + +-- | just like onNextContainer, except it doens't throw an error if the container doesn't exists. +onNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a) +onNextContainerMaybe ty f = do + n <- getNextContainerMaybe ty + case n of + Just l -> either throwError (return . Just) $ runParseASN1 f l + Nothing -> return Nothing + +-- | returns if there's more elements in the stream. +hasNext :: ParseASN1 Bool +hasNext = not . null <$> P (lift get) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2010-2013 Vincent Hanquez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/asn1-parse.cabal b/asn1-parse.cabal new file mode 100644 --- /dev/null +++ b/asn1-parse.cabal @@ -0,0 +1,30 @@ +Name: asn1-parse +Version: 0.8.0 +Description: Simple monadic parser for ASN1 stream types, when ASN1 pattern matching is not convenient. +License: BSD3 +License-file: LICENSE +Copyright: Vincent Hanquez +Author: Vincent Hanquez +Maintainer: Vincent Hanquez +Synopsis: Simple monadic parser for ASN1 stream types. +Build-Type: Simple +Category: Data +stability: experimental +Cabal-Version: >=1.6 +Homepage: http://github.com/vincenthz/hs-asn1 + +Library + Build-Depends: base >= 3 && < 5 + , bytestring + , text >= 0.11 + , mtl + , time + , asn1-types >= 0.2 && < 0.3 + , asn1-encoding >= 0.8 + + Exposed-modules: Data.ASN1.Parse + ghc-options: -Wall + +source-repository head + type: git + location: git://github.com/vincenthz/hs-asn1