{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.Ledger.Binary.Decoding.Annotated (
Annotated (..),
ByteSpan (..),
Decoded (..),
annotationBytes,
annotatedDecoder,
slice,
decCBORAnnotated,
reAnnotate,
Annotator (..),
annotatorSlice,
withSlice,
FullByteString (..),
decodeAnnSet,
)
where
import Cardano.Ledger.Binary.Decoding.DecCBOR (DecCBOR (..))
import Cardano.Ledger.Binary.Decoding.Decoder (
Decoder,
allowTag,
decodeList,
decodeWithByteSpan,
fromPlainDecoder,
setTag,
whenDecoderVersionAtLeast,
)
import Cardano.Ledger.Binary.Encoding (EncCBOR, Version, serialize')
import Cardano.Ledger.Binary.Version (natVersion)
import Codec.CBOR.Read (ByteOffset)
import qualified Codec.Serialise as Serialise (decode)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Bifunctor (Bifunctor (first, second))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Kind (Type)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import qualified PlutusLedgerApi.V1 as PV1
slice :: BSL.ByteString -> ByteSpan -> BSL.ByteString
slice :: ByteString -> ByteSpan -> ByteString
slice ByteString
bytes (ByteSpan ByteOffset
start ByteOffset
end) =
ByteOffset -> ByteString -> ByteString
BSL.take (ByteOffset
end forall a. Num a => a -> a -> a
- ByteOffset
start) forall a b. (a -> b) -> a -> b
$ ByteOffset -> ByteString -> ByteString
BSL.drop ByteOffset
start ByteString
bytes
{-# INLINE slice #-}
data ByteSpan = ByteSpan !ByteOffset !ByteOffset
deriving (forall x. Rep ByteSpan x -> ByteSpan
forall x. ByteSpan -> Rep ByteSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ByteSpan x -> ByteSpan
$cfrom :: forall x. ByteSpan -> Rep ByteSpan x
Generic, Int -> ByteSpan -> ShowS
[ByteSpan] -> ShowS
ByteSpan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByteSpan] -> ShowS
$cshowList :: [ByteSpan] -> ShowS
show :: ByteSpan -> String
$cshow :: ByteSpan -> String
showsPrec :: Int -> ByteSpan -> ShowS
$cshowsPrec :: Int -> ByteSpan -> ShowS
Show)
instance ToJSON ByteSpan
data Annotated b a = Annotated {forall b a. Annotated b a -> b
unAnnotated :: !b, forall b a. Annotated b a -> a
annotation :: !a}
deriving (Annotated b a -> Annotated b a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall b a. (Eq b, Eq a) => Annotated b a -> Annotated b a -> Bool
/= :: Annotated b a -> Annotated b a -> Bool
$c/= :: forall b a. (Eq b, Eq a) => Annotated b a -> Annotated b a -> Bool
== :: Annotated b a -> Annotated b a -> Bool
$c== :: forall b a. (Eq b, Eq a) => Annotated b a -> Annotated b a -> Bool
Eq, Int -> Annotated b a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall b a. (Show b, Show a) => Int -> Annotated b a -> ShowS
forall b a. (Show b, Show a) => [Annotated b a] -> ShowS
forall b a. (Show b, Show a) => Annotated b a -> String
showList :: [Annotated b a] -> ShowS
$cshowList :: forall b a. (Show b, Show a) => [Annotated b a] -> ShowS
show :: Annotated b a -> String
$cshow :: forall b a. (Show b, Show a) => Annotated b a -> String
showsPrec :: Int -> Annotated b a -> ShowS
$cshowsPrec :: forall b a. (Show b, Show a) => Int -> Annotated b a -> ShowS
Show, forall a b. a -> Annotated b b -> Annotated b a
forall a b. (a -> b) -> Annotated b a -> Annotated b b
forall b a b. a -> Annotated b b -> Annotated b a
forall b a b. (a -> b) -> Annotated b a -> Annotated b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Annotated b b -> Annotated b a
$c<$ :: forall b a b. a -> Annotated b b -> Annotated b a
fmap :: forall a b. (a -> b) -> Annotated b a -> Annotated b b
$cfmap :: forall b a b. (a -> b) -> Annotated b a -> Annotated b b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b a x. Rep (Annotated b a) x -> Annotated b a
forall b a x. Annotated b a -> Rep (Annotated b a) x
$cto :: forall b a x. Rep (Annotated b a) x -> Annotated b a
$cfrom :: forall b a x. Annotated b a -> Rep (Annotated b a) x
Generic)
deriving anyclass (forall a. (a -> ()) -> NFData a
forall b a. (NFData b, NFData a) => Annotated b a -> ()
rnf :: Annotated b a -> ()
$crnf :: forall b a. (NFData b, NFData a) => Annotated b a -> ()
NFData, forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall b a.
(NoThunks b, NoThunks a) =>
Context -> Annotated b a -> IO (Maybe ThunkInfo)
forall b a.
(NoThunks b, NoThunks a) =>
Proxy (Annotated b a) -> String
showTypeOf :: Proxy (Annotated b a) -> String
$cshowTypeOf :: forall b a.
(NoThunks b, NoThunks a) =>
Proxy (Annotated b a) -> String
wNoThunks :: Context -> Annotated b a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall b a.
(NoThunks b, NoThunks a) =>
Context -> Annotated b a -> IO (Maybe ThunkInfo)
noThunks :: Context -> Annotated b a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall b a.
(NoThunks b, NoThunks a) =>
Context -> Annotated b a -> IO (Maybe ThunkInfo)
NoThunks)
instance Bifunctor Annotated where
first :: forall a b c. (a -> b) -> Annotated a c -> Annotated b c
first a -> b
f (Annotated a
b c
a) = forall b a. b -> a -> Annotated b a
Annotated (a -> b
f a
b) c
a
second :: forall b c a. (b -> c) -> Annotated a b -> Annotated a c
second = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
instance (Eq a, Ord b) => Ord (Annotated b a) where
compare :: Annotated b a -> Annotated b a -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall b a. Annotated b a -> b
unAnnotated
instance ToJSON b => ToJSON (Annotated b a) where
toJSON :: Annotated b a -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Annotated b a -> b
unAnnotated
toEncoding :: Annotated b a -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Annotated b a -> b
unAnnotated
instance FromJSON b => FromJSON (Annotated b ()) where
parseJSON :: Value -> Parser (Annotated b ())
parseJSON Value
j = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b a. b -> a -> Annotated b a
Annotated () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
j
annotatedDecoder :: Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder :: forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder Decoder s a
vd =
forall s a. Decoder s a -> Decoder s (a, ByteOffset, ByteOffset)
decodeWithByteSpan Decoder s a
vd forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(a
x, ByteOffset
start, ByteOffset
end) -> forall b a. b -> a -> Annotated b a
Annotated a
x (ByteOffset -> ByteOffset -> ByteSpan
ByteSpan ByteOffset
start ByteOffset
end)
{-# INLINE annotatedDecoder #-}
decCBORAnnotated :: DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated :: forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated = forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall a s. DecCBOR a => Decoder s a
decCBOR
{-# INLINE decCBORAnnotated #-}
annotationBytes :: Functor f => BSL.ByteString -> f ByteSpan -> f BS.ByteString
annotationBytes :: forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
annotationBytes ByteString
bytes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteSpan -> ByteString
slice ByteString
bytes)
reAnnotate :: EncCBOR a => Version -> Annotated a b -> Annotated a BS.ByteString
reAnnotate :: forall a b.
EncCBOR a =>
Version -> Annotated a b -> Annotated a ByteString
reAnnotate Version
version (Annotated a
x b
_) = forall b a. b -> a -> Annotated b a
Annotated a
x (forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
version a
x)
class Decoded t where
type BaseType t :: Type
recoverBytes :: t -> BS.ByteString
instance Decoded (Annotated b BS.ByteString) where
type BaseType (Annotated b BS.ByteString) = b
recoverBytes :: Annotated b ByteString -> ByteString
recoverBytes = forall b a. Annotated b a -> a
annotation
newtype FullByteString = Full BSL.ByteString
newtype Annotator a = Annotator {forall a. Annotator a -> FullByteString -> a
runAnnotator :: FullByteString -> a}
deriving newtype (Applicative Annotator
forall a. a -> Annotator a
forall a b. Annotator a -> Annotator b -> Annotator b
forall a b. Annotator a -> (a -> Annotator b) -> Annotator b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Annotator a
$creturn :: forall a. a -> Annotator a
>> :: forall a b. Annotator a -> Annotator b -> Annotator b
$c>> :: forall a b. Annotator a -> Annotator b -> Annotator b
>>= :: forall a b. Annotator a -> (a -> Annotator b) -> Annotator b
$c>>= :: forall a b. Annotator a -> (a -> Annotator b) -> Annotator b
Monad, Functor Annotator
forall a. a -> Annotator a
forall a b. Annotator a -> Annotator b -> Annotator a
forall a b. Annotator a -> Annotator b -> Annotator b
forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
forall a b c.
(a -> b -> c) -> Annotator a -> Annotator b -> Annotator c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Annotator a -> Annotator b -> Annotator a
$c<* :: forall a b. Annotator a -> Annotator b -> Annotator a
*> :: forall a b. Annotator a -> Annotator b -> Annotator b
$c*> :: forall a b. Annotator a -> Annotator b -> Annotator b
liftA2 :: forall a b c.
(a -> b -> c) -> Annotator a -> Annotator b -> Annotator c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Annotator a -> Annotator b -> Annotator c
<*> :: forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
$c<*> :: forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
pure :: forall a. a -> Annotator a
$cpure :: forall a. a -> Annotator a
Applicative, forall a b. a -> Annotator b -> Annotator a
forall a b. (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Annotator b -> Annotator a
$c<$ :: forall a b. a -> Annotator b -> Annotator a
fmap :: forall a b. (a -> b) -> Annotator a -> Annotator b
$cfmap :: forall a b. (a -> b) -> Annotator a -> Annotator b
Functor)
annotatorSlice ::
Decoder s (Annotator (BSL.ByteString -> a)) ->
Decoder s (Annotator a)
annotatorSlice :: forall s a.
Decoder s (Annotator (ByteString -> a)) -> Decoder s (Annotator a)
annotatorSlice Decoder s (Annotator (ByteString -> a))
dec = do
(Annotator (ByteString -> a)
k, Annotator ByteString
bytes) <- forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s (Annotator (ByteString -> a))
dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Annotator (ByteString -> a)
k forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
bytes
{-# INLINE annotatorSlice #-}
withSlice :: Decoder s a -> Decoder s (a, Annotator BSL.ByteString)
withSlice :: forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s a
dec = do
Annotated a
r ByteSpan
byteSpan <- forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder Decoder s a
dec
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, forall a. (FullByteString -> a) -> Annotator a
Annotator (\(Full ByteString
bsl) -> ByteString -> ByteSpan -> ByteString
slice ByteString
bsl ByteSpan
byteSpan))
{-# INLINE withSlice #-}
decodeAnnSet :: Ord t => Decoder s (Annotator t) -> Decoder s (Annotator (Set.Set t))
decodeAnnSet :: forall t s.
Ord t =>
Decoder s (Annotator t) -> Decoder s (Annotator (Set t))
decodeAnnSet Decoder s (Annotator t)
dec = do
forall s a. Version -> Decoder s a -> Decoder s ()
whenDecoderVersionAtLeast (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9) forall a b. (a -> b) -> a -> b
$
forall s. Word -> Decoder s ()
allowTag Word
setTag
[Annotator t]
xs <- forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator t)
dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Annotator t]
xs)
{-# INLINE decodeAnnSet #-}
instance DecCBOR (Annotator PV1.Data) where
decCBOR :: forall s. Decoder s (Annotator Data)
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall a s. Serialise a => Decoder s a
Serialise.decode
{-# INLINE decCBOR #-}