{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Cardano.Ledger.Alonzo.Binary.Annotator (
module Test.Cardano.Ledger.Mary.Binary.Annotator,
) where
import Cardano.Ledger.Alonzo.Scripts
import Cardano.Ledger.Alonzo.Tx hiding (wits)
import Cardano.Ledger.Alonzo.TxAuxData
import Cardano.Ledger.Alonzo.TxBody
import Cardano.Ledger.Alonzo.TxSeq.Internal
import Cardano.Ledger.Alonzo.TxWits
import Cardano.Ledger.Binary
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus
import Cardano.Ledger.Shelley.BlockChain (auxDataSeqDecoder)
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras as Map (fromElems)
import Data.Maybe.Strict (maybeToStrictMaybe)
import qualified Data.Sequence as Seq
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import Lens.Micro
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Mary.Binary.Annotator
import Test.Cardano.Ledger.Shelley.Arbitrary ()
instance Era era => DecCBOR (Annotator (TxDatsRaw era)) where
decCBOR :: forall s. Decoder s (Annotator (TxDatsRaw era))
decCBOR =
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
(forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
( forall s. Word -> Decoder s ()
allowTag Word
setTag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA
(forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall a s. DecCBOR a => Decoder s a
decCBOR)
(forall era. Map DataHash (Data era) -> TxDatsRaw era
TxDatsRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
Map.fromElems forall era. Data era -> DataHash
hashData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
)
(forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR) (forall era. Map DataHash (Data era) -> TxDatsRaw era
TxDatsRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
Map.fromElems forall era. Data era -> DataHash
hashData))
{-# INLINE decCBOR #-}
deriving via
Mem (TxDatsRaw era)
instance
Era era => DecCBOR (Annotator (TxDats era))
instance AlonzoEraScript era => DecCBOR (Annotator (RedeemersRaw era)) where
decCBOR :: forall s. Decoder s (Annotator (RedeemersRaw era))
decCBOR = do
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
(forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
( forall s. Decoder s TokenType
peekTokenType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TokenType
TypeMapLenIndef -> forall s. Decoder s (Annotator (RedeemersRaw era))
decodeMapRedeemers
TokenType
TypeMapLen -> forall s. Decoder s (Annotator (RedeemersRaw era))
decodeMapRedeemers
TokenType
_ -> Decoder s (Annotator (RedeemersRaw era))
decodeListRedeemers
)
( forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA
(forall s a. Decoder s a -> Decoder s [a]
decodeList forall s.
Decoder s (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
decodeAnnElement)
(forall era.
Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
RedeemersRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList)
)
where
decodeRedeemersWith :: Decoder
s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
-> Decoder s (Annotator (RedeemersRaw b))
decodeRedeemersWith Decoder
s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
nonEmptyDecoder =
forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA
Decoder
s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
nonEmptyDecoder
(forall era.
Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
RedeemersRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
decodeMapRedeemers :: Decoder s (Annotator (RedeemersRaw era))
decodeMapRedeemers = forall {b} {s}.
Ord (PlutusPurpose AsIx b) =>
Decoder
s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
-> Decoder s (Annotator (RedeemersRaw b))
decodeRedeemersWith forall a b. (a -> b) -> a -> b
$ do
(Int
_, [Annotator (PlutusPurpose AsIx era, (Data era, ExUnits))]
xs) <- forall s a b.
Monoid b =>
Decoder s (Maybe Int)
-> (a -> b -> b) -> (b -> Decoder s a) -> Decoder s (Int, b)
decodeListLikeWithCount forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef (:) forall a b. (a -> b) -> a -> b
$ \[Annotator (PlutusPurpose AsIx era, (Data era, ExUnits))]
_ -> do
PlutusPurpose AsIx era
ptr <- forall a s. DecCBOR a => Decoder s a
decCBOR
(Annotator (Data era)
annData, ExUnits
exUnits) <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (\Data era
d -> (PlutusPurpose AsIx era
ptr, (Data era
d, ExUnits
exUnits))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (Data era)
annData
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Annotator (PlutusPurpose AsIx era, (Data era, ExUnits))]
xs of
Maybe
(NonEmpty
(Annotator (PlutusPurpose AsIx era, (Data era, ExUnits))))
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected redeemers map to be non-empty"
Just NonEmpty (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
neList -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
neList
decodeListRedeemers :: Decoder s (Annotator (RedeemersRaw era))
decodeListRedeemers =
forall {b} {s}.
Ord (PlutusPurpose AsIx b) =>
Decoder
s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
-> Decoder s (Annotator (RedeemersRaw b))
decodeRedeemersWith (forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall s.
Decoder s (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
decodeAnnElement)
decodeAnnElement ::
forall s. Decoder s (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
decodeAnnElement :: forall s.
Decoder s (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
decodeAnnElement = do
(PlutusPurpose AsIx era
rdmrPtr, Annotator (Data era)
dat, ExUnits
ex) <- forall s.
Decoder s (PlutusPurpose AsIx era, Annotator (Data era), ExUnits)
decodeElement
let f :: a -> a -> b -> (a, (a, b))
f a
x a
y b
z = (a
x, (a
y, b
z))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
f PlutusPurpose AsIx era
rdmrPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (Data era)
dat forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ExUnits
ex
{-# INLINE decodeAnnElement #-}
decodeElement ::
forall s. Decoder s (PlutusPurpose AsIx era, Annotator (Data era), ExUnits)
decodeElement :: forall s.
Decoder s (PlutusPurpose AsIx era, Annotator (Data era), ExUnits)
decodeElement = do
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
Text
"Redeemer"
(\(PlutusPurpose AsIx era
rdmrPtr, Annotator (Data era)
_, ExUnits
_) -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. EncCBORGroup a => a -> Word
listLen PlutusPurpose AsIx era
rdmrPtr) forall a. Num a => a -> a -> a
+ Int
2)
forall a b. (a -> b) -> a -> b
$ (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBORGroup a => Decoder s a
decCBORGroup forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
{-# INLINE decodeElement #-}
{-# INLINE decCBOR #-}
deriving via
Mem (RedeemersRaw era)
instance
AlonzoEraScript era => DecCBOR (Annotator (Redeemers era))
deriving via
Mem (AlonzoTxWitsRaw era)
instance
( AlonzoEraScript era
, DecCBOR (Annotator (NativeScript era))
) =>
DecCBOR (Annotator (AlonzoTxWits era))
instance
(AlonzoEraScript era, DecCBOR (Annotator (NativeScript era))) =>
DecCBOR (Annotator (AlonzoTxWitsRaw era))
where
decCBOR :: forall s. Decoder s (Annotator (AlonzoTxWitsRaw era))
decCBOR =
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed
String
"AlonzoTxWits"
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall era. AlonzoEraScript era => AlonzoTxWitsRaw era
emptyTxWitsRaw)
Word -> Field (Annotator (AlonzoTxWitsRaw era))
txWitnessField
[]
where
txWitnessField :: Word -> Field (Annotator (AlonzoTxWitsRaw era))
txWitnessField :: Word -> Field (Annotator (AlonzoTxWitsRaw era))
txWitnessField Word
0 =
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
(\Set (WitVKey 'Witness)
x AlonzoTxWitsRaw era
wits -> AlonzoTxWitsRaw era
wits {atwrAddrTxWits :: Set (WitVKey 'Witness)
atwrAddrTxWits = Set (WitVKey 'Witness)
x})
( forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a b. (a -> b) -> a -> b
$
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
(forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
( forall s. Word -> Decoder s ()
allowTag Word
setTag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall a s. DecCBOR a => Decoder s a
decCBOR) (forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
)
(forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR) forall a. Ord a => [a] -> Set a
Set.fromList)
)
txWitnessField Word
1 =
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
forall era.
Map ScriptHash (Script era)
-> AlonzoTxWitsRaw era -> AlonzoTxWitsRaw era
addScriptsTxWitsRaw
(forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s (Annotator (Map ScriptHash (Script era)))
nativeScriptsDecoder)
txWitnessField Word
2 =
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
(\Set BootstrapWitness
x AlonzoTxWitsRaw era
wits -> AlonzoTxWitsRaw era
wits {atwrBootAddrTxWits :: Set BootstrapWitness
atwrBootAddrTxWits = Set BootstrapWitness
x})
( forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a b. (a -> b) -> a -> b
$
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
(forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
( forall s. Word -> Decoder s ()
allowTag Word
setTag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall a s. DecCBOR a => Decoder s a
decCBOR) (forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
)
(forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR) forall a. Ord a => [a] -> Set a
Set.fromList)
)
txWitnessField Word
3 = forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA forall era.
Map ScriptHash (Script era)
-> AlonzoTxWitsRaw era -> AlonzoTxWitsRaw era
addScriptsTxWitsRaw (forall era (l :: Language).
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
decodeAlonzoPlutusScript SLanguage 'PlutusV1
SPlutusV1)
txWitnessField Word
4 =
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
(\TxDats era
x AlonzoTxWitsRaw era
wits -> AlonzoTxWitsRaw era
wits {atwrDatsTxWits :: TxDats era
atwrDatsTxWits = TxDats era
x})
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
txWitnessField Word
5 = forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA (\Redeemers era
x AlonzoTxWitsRaw era
wits -> AlonzoTxWitsRaw era
wits {atwrRdmrsTxWits :: Redeemers era
atwrRdmrsTxWits = Redeemers era
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
txWitnessField Word
6 = forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA forall era.
Map ScriptHash (Script era)
-> AlonzoTxWitsRaw era -> AlonzoTxWitsRaw era
addScriptsTxWitsRaw (forall era (l :: Language).
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
decodeAlonzoPlutusScript SLanguage 'PlutusV2
SPlutusV2)
txWitnessField Word
7 = forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA forall era.
Map ScriptHash (Script era)
-> AlonzoTxWitsRaw era -> AlonzoTxWitsRaw era
addScriptsTxWitsRaw (forall era (l :: Language).
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
decodeAlonzoPlutusScript SLanguage 'PlutusV3
SPlutusV3)
txWitnessField Word
n = forall t. Word -> Field t
invalidField Word
n
{-# INLINE txWitnessField #-}
nativeScriptsDecoder :: Decoder s (Annotator (Map ScriptHash (Script era)))
nativeScriptsDecoder :: forall s. Decoder s (Annotator (Map ScriptHash (Script era)))
nativeScriptsDecoder =
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
(forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
( forall s. Word -> Decoder s ()
allowTag Word
setTag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall s. Decoder s (Annotator (ScriptHash, Script era))
pairDecoder) (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
)
(forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s [a]
decodeList forall s. Decoder s (Annotator (ScriptHash, Script era))
pairDecoder) forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList)
where
pairDecoder :: Decoder s (Annotator (ScriptHash, Script era))
pairDecoder :: forall s. Decoder s (Annotator (ScriptHash, Script era))
pairDecoder = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era. EraScript era => Script era -> (ScriptHash, Script era)
asHashedScriptPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => NativeScript era -> Script era
fromNativeScript) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
{-# INLINE decCBOR #-}
instance AlonzoEraScript era => DecCBOR (Annotator (AlonzoScript era)) where
decCBOR :: forall s. Decoder s (Annotator (AlonzoScript era))
decCBOR = forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"AlonzoScript" Word -> Decode 'Open (Annotator (AlonzoScript era))
decodeScript)
where
decodeAnnPlutus :: SLanguage l -> Decode 'Open (Annotator (AlonzoScript era))
decodeAnnPlutus SLanguage l
slang =
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. t -> Decode 'Open t
SumD forall era. PlutusScript era -> AlonzoScript era
PlutusScript) forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (forall era (l :: Language) s.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decoder s (PlutusScript era)
decodePlutusScript SLanguage l
slang))
{-# INLINE decodeAnnPlutus #-}
decodeScript :: Word -> Decode 'Open (Annotator (AlonzoScript era))
decodeScript :: Word -> Decode 'Open (Annotator (AlonzoScript era))
decodeScript = \case
Word
0 -> forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. t -> Decode 'Open t
SumD forall era. Timelock era -> AlonzoScript era
TimelockScript) forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
1 -> forall {era} {l :: Language}.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decode 'Open (Annotator (AlonzoScript era))
decodeAnnPlutus SLanguage 'PlutusV1
SPlutusV1
Word
2 -> forall {era} {l :: Language}.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decode 'Open (Annotator (AlonzoScript era))
decodeAnnPlutus SLanguage 'PlutusV2
SPlutusV2
Word
3 -> forall {era} {l :: Language}.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decode 'Open (Annotator (AlonzoScript era))
decodeAnnPlutus SLanguage 'PlutusV3
SPlutusV3
Word
n -> forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n
{-# INLINE decodeScript #-}
{-# INLINE decCBOR #-}
instance Era era => DecCBOR (Annotator (AlonzoTxAuxDataRaw era)) where
decCBOR :: forall s. Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decCBOR =
forall t s.
Decoder s t -> Decoder s t -> Decoder s t -> Decoder s t
decodeTxAuxDataByTokenType @(Annotator (AlonzoTxAuxDataRaw era))
forall s. Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeShelley
forall s. Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeAllegra
Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeAlonzo
where
decodeShelley :: Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeShelley =
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode
( forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (forall t (w :: Wrapped). t -> Decode w t
Emit forall era.
Map Word64 Metadatum
-> StrictSeq (Timelock era)
-> Map Language (NonEmpty PlutusBinary)
-> AlonzoTxAuxDataRaw era
AlonzoTxAuxDataRaw)
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (forall t (w :: Wrapped). t -> Decode w t
Emit forall a. StrictSeq a
StrictSeq.empty)
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (forall t (w :: Wrapped). t -> Decode w t
Emit forall k a. Map k a
Map.empty)
)
decodeAllegra :: Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeAllegra =
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode
( forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. t -> Decode ('Closed 'Dense) t
RecD forall era.
Map Word64 Metadatum
-> StrictSeq (Timelock era)
-> Map Language (NonEmpty PlutusBinary)
-> AlonzoTxAuxDataRaw era
AlonzoTxAuxDataRaw)
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D
(forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq forall a s. DecCBOR a => Decoder s a
decCBOR)
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (forall t (w :: Wrapped). t -> Decode w t
Emit forall k a. Map k a
Map.empty)
)
decodeAlonzo :: Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeAlonzo =
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
forall (x :: Density) t.
Word -> Decode ('Closed x) t -> Decode ('Closed x) t
TagD Word
259 forall a b. (a -> b) -> a -> b
$
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed String
"AlonzoTxAuxData" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall era. AlonzoTxAuxDataRaw era
emptyAlonzoTxAuxDataRaw) Word -> Field (Annotator (AlonzoTxAuxDataRaw era))
auxDataField []
auxDataField :: Word -> Field (Annotator (AlonzoTxAuxDataRaw era))
auxDataField :: Word -> Field (Annotator (AlonzoTxAuxDataRaw era))
auxDataField Word
0 = forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA (\Map Word64 Metadatum
x AlonzoTxAuxDataRaw era
ad -> AlonzoTxAuxDataRaw era
ad {atadrMetadata :: Map Word64 Metadatum
atadrMetadata = Map Word64 Metadatum
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
auxDataField Word
1 =
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
(\StrictSeq (Timelock era)
x AlonzoTxAuxDataRaw era
ad -> AlonzoTxAuxDataRaw era
ad {atadrTimelock :: StrictSeq (Timelock era)
atadrTimelock = forall era. AlonzoTxAuxDataRaw era -> StrictSeq (Timelock era)
atadrTimelock AlonzoTxAuxDataRaw era
ad forall a. Semigroup a => a -> a -> a
<> StrictSeq (Timelock era)
x})
(forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq forall a s. DecCBOR a => Decoder s a
decCBOR))
auxDataField Word
2 = forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA (forall era.
Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
addPlutusScripts Language
PlutusV1) (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (forall s. Language -> Decoder s ()
guardPlutus Language
PlutusV1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. DecCBOR a => Decoder s a
decCBOR))
auxDataField Word
3 = forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA (forall era.
Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
addPlutusScripts Language
PlutusV2) (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (forall s. Language -> Decoder s ()
guardPlutus Language
PlutusV2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. DecCBOR a => Decoder s a
decCBOR))
auxDataField Word
4 = forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA (forall era.
Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
addPlutusScripts Language
PlutusV3) (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (forall s. Language -> Decoder s ()
guardPlutus Language
PlutusV3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. DecCBOR a => Decoder s a
decCBOR))
auxDataField Word
n = forall t. Word -> Field t
invalidField Word
n
deriving via
Mem (AlonzoTxAuxDataRaw era)
instance
Era era => DecCBOR (Annotator (AlonzoTxAuxData era))
deriving via
Mem (AlonzoTxBodyRaw era)
instance
(Era era, DecCBOR (TxOut era), DecCBOR (TxCert era), DecCBOR (PParamsUpdate era)) =>
DecCBOR (Annotator (AlonzoTxBody era))
instance
(Era era, DecCBOR (TxOut era), DecCBOR (TxCert era), DecCBOR (PParamsUpdate era)) =>
DecCBOR (Annotator (AlonzoTxBodyRaw era))
where
decCBOR :: forall s. Decoder s (Annotator (AlonzoTxBodyRaw era))
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
instance
( AlonzoEraTx era
, DecCBOR (Annotator (TxAuxData era))
, DecCBOR (Annotator (TxBody era))
, DecCBOR (Annotator (TxWits era))
) =>
DecCBOR (Annotator (AlonzoTxSeq era))
where
decCBOR :: forall s. Decoder s (Annotator (AlonzoTxSeq era))
decCBOR = do
(Seq (Annotator (TxBody era))
bodies, Annotator ByteString
bodiesAnn) <- forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice forall a s. DecCBOR a => Decoder s a
decCBOR
(Seq (Annotator (TxWits era))
wits, Annotator ByteString
witsAnn) <- forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice forall a s. DecCBOR a => Decoder s a
decCBOR
let bodiesLength :: Int
bodiesLength = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (TxBody era))
bodies
inRange :: Int -> Bool
inRange Int
x = (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
x) Bool -> Bool -> Bool
&& (Int
x forall a. Ord a => a -> a -> Bool
<= (Int
bodiesLength forall a. Num a => a -> a -> a
- Int
1))
witsLength :: Int
witsLength = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (TxWits era))
wits
(Seq (Maybe (Annotator (TxAuxData era)))
auxData, Annotator ByteString
auxDataAnn) <- forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice forall a b. (a -> b) -> a -> b
$ do
IntMap (Annotator (TxAuxData era))
auxDataMap <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall a s. Int -> IntMap a -> Bool -> Decoder s (Seq (Maybe a))
auxDataSeqDecoder Int
bodiesLength IntMap (Annotator (TxAuxData era))
auxDataMap Bool
False
([Int]
isValIdxs, Annotator ByteString
isValAnn) <- forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice forall a s. DecCBOR a => Decoder s a
decCBOR
let validFlags :: Seq IsValid
validFlags = Int -> [Int] -> Seq IsValid
alignedValidFlags Int
bodiesLength [Int]
isValIdxs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(Int
bodiesLength forall a. Eq a => a -> a -> Bool
== Int
witsLength)
( forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
String
"different number of transaction bodies ("
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
bodiesLength
forall a. Semigroup a => a -> a -> a
<> String
") and witness sets ("
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
witsLength
forall a. Semigroup a => a -> a -> a
<> String
")"
)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Int -> Bool
inRange [Int]
isValIdxs)
( forall (m :: * -> *) a. MonadFail m => String -> m a
fail
( String
"Some IsValid index is not in the range: 0 .. "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
bodiesLength forall a. Num a => a -> a -> a
- Int
1)
forall a. [a] -> [a] -> [a]
++ String
", "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Int]
isValIdxs
)
)
let txns :: Annotator (StrictSeq (Tx era))
txns =
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$
forall a. Seq a -> StrictSeq a
StrictSeq.forceToStrict forall a b. (a -> b) -> a -> b
$
forall a b c d e.
(a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
Seq.zipWith4 forall era.
AlonzoEraTx era =>
Annotator (TxBody era)
-> Annotator (TxWits era)
-> IsValid
-> Maybe (Annotator (TxAuxData era))
-> Annotator (Tx era)
alonzoSegwitTx Seq (Annotator (TxBody era))
bodies Seq (Annotator (TxWits era))
wits Seq IsValid
validFlags Seq (Maybe (Annotator (TxAuxData era)))
auxData
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall era.
StrictSeq (Tx era)
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> AlonzoTxSeq era
AlonzoTxSeqRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (Tx era))
txns
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
bodiesAnn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
witsAnn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
auxDataAnn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
isValAnn
instance
( Typeable era
, Typeable (TxBody era)
, Typeable (TxWits era)
, Typeable (TxAuxData era)
, DecCBOR (Annotator (TxBody era))
, DecCBOR (Annotator (TxWits era))
, DecCBOR (Annotator (TxAuxData era))
) =>
DecCBOR (Annotator (AlonzoTx era))
where
decCBOR :: forall s. Decoder s (Annotator (AlonzoTx era))
decCBOR =
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. t -> Decode ('Closed 'Dense) t
RecD forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx)
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D
( forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe forall a s. DecCBOR a => Decoder s a
decCBOR
)
{-# INLINE decCBOR #-}
alonzoSegwitTx ::
AlonzoEraTx era =>
Annotator (TxBody era) ->
Annotator (TxWits era) ->
IsValid ->
Maybe (Annotator (TxAuxData era)) ->
Annotator (Tx era)
alonzoSegwitTx :: forall era.
AlonzoEraTx era =>
Annotator (TxBody era)
-> Annotator (TxWits era)
-> IsValid
-> Maybe (Annotator (TxAuxData era))
-> Annotator (Tx era)
alonzoSegwitTx Annotator (TxBody era)
txBodyAnn Annotator (TxWits era)
txWitsAnn IsValid
txIsValid Maybe (Annotator (TxAuxData era))
auxDataAnn = forall a. (FullByteString -> a) -> Annotator a
Annotator forall a b. (a -> b) -> a -> b
$ \FullByteString
bytes ->
let txBody :: TxBody era
txBody = forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxBody era)
txBodyAnn FullByteString
bytes
txWits :: TxWits era
txWits = forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxWits era)
txWitsAnn FullByteString
bytes
txAuxData :: StrictMaybe (TxAuxData era)
txAuxData = forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
bytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator (TxAuxData era))
auxDataAnn)
in forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
txBody
forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits era
txWits
forall a b. a -> (a -> b) -> b
& forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (TxAuxData era)
txAuxData
forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ IsValid
txIsValid