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 -> Word64 -> ParseState
ParseState [] (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) Word64
0
isEOC :: ASN1Header -> Bool
isEOC :: ASN1Header -> Bool
isEOC (ASN1Header ASN1Class
cl Int
t Bool
_ ASN1Length
_) = ASN1Class
cl ASN1Class -> ASN1Class -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Class
Universal Bool -> Bool -> Bool
&& Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
asn1LengthToConst :: ASN1Length -> Maybe Word64
asn1LengthToConst :: ASN1Length -> ConstructionEndAt
asn1LengthToConst (LenShort Int
n) = Word64 -> ConstructionEndAt
forall a. a -> Maybe a
Just (Word64 -> ConstructionEndAt) -> Word64 -> ConstructionEndAt
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
asn1LengthToConst (LenLong Int
_ Int
n) = Word64 -> ConstructionEndAt
forall a. a -> Maybe a
Just (Word64 -> ConstructionEndAt) -> Word64 -> ConstructionEndAt
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
asn1LengthToConst ASN1Length
LenIndefinite = ConstructionEndAt
forall a. Maybe a
Nothing
mplusEither :: Either b a -> (a -> Either b c) -> Either b c
mplusEither :: forall b a c. 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 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 ([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 Word64
pos), b
r) =
case [ConstructionEndAt]
stackEnd of
Just Word64
endPos:[ConstructionEndAt]
xs
| Word64
pos Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
endPos -> ASN1Error -> Either ASN1Error (ParseCursor, b)
forall a b. a -> Either a b
Left ASN1Error
StreamConstructionWrongSize
| Word64
pos Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
endPos -> (ParseCursor, b) -> Either ASN1Error (ParseCursor, b)
terminateAugment (([ASN1Event]
evs [ASN1Event] -> [ASN1Event] -> [ASN1Event]
forall a. [a] -> [a] -> [a]
++ [ASN1Event
ConstructionEnd], [ConstructionEndAt] -> ParseExpect -> Word64 -> ParseState
ParseState [ConstructionEndAt]
xs ParseExpect
pe Word64
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) Word64
pos) ByteString
bs =
case Maybe (ByteString -> Result ASN1Header)
-> Word64 -> ByteString -> Result ASN1Header
runGetHeader Maybe (ByteString -> Result ASN1Header)
cont Word64
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 -> Word64 -> 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) Word64
pos), ByteString
B.empty)
Done ASN1Header
hdr Word64
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 -> Word64 -> ParseState
ParseState [] (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) Word64
nPos), ByteString
remBytes)
Just Word64
_:[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 -> Word64 -> ParseState
ParseState [ConstructionEndAt]
newStackEnd (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) Word64
nPos)
, ByteString
remBytes)
| Bool
otherwise -> case ASN1Header
hdr of
(ASN1Header ASN1Class
_ Int
_ Bool
True ASN1Length
len) ->
let nEnd :: ConstructionEndAt
nEnd = (Word64
nPos Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+) (Word64 -> Word64) -> ConstructionEndAt -> ConstructionEndAt
forall a b. (a -> b) -> Maybe a -> Maybe b
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 -> Word64 -> 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) Word64
nPos)
, ByteString
remBytes)
(ASN1Header ASN1Class
_ Int
_ Bool
False ASN1Length
LenIndefinite) -> ASN1Error -> Either ASN1Error (ParseCursor, ByteString)
forall a b. a -> Either a b
Left ASN1Error
StreamInfinitePrimitive
(ASN1Header ASN1Class
_ Int
_ Bool
False ASN1Length
len) ->
let pLength :: Word64
pLength = ConstructionEndAt -> Word64
forall a. HasCallStack => Maybe a -> a
fromJust (ConstructionEndAt -> Word64) -> ConstructionEndAt -> Word64
forall a b. (a -> b) -> a -> b
$ ASN1Length -> ConstructionEndAt
asn1LengthToConst ASN1Length
len
in if Word64
pLength Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
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 -> Word64 -> ParseState
ParseState [ConstructionEndAt]
stackEnd (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) Word64
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 -> Word64 -> ParseState
ParseState [ConstructionEndAt]
stackEnd (Word64 -> Maybe (ByteString -> Result ByteString) -> ParseExpect
ExpectPrimitive Word64
pLength Maybe (ByteString -> Result ByteString)
forall a. Maybe a
Nothing) Word64
nPos)
, ByteString
remBytes)
go (ParseState [ConstructionEndAt]
stackEnd (ExpectPrimitive Word64
len Maybe (ByteString -> Result ByteString)
cont) Word64
pos) ByteString
bs =
case Maybe (ByteString -> Result ByteString)
-> Word64 -> Word64 -> ByteString -> Result ByteString
forall {a}.
Integral a =>
Maybe (ByteString -> Result ByteString)
-> a -> Word64 -> ByteString -> Result ByteString
runGetPrimitive Maybe (ByteString -> Result ByteString)
cont Word64
len Word64
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 -> Word64 -> ParseState
ParseState [ConstructionEndAt]
stackEnd (Word64 -> Maybe (ByteString -> Result ByteString) -> ParseExpect
ExpectPrimitive Word64
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) Word64
pos), ByteString
B.empty)
Done ByteString
p Word64
nPos ByteString
remBytes -> (ParseCursor, ByteString)
-> Either ASN1Error (ParseCursor, ByteString)
forall a b. b -> Either a b
Right (([ByteString -> ASN1Event
Primitive ByteString
p], [ConstructionEndAt] -> ParseExpect -> Word64 -> ParseState
ParseState [ConstructionEndAt]
stackEnd (Maybe (ByteString -> Result ASN1Header) -> ParseExpect
ExpectHeader Maybe (ByteString -> Result ASN1Header)
forall a. Maybe a
Nothing) Word64
nPos), ByteString
remBytes)
runGetHeader :: Maybe (ByteString -> Result ASN1Header)
-> Word64 -> ByteString -> Result ASN1Header
runGetHeader Maybe (ByteString -> Result ASN1Header)
Nothing = \Word64
pos -> Word64 -> Get ASN1Header -> ByteString -> Result ASN1Header
forall a. Word64 -> Get a -> ByteString -> Result a
runGetPos Word64
pos Get ASN1Header
getHeader
runGetHeader (Just ByteString -> Result ASN1Header
f) = (ByteString -> Result ASN1Header)
-> Word64 -> ByteString -> Result ASN1Header
forall a b. a -> b -> a
const ByteString -> Result ASN1Header
f
runGetPrimitive :: Maybe (ByteString -> Result ByteString)
-> a -> Word64 -> ByteString -> Result ByteString
runGetPrimitive Maybe (ByteString -> Result ByteString)
Nothing a
n = \Word64
pos -> Word64 -> Get ByteString -> ByteString -> Result ByteString
forall a. Word64 -> Get a -> ByteString -> Result a
runGetPos Word64
pos (Int -> Get ByteString
getBytes (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
runGetPrimitive (Just ByteString -> Result ByteString
f) a
_ = (ByteString -> Result ByteString)
-> Word64 -> 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) Word64
_) = 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 :: forall a.
(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