{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE CPP #-}
module Data.ASN1.Get
( Result(..)
, Input
, Get
, runGetPos
, runGet
, getBytes
, getBytesCopy
, getWord8
) where
import Control.Applicative (Applicative(..),Alternative(..))
import Control.Monad (ap,MonadPlus(..))
import Data.Maybe (fromMaybe)
import Foreign
import qualified Data.ByteString as B
data Result r = Fail String
| Partial (B.ByteString -> Result r)
| Done r Position B.ByteString
instance Show r => Show (Result r) where
show :: Result r -> String
show (Fail String
msg) = String
"Fail " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
msg
show (Partial ByteString -> Result r
_) = String
"Partial _"
show (Done r
r Position
pos ByteString
bs) = String
"Done " String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> String
forall a. Show a => a -> String
show r
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show Position
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs
instance Functor Result where
fmap :: (a -> b) -> Result a -> Result b
fmap a -> b
_ (Fail String
msg) = String -> Result b
forall r. String -> Result r
Fail String
msg
fmap a -> b
f (Partial ByteString -> Result a
k) = (ByteString -> Result b) -> Result b
forall r. (ByteString -> Result r) -> Result r
Partial ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result a -> Result b)
-> (ByteString -> Result a) -> ByteString -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Result a
k)
fmap a -> b
f (Done a
r Position
p ByteString
bs) = b -> Position -> ByteString -> Result b
forall r. r -> Position -> ByteString -> Result r
Done (a -> b
f a
r) Position
p ByteString
bs
type Input = B.ByteString
type Buffer = Maybe B.ByteString
type Failure r = Input -> Buffer -> More -> Position -> String -> Result r
type Success a r = Input -> Buffer -> More -> Position -> a -> Result r
type Position = Word64
data More = Complete
| Incomplete (Maybe Int)
deriving (More -> More -> Bool
(More -> More -> Bool) -> (More -> More -> Bool) -> Eq More
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: More -> More -> Bool
$c/= :: More -> More -> Bool
== :: More -> More -> Bool
$c== :: More -> More -> Bool
Eq)
newtype Get a = Get
{ Get a
-> forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
unGet :: forall r. Input -> Buffer -> More -> Position -> Failure r -> Success a r -> Result r }
append :: Buffer -> Buffer -> Buffer
append :: Buffer -> Buffer -> Buffer
append Buffer
l Buffer
r = ByteString -> ByteString -> ByteString
B.append (ByteString -> ByteString -> ByteString)
-> Buffer -> Maybe (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Buffer
l Maybe (ByteString -> ByteString) -> Buffer -> Buffer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Buffer
r
{-# INLINE append #-}
bufferBytes :: Buffer -> B.ByteString
bufferBytes :: Buffer -> ByteString
bufferBytes = ByteString -> Buffer -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
B.empty
{-# INLINE bufferBytes #-}
instance Functor Get where
fmap :: (a -> b) -> Get a -> Get b
fmap a -> b
p Get a
m =
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success b r
-> Result r)
-> Get b
forall a.
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success b r
-> Result r)
-> Get b)
-> (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success b r
-> Result r)
-> Get b
forall a b. (a -> b) -> a -> b
$ \ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf Success b r
ks ->
let ks' :: ByteString -> Buffer -> More -> Position -> a -> Result r
ks' ByteString
s1 Buffer
b1 More
m1 Position
p1 a
a = Success b r
ks ByteString
s1 Buffer
b1 More
m1 Position
p1 (a -> b
p a
a)
in Get a
-> ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> (ByteString -> Buffer -> More -> Position -> a -> Result r)
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
unGet Get a
m ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf ByteString -> Buffer -> More -> Position -> a -> Result r
ks'
instance Applicative Get where
pure :: a -> Get a
pure = a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: Get (a -> b) -> Get a -> Get b
(<*>) = Get (a -> b) -> Get a -> Get b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Alternative Get where
empty :: Get a
empty = String -> Get a
forall a. String -> Get a
failDesc String
"empty"
<|> :: Get a -> Get a -> Get a
(<|>) = Get a -> Get a -> Get a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance Monad Get where
return :: a -> Get a
return a
a = (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
forall a.
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a)
-> (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
forall a b. (a -> b) -> a -> b
$ \ ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
_ Success a r
ks -> Success a r
ks ByteString
s0 Buffer
b0 More
m0 Position
p0 a
a
Get a
m >>= :: Get a -> (a -> Get b) -> Get b
>>= a -> Get b
g = (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success b r
-> Result r)
-> Get b
forall a.
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success b r
-> Result r)
-> Get b)
-> (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success b r
-> Result r)
-> Get b
forall a b. (a -> b) -> a -> b
$ \ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf Success b r
ks ->
let ks' :: ByteString -> Buffer -> More -> Position -> a -> Result r
ks' ByteString
s1 Buffer
b1 More
m1 Position
p1 a
a = Get b
-> ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success b r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
unGet (a -> Get b
g a
a) ByteString
s1 Buffer
b1 More
m1 Position
p1 Failure r
kf Success b r
ks
in Get a
-> ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> (ByteString -> Buffer -> More -> Position -> a -> Result r)
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
unGet Get a
m ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf ByteString -> Buffer -> More -> Position -> a -> Result r
ks'
#if MIN_VERSION_base(4,13,0)
instance MonadFail Get where
#endif
fail :: String -> Get a
fail = String -> Get a
forall a. String -> Get a
failDesc
instance MonadPlus Get where
mzero :: Get a
mzero = String -> Get a
forall a. String -> Get a
failDesc String
"mzero"
mplus :: Get a -> Get a -> Get a
mplus Get a
a Get a
b =
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
forall a.
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a)
-> (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf Success a r
ks ->
let kf' :: p -> Buffer -> More -> Position -> p -> Result r
kf' p
_ Buffer
b1 More
m1 Position
p1 p
_ = Get a
-> ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
unGet Get a
b (ByteString
s0 ByteString -> ByteString -> ByteString
`B.append` Buffer -> ByteString
bufferBytes Buffer
b1)
(Buffer
b0 Buffer -> Buffer -> Buffer
`append` Buffer
b1) More
m1 Position
p1 Failure r
kf Success a r
ks
in Get a
-> ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
unGet Get a
a ByteString
s0 (ByteString -> Buffer
forall a. a -> Maybe a
Just ByteString
B.empty) More
m0 Position
p0 Failure r
forall p p. p -> Buffer -> More -> Position -> p -> Result r
kf' Success a r
ks
put :: Position -> B.ByteString -> Get ()
put :: Position -> ByteString -> Get ()
put Position
pos ByteString
s = (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success () r
-> Result r)
-> Get ()
forall a.
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
Get (\ByteString
_ Buffer
b0 More
m Position
p0 Failure r
_ Success () r
k -> Success () r
k ByteString
s Buffer
b0 More
m (Position
p0Position -> Position -> Position
forall a. Num a => a -> a -> a
+Position
pos) ())
{-# INLINE put #-}
finalK :: B.ByteString -> t -> t1 -> Position -> r -> Result r
finalK :: ByteString -> t -> t1 -> Position -> r -> Result r
finalK ByteString
s t
_ t1
_ Position
p r
a = r -> Position -> ByteString -> Result r
forall r. r -> Position -> ByteString -> Result r
Done r
a Position
p ByteString
s
failK :: Failure a
failK :: Failure a
failK ByteString
_ Buffer
_ More
_ Position
p String
s = String -> Result a
forall r. String -> Result r
Fail (Position -> String
forall a. Show a => a -> String
show Position
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
runGetPos :: Position -> Get a -> B.ByteString -> Result a
runGetPos :: Position -> Get a -> ByteString -> Result a
runGetPos Position
pos Get a
m ByteString
str = Get a
-> ByteString
-> Buffer
-> More
-> Position
-> Failure a
-> Success a a
-> Result a
forall a.
Get a
-> forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
unGet Get a
m ByteString
str Buffer
forall a. Maybe a
Nothing (Maybe Int -> More
Incomplete Maybe Int
forall a. Maybe a
Nothing) Position
pos Failure a
forall a. Failure a
failK Success a a
forall t t1 r. ByteString -> t -> t1 -> Position -> r -> Result r
finalK
{-# INLINE runGetPos #-}
runGet :: Get a -> B.ByteString -> Result a
runGet :: Get a -> ByteString -> Result a
runGet = Position -> Get a -> ByteString -> Result a
forall a. Position -> Get a -> ByteString -> Result a
runGetPos Position
0
{-# INLINE runGet #-}
ensure :: Int -> Get B.ByteString
ensure :: Int -> Get ByteString
ensure Int
n = Int
n Int -> Get ByteString -> Get ByteString
`seq` (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString
forall a.
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString)
-> (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString
forall a b. (a -> b) -> a -> b
$ \ ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf Success ByteString r
ks ->
if ByteString -> Int
B.length ByteString
s0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
then Success ByteString r
ks ByteString
s0 Buffer
b0 More
m0 Position
p0 ByteString
s0
else Get ByteString
-> ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success ByteString r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
unGet (Get ()
demandInput Get () -> Get ByteString -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get ByteString
ensureRec Int
n) ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf Success ByteString r
ks
{-# INLINE ensure #-}
ensureRec :: Int -> Get B.ByteString
ensureRec :: Int -> Get ByteString
ensureRec Int
n = (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString
forall a.
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString)
-> (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf Success ByteString r
ks ->
if ByteString -> Int
B.length ByteString
s0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
then Success ByteString r
ks ByteString
s0 Buffer
b0 More
m0 Position
p0 ByteString
s0
else Get ByteString
-> ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success ByteString r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r
unGet (Get ()
demandInput Get () -> Get ByteString -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get ByteString
ensureRec Int
n) ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf Success ByteString r
ks
demandInput :: Get ()
demandInput :: Get ()
demandInput = (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success () r
-> Result r)
-> Get ()
forall a.
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success () r
-> Result r)
-> Get ())
-> (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success () r
-> Result r)
-> Get ()
forall a b. (a -> b) -> a -> b
$ \ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf Success () r
ks ->
case More
m0 of
More
Complete -> Failure r
kf ByteString
s0 Buffer
b0 More
m0 Position
p0 String
"too few bytes"
Incomplete Maybe Int
mb -> (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
Partial ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \ByteString
s ->
if ByteString -> Bool
B.null ByteString
s
then Failure r
kf ByteString
s0 Buffer
b0 More
m0 Position
p0 String
"too few bytes"
else let update :: Int -> Int
update Int
l = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
s
s1 :: ByteString
s1 = ByteString
s0 ByteString -> ByteString -> ByteString
`B.append` ByteString
s
b1 :: Buffer
b1 = Buffer
b0 Buffer -> Buffer -> Buffer
`append` ByteString -> Buffer
forall a. a -> Maybe a
Just ByteString
s
in Success () r
ks ByteString
s1 Buffer
b1 (Maybe Int -> More
Incomplete (Int -> Int
update (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Int
mb)) Position
p0 ()
failDesc :: String -> Get a
failDesc :: String -> Get a
failDesc String
err = (forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
forall a.
(forall r.
ByteString
-> Buffer
-> More
-> Position
-> Failure r
-> Success a r
-> Result r)
-> Get a
Get (\ByteString
s0 Buffer
b0 More
m0 Position
p0 Failure r
kf Success a r
_ -> Failure r
kf ByteString
s0 Buffer
b0 More
m0 Position
p0 (String
"Failed reading: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err))
getBytesCopy :: Int -> Get B.ByteString
getBytesCopy :: Int -> Get ByteString
getBytesCopy Int
n = do
ByteString
bs <- Int -> Get ByteString
getBytes Int
n
ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Get ByteString) -> ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString
B.copy ByteString
bs
getBytes :: Int -> Get B.ByteString
getBytes :: Int -> Get ByteString
getBytes Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
| Bool
otherwise = do
ByteString
s <- Int -> Get ByteString
ensure Int
n
let (ByteString
b1, ByteString
b2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
s
Position -> ByteString -> Get ()
put (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ByteString
b2
ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b1
getWord8 :: Get Word8
getWord8 :: Get Word8
getWord8 = do
ByteString
s <- Int -> Get ByteString
ensure Int
1
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
s of
Maybe (Word8, ByteString)
Nothing -> String -> Get Word8
forall a. HasCallStack => String -> a
error String
"getWord8: ensure internal error"
Just (Word8
h,ByteString
b2) -> Position -> ByteString -> Get ()
put Position
1 ByteString
b2 Get () -> Get Word8 -> Get Word8
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Get Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
h