module Data.ASN1.BinaryEncoding.Parse
(
runParseState
, isParseDone
, newParseState
, ParseState
, ParseCursor
, parseLBS
, parseBS
) where
import Control.Arrow (first)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ASN1.Error
import Data.ASN1.Types
import Data.ASN1.Types.Lowlevel
import Data.ASN1.Get
import Data.ASN1.Serialize
import Data.Word
import Data.Maybe (fromJust)
type ConstructionEndAt = Maybe Word64
data ParseExpect = (Maybe (B.ByteString -> Result ASN1Header))
| ExpectPrimitive Word64 (Maybe (B.ByteString -> Result ByteString))
type ParsePosition = Word64
data ParseState = ParseState [ConstructionEndAt] ParseExpect ParsePosition
newParseState :: ParseState
newParseState :: ParseState
newParseState = [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState [] (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) ParsePosition
0
isEOC :: ASN1Header -> Bool
isEOC :: ASN1Header -> Bool
isEOC (ASN1Header ASN1Class
cl ASN1Tag
t Bool
_ ASN1Length
_) = ASN1Class
cl ASN1Class -> ASN1Class -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Class
Universal Bool -> Bool -> Bool
&& ASN1Tag
t ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Tag
0
asn1LengthToConst :: ASN1Length -> Maybe Word64
asn1LengthToConst :: ASN1Length -> ConstructionEndAt
asn1LengthToConst (LenShort ASN1Tag
n) = ParsePosition -> ConstructionEndAt
forall a. a -> Maybe a
Just (ParsePosition -> ConstructionEndAt)
-> ParsePosition -> ConstructionEndAt
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> ParsePosition
forall a b. (Integral a, Num b) => a -> b
fromIntegral ASN1Tag
n
asn1LengthToConst (LenLong ASN1Tag
_ ASN1Tag
n) = ParsePosition -> ConstructionEndAt
forall a. a -> Maybe a
Just (ParsePosition -> ConstructionEndAt)
-> ParsePosition -> ConstructionEndAt
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> ParsePosition
forall a b. (Integral a, Num b) => a -> b
fromIntegral ASN1Tag
n
asn1LengthToConst ASN1Length
LenIndefinite = ConstructionEndAt
forall a. Maybe a
Nothing
mplusEither :: Either b a -> (a -> Either b c) -> Either b c
mplusEither :: Either b a -> (a -> Either b c) -> Either b c
mplusEither (Left b
e) a -> Either b c
_ = b -> Either b c
forall a b. a -> Either a b
Left b
e
mplusEither (Right a
e) a -> Either b c
f = a -> Either b c
f a
e
type ParseCursor = ([ASN1Event], ParseState)
runParseState :: ParseState
-> ByteString
-> Either ASN1Error ParseCursor
runParseState :: ParseState -> ByteString -> Either ASN1Error ParseCursor
runParseState = ParseState -> ByteString -> Either ASN1Error ParseCursor
loop
where
loop :: ParseState -> ByteString -> Either ASN1Error ParseCursor
loop ParseState
iniState ByteString
bs
| ByteString -> Bool
B.null ByteString
bs = (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall b. (ParseCursor, b) -> Either ASN1Error (ParseCursor, b)
terminateAugment (([], ParseState
iniState), ByteString
bs) Either ASN1Error (ParseCursor, ByteString)
-> ((ParseCursor, ByteString) -> Either ASN1Error ParseCursor)
-> Either ASN1Error ParseCursor
forall b a c. Either b a -> (a -> Either b c) -> Either b c
`mplusEither` (ParseCursor -> Either ASN1Error ParseCursor
forall a b. b -> Either a b
Right (ParseCursor -> Either ASN1Error ParseCursor)
-> ((ParseCursor, ByteString) -> ParseCursor)
-> (ParseCursor, ByteString)
-> Either ASN1Error ParseCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseCursor, ByteString) -> ParseCursor
forall a b. (a, b) -> a
fst)
| Bool
otherwise = ParseState
-> ByteString -> Either ASN1Error (ParseCursor, ByteString)
go ParseState
iniState ByteString
bs Either ASN1Error (ParseCursor, ByteString)
-> ((ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString))
-> Either ASN1Error (ParseCursor, ByteString)
forall b a c. Either b a -> (a -> Either b c) -> Either b c
`mplusEither` (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall b. (ParseCursor, b) -> Either ASN1Error (ParseCursor, b)
terminateAugment
Either ASN1Error (ParseCursor, ByteString)
-> ((ParseCursor, ByteString) -> Either ASN1Error ParseCursor)
-> Either ASN1Error ParseCursor
forall b a c. Either b a -> (a -> Either b c) -> Either b c
`mplusEither` \(([ASN1Event]
evs, ParseState
newState), ByteString
nbs) -> ParseState -> ByteString -> Either ASN1Error ParseCursor
loop ParseState
newState ByteString
nbs
Either ASN1Error ParseCursor
-> (ParseCursor -> Either ASN1Error ParseCursor)
-> Either ASN1Error ParseCursor
forall b a c. Either b a -> (a -> Either b c) -> Either b c
`mplusEither` (ParseCursor -> Either ASN1Error ParseCursor
forall a b. b -> Either a b
Right (ParseCursor -> Either ASN1Error ParseCursor)
-> (ParseCursor -> ParseCursor)
-> ParseCursor
-> Either ASN1Error ParseCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ASN1Event] -> [ASN1Event]) -> ParseCursor -> ParseCursor
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([ASN1Event]
evs [ASN1Event] -> [ASN1Event] -> [ASN1Event]
forall a. [a] -> [a] -> [a]
++))
terminateAugment :: (ParseCursor, b) -> Either ASN1Error (ParseCursor, b)
terminateAugment ret :: (ParseCursor, b)
ret@(([ASN1Event]
evs, ParseState [ConstructionEndAt]
stackEnd ParseExpect
pe ParsePosition
pos), b
r) =
case [ConstructionEndAt]
stackEnd of
Just ParsePosition
endPos:[ConstructionEndAt]
xs
| ParsePosition
pos ParsePosition -> ParsePosition -> Bool
forall a. Ord a => a -> a -> Bool
> ParsePosition
endPos -> ASN1Error -> Either ASN1Error (ParseCursor, b)
forall a b. a -> Either a b
Left ASN1Error
StreamConstructionWrongSize
| ParsePosition
pos ParsePosition -> ParsePosition -> Bool
forall a. Eq a => a -> a -> Bool
== ParsePosition
endPos -> (ParseCursor, b) -> Either ASN1Error (ParseCursor, b)
terminateAugment (([ASN1Event]
evs [ASN1Event] -> [ASN1Event] -> [ASN1Event]
forall a. [a] -> [a] -> [a]
++ [ASN1Event
ConstructionEnd], [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState [ConstructionEndAt]
xs ParseExpect
pe ParsePosition
pos), b
r)
| Bool
otherwise -> (ParseCursor, b) -> Either ASN1Error (ParseCursor, b)
forall a b. b -> Either a b
Right (ParseCursor, b)
ret
[ConstructionEndAt]
_ -> (ParseCursor, b) -> Either ASN1Error (ParseCursor, b)
forall a b. b -> Either a b
Right (ParseCursor, b)
ret
go :: ParseState -> ByteString -> Either ASN1Error (ParseCursor, ByteString)
go :: ParseState
-> ByteString -> Either ASN1Error (ParseCursor, ByteString)
go (ParseState [ConstructionEndAt]
stackEnd (ExpectHeader Maybe (ByteString -> Result ASN1Header)
cont) ParsePosition
pos) ByteString
bs =
case Maybe (ByteString -> Result ASN1Header)
-> ParsePosition -> ByteString -> Result ASN1Header
runGetHeader Maybe (ByteString -> Result ASN1Header)
cont ParsePosition
pos ByteString
bs of
Fail String
s -> ASN1Error -> Either ASN1Error (ParseCursor, ByteString)
forall a b. a -> Either a b
Left (ASN1Error -> Either ASN1Error (ParseCursor, ByteString))
-> ASN1Error -> Either ASN1Error (ParseCursor, ByteString)
forall a b. (a -> b) -> a -> b
$ String -> ASN1Error
ParsingHeaderFail String
s
Partial ByteString -> Result ASN1Header
f -> (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall a b. b -> Either a b
Right (([], [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState [ConstructionEndAt]
stackEnd (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader (Maybe (ByteString -> Result ASN1Header) -> ParseExpect)
-> Maybe (ByteString -> Result ASN1Header) -> ParseExpect
forall a b. (a -> b) -> a -> b
$ (ByteString -> Result ASN1Header)
-> Maybe (ByteString -> Result ASN1Header)
forall a. a -> Maybe a
Just ByteString -> Result ASN1Header
f) ParsePosition
pos), ByteString
B.empty)
Done ASN1Header
hdr ParsePosition
nPos ByteString
remBytes
| ASN1Header -> Bool
isEOC ASN1Header
hdr -> case [ConstructionEndAt]
stackEnd of
[] -> (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall a b. b -> Either a b
Right (([], [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState [] (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) ParsePosition
nPos), ByteString
remBytes)
Just ParsePosition
_:[ConstructionEndAt]
_ -> ASN1Error -> Either ASN1Error (ParseCursor, ByteString)
forall a b. a -> Either a b
Left ASN1Error
StreamUnexpectedEOC
ConstructionEndAt
Nothing:[ConstructionEndAt]
newStackEnd -> (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall a b. b -> Either a b
Right ( ( [ASN1Event
ConstructionEnd]
, [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState [ConstructionEndAt]
newStackEnd (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) ParsePosition
nPos)
, ByteString
remBytes)
| Bool
otherwise -> case ASN1Header
hdr of
(ASN1Header ASN1Class
_ ASN1Tag
_ Bool
True ASN1Length
len) ->
let nEnd :: ConstructionEndAt
nEnd = (ParsePosition
nPos ParsePosition -> ParsePosition -> ParsePosition
forall a. Num a => a -> a -> a
+) (ParsePosition -> ParsePosition)
-> ConstructionEndAt -> ConstructionEndAt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ASN1Length -> ConstructionEndAt
asn1LengthToConst ASN1Length
len
in (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall a b. b -> Either a b
Right ( ( [ASN1Header -> ASN1Event
Header ASN1Header
hdr,ASN1Event
ConstructionBegin]
, [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState (ConstructionEndAt
nEndConstructionEndAt -> [ConstructionEndAt] -> [ConstructionEndAt]
forall a. a -> [a] -> [a]
:[ConstructionEndAt]
stackEnd) (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) ParsePosition
nPos)
, ByteString
remBytes)
(ASN1Header ASN1Class
_ ASN1Tag
_ Bool
False ASN1Length
LenIndefinite) -> ASN1Error -> Either ASN1Error (ParseCursor, ByteString)
forall a b. a -> Either a b
Left ASN1Error
StreamInfinitePrimitive
(ASN1Header ASN1Class
_ ASN1Tag
_ Bool
False ASN1Length
len) ->
let pLength :: ParsePosition
pLength = ConstructionEndAt -> ParsePosition
forall a. HasCallStack => Maybe a -> a
fromJust (ConstructionEndAt -> ParsePosition)
-> ConstructionEndAt -> ParsePosition
forall a b. (a -> b) -> a -> b
$ ASN1Length -> ConstructionEndAt
asn1LengthToConst ASN1Length
len
in if ParsePosition
pLength ParsePosition -> ParsePosition -> Bool
forall a. Eq a => a -> a -> Bool
== ParsePosition
0
then (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall a b. b -> Either a b
Right ( ( [ASN1Header -> ASN1Event
Header ASN1Header
hdr,ByteString -> ASN1Event
Primitive ByteString
B.empty]
, [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState [ConstructionEndAt]
stackEnd (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) ParsePosition
nPos)
, ByteString
remBytes)
else (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall a b. b -> Either a b
Right ( ( [ASN1Header -> ASN1Event
Header ASN1Header
hdr]
, [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState [ConstructionEndAt]
stackEnd (ParsePosition
-> Maybe (ByteString -> Result ByteString) -> ParseExpect
ExpectPrimitive ParsePosition
pLength Maybe (ByteString -> Result ByteString)
forall a. Maybe a
Nothing) ParsePosition
nPos)
, ByteString
remBytes)
go (ParseState [ConstructionEndAt]
stackEnd (ExpectPrimitive ParsePosition
len Maybe (ByteString -> Result ByteString)
cont) ParsePosition
pos) ByteString
bs =
case Maybe (ByteString -> Result ByteString)
-> ParsePosition
-> ParsePosition
-> ByteString
-> Result ByteString
forall a.
Integral a =>
Maybe (ByteString -> Result ByteString)
-> a -> ParsePosition -> ByteString -> Result ByteString
runGetPrimitive Maybe (ByteString -> Result ByteString)
cont ParsePosition
len ParsePosition
pos ByteString
bs of
Fail String
_ -> ASN1Error -> Either ASN1Error (ParseCursor, ByteString)
forall a b. a -> Either a b
Left ASN1Error
ParsingPartial
Partial ByteString -> Result ByteString
f -> (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall a b. b -> Either a b
Right (([], [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState [ConstructionEndAt]
stackEnd (ParsePosition
-> Maybe (ByteString -> Result ByteString) -> ParseExpect
ExpectPrimitive ParsePosition
len (Maybe (ByteString -> Result ByteString) -> ParseExpect)
-> Maybe (ByteString -> Result ByteString) -> ParseExpect
forall a b. (a -> b) -> a -> b
$ (ByteString -> Result ByteString)
-> Maybe (ByteString -> Result ByteString)
forall a. a -> Maybe a
Just ByteString -> Result ByteString
f) ParsePosition
pos), ByteString
B.empty)
Done ByteString
p ParsePosition
nPos ByteString
remBytes -> (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall a b. b -> Either a b
Right (([ByteString -> ASN1Event
Primitive ByteString
p], [ConstructionEndAt] -> ParseExpect -> ParsePosition -> ParseState
ParseState [ConstructionEndAt]
stackEnd (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) ParsePosition
nPos), ByteString
remBytes)
runGetHeader :: Maybe (ByteString -> Result ASN1Header)
-> ParsePosition -> ByteString -> Result ASN1Header
runGetHeader Maybe (ByteString -> Result ASN1Header)
Nothing = \ParsePosition
pos -> ParsePosition -> Get ASN1Header -> ByteString -> Result ASN1Header
forall a. ParsePosition -> Get a -> ByteString -> Result a
runGetPos ParsePosition
pos Get ASN1Header
getHeader
runGetHeader (Just ByteString -> Result ASN1Header
f) = (ByteString -> Result ASN1Header)
-> ParsePosition -> ByteString -> Result ASN1Header
forall a b. a -> b -> a
const ByteString -> Result ASN1Header
f
runGetPrimitive :: Maybe (ByteString -> Result ByteString)
-> a -> ParsePosition -> ByteString -> Result ByteString
runGetPrimitive Maybe (ByteString -> Result ByteString)
Nothing a
n = \ParsePosition
pos -> ParsePosition -> Get ByteString -> ByteString -> Result ByteString
forall a. ParsePosition -> Get a -> ByteString -> Result a
runGetPos ParsePosition
pos (ASN1Tag -> Get ByteString
getBytes (ASN1Tag -> Get ByteString) -> ASN1Tag -> Get ByteString
forall a b. (a -> b) -> a -> b
$ a -> ASN1Tag
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
runGetPrimitive (Just ByteString -> Result ByteString
f) a
_ = (ByteString -> Result ByteString)
-> ParsePosition -> ByteString -> Result ByteString
forall a b. a -> b -> a
const ByteString -> Result ByteString
f
isParseDone :: ParseState -> Bool
isParseDone :: ParseState -> Bool
isParseDone (ParseState [] (ExpectHeader Maybe (ByteString -> Result ASN1Header)
Nothing) ParsePosition
_) = Bool
True
isParseDone ParseState
_ = Bool
False
parseLBS :: L.ByteString -> Either ASN1Error [ASN1Event]
parseLBS :: ByteString -> Either ASN1Error [ASN1Event]
parseLBS ByteString
lbs = (([[ASN1Event]], ParseState)
-> ByteString -> Either ASN1Error ([[ASN1Event]], ParseState))
-> ([[ASN1Event]], ParseState)
-> [ByteString]
-> Either ASN1Error ([[ASN1Event]], ParseState)
forall a.
(a -> ByteString -> Either ASN1Error a)
-> a -> [ByteString] -> Either ASN1Error a
foldrEither ([[ASN1Event]], ParseState)
-> ByteString -> Either ASN1Error ([[ASN1Event]], ParseState)
process ([], ParseState
newParseState) (ByteString -> [ByteString]
L.toChunks ByteString
lbs) Either ASN1Error ([[ASN1Event]], ParseState)
-> (([[ASN1Event]], ParseState) -> Either ASN1Error [ASN1Event])
-> Either ASN1Error [ASN1Event]
forall b a c. Either b a -> (a -> Either b c) -> Either b c
`mplusEither` ([[ASN1Event]], ParseState) -> Either ASN1Error [ASN1Event]
forall a. ([[a]], ParseState) -> Either ASN1Error [a]
onSuccess
where
onSuccess :: ([[a]], ParseState) -> Either ASN1Error [a]
onSuccess ([[a]]
allEvs, ParseState
finalState)
| ParseState -> Bool
isParseDone ParseState
finalState = [a] -> Either ASN1Error [a]
forall a b. b -> Either a b
Right ([a] -> Either ASN1Error [a]) -> [a] -> Either ASN1Error [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
allEvs
| Bool
otherwise = ASN1Error -> Either ASN1Error [a]
forall a b. a -> Either a b
Left ASN1Error
ParsingPartial
process :: ([[ASN1Event]], ParseState) -> ByteString -> Either ASN1Error ([[ASN1Event]], ParseState)
process :: ([[ASN1Event]], ParseState)
-> ByteString -> Either ASN1Error ([[ASN1Event]], ParseState)
process ([[ASN1Event]]
pevs, ParseState
cState) ByteString
bs = ParseState -> ByteString -> Either ASN1Error ParseCursor
runParseState ParseState
cState ByteString
bs Either ASN1Error ParseCursor
-> (ParseCursor -> Either ASN1Error ([[ASN1Event]], ParseState))
-> Either ASN1Error ([[ASN1Event]], ParseState)
forall b a c. Either b a -> (a -> Either b c) -> Either b c
`mplusEither` \([ASN1Event]
es, ParseState
cState') -> ([[ASN1Event]], ParseState)
-> Either ASN1Error ([[ASN1Event]], ParseState)
forall a b. b -> Either a b
Right ([ASN1Event]
es [ASN1Event] -> [[ASN1Event]] -> [[ASN1Event]]
forall a. a -> [a] -> [a]
: [[ASN1Event]]
pevs, ParseState
cState')
foldrEither :: (a -> ByteString -> Either ASN1Error a) -> a -> [ByteString] -> Either ASN1Error a
foldrEither :: (a -> ByteString -> Either ASN1Error a)
-> a -> [ByteString] -> Either ASN1Error a
foldrEither a -> ByteString -> Either ASN1Error a
_ a
acc [] = a -> Either ASN1Error a
forall a b. b -> Either a b
Right a
acc
foldrEither a -> ByteString -> Either ASN1Error a
f a
acc (ByteString
x:[ByteString]
xs) = a -> ByteString -> Either ASN1Error a
f a
acc ByteString
x Either ASN1Error a
-> (a -> Either ASN1Error a) -> Either ASN1Error a
forall b a c. Either b a -> (a -> Either b c) -> Either b c
`mplusEither` \a
nacc -> (a -> ByteString -> Either ASN1Error a)
-> a -> [ByteString] -> Either ASN1Error a
forall a.
(a -> ByteString -> Either ASN1Error a)
-> a -> [ByteString] -> Either ASN1Error a
foldrEither a -> ByteString -> Either ASN1Error a
f a
nacc [ByteString]
xs
parseBS :: ByteString -> Either ASN1Error [ASN1Event]
parseBS :: ByteString -> Either ASN1Error [ASN1Event]
parseBS ByteString
bs = ParseState -> ByteString -> Either ASN1Error ParseCursor
runParseState ParseState
newParseState ByteString
bs Either ASN1Error ParseCursor
-> (ParseCursor -> Either ASN1Error [ASN1Event])
-> Either ASN1Error [ASN1Event]
forall b a c. Either b a -> (a -> Either b c) -> Either b c
`mplusEither` ParseCursor -> Either ASN1Error [ASN1Event]
forall b. (b, ParseState) -> Either ASN1Error b
onSuccess
where onSuccess :: (b, ParseState) -> Either ASN1Error b
onSuccess (b
evs, ParseState
pstate)
| ParseState -> Bool
isParseDone ParseState
pstate = b -> Either ASN1Error b
forall a b. b -> Either a b
Right b
evs
| Bool
otherwise = ASN1Error -> Either ASN1Error b
forall a b. a -> Either a b
Left ASN1Error
ParsingPartial