From ed16f3dc2bc662065c46bc86ca7fc48f00ec285e Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 5 Sep 2025 19:00:35 +0200 Subject: [PATCH 1/9] cardano-rpc | Add decoded PlutusData to Datum in proto definition --- .../utxorpc/v1alpha/cardano/cardano.proto | 47 ++++++++++++++++++- .../Cardano/Rpc/Server/Internal/Orphans.hs | 25 ++++++++++ 2 files changed, 71 insertions(+), 1 deletion(-) diff --git a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto index b33b3ce5b3..f714653c94 100644 --- a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto +++ b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto @@ -16,9 +16,9 @@ message AddressArray { repeated bytes items = 1; } -// TODO u5c: replaced plutus_data with just bytes message Datum { bytes hash = 1; // Hash of this datum as seen on-chain + PlutusData payload = 2; // Parsed Plutus data payload bytes original_cbor = 3; // Original cbor-encoded data as seen on-chain } @@ -38,6 +38,51 @@ message MultiAsset { repeated Asset assets = 2; // List of custom assets. } +// Represents a constructor for Plutus data in Cardano. +message Constr { + uint32 tag = 1; + uint64 any_constructor = 2; + repeated PlutusData fields = 3; +} + +// Represents a big integer for Plutus data in Cardano. +message BigInt { + oneof big_int { + int64 int = 1; + bytes big_u_int = 2; + bytes big_n_int = 3; + } +} + + +// Represents a key-value pair for Plutus data in Cardano. +message PlutusDataPair { + PlutusData key = 1; // Key of the pair. + PlutusData value = 2; // Value of the pair. +} + +// Represents a Plutus data item in Cardano. +message PlutusData { + oneof plutus_data { + Constr constr = 2; // Constructor. + PlutusDataMap map = 3; // Map of Plutus data. + BigInt big_int = 4; // Big integer. + bytes bounded_bytes = 5; // Bounded bytes. + PlutusDataArray array = 6; // Array of Plutus data. + } +} + +// Represents a map of Plutus data in Cardano. +message PlutusDataMap { + repeated PlutusDataPair pairs = 1; // List of key-value pairs. +} + +// Represents an array of Plutus data in Cardano. +message PlutusDataArray { + repeated PlutusData items = 1; // List of Plutus data items. +} + + // Represents a script in Cardano. // TODO u5c: removed native script representation, added plutus_v4 message Script { diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs index 3f727afd26..9bd553f7d9 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLists #-} @@ -89,6 +90,28 @@ instance Inject (ReferenceScript era) (Proto UtxoRpc.Script) where PlutusScript PlutusScriptV4 ps -> defMessage & #plutusV4 .~ serialiseToRawBytes ps +instance Inject ScriptData (Proto UtxoRpc.PlutusData) where + inject = \case + ScriptDataBytes bs -> + defMessage & #boundedBytes .~ bs + ScriptDataNumber int -> + defMessage & #bigInt . #int .~ fromIntegral int + ScriptDataList sds -> + defMessage & #array . #items .~ map inject sds + ScriptDataMap elements -> do + let pairs = + elements <&> \(k, v) -> + defMessage + & #key .~ inject k + & #value .~ inject v + defMessage & #map . #pairs .~ pairs + ScriptDataConstructor tag args -> do + let constr = + defMessage + & #tag .~ fromIntegral tag + & #fields .~ map inject args + defMessage & #constr .~ constr + instance IsCardanoEra era => Inject (UTxO era) [Proto UtxoRpc.AnyUtxoData] where inject utxo = toList utxo <&> \(txIn, TxOut addressInEra txOutValue datum script) -> do @@ -112,10 +135,12 @@ instance IsCardanoEra era => Inject (UTxO era) [Proto UtxoRpc.AnyUtxoData] where TxOutDatumHash _ scriptDataHash -> defMessage & #hash .~ serialiseToRawBytes scriptDataHash + & #maybe'payload .~ Nothing -- we don't have it & #originalCbor .~ mempty -- we don't have it TxOutDatumInline _ hashableScriptData -> defMessage & #hash .~ serialiseToRawBytes (hashScriptDataBytes hashableScriptData) + & #payload .~ inject (getScriptData hashableScriptData) & #originalCbor .~ getOriginalScriptDataBytes hashableScriptData protoTxOut = From 002e39c7ca43f174d27e2f32bd90ab45ec08c69d Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 8 Sep 2025 16:09:05 +0200 Subject: [PATCH 2/9] cardano-rpc | Add native script deserialised form --- .../utxorpc/v1alpha/cardano/cardano.proto | 25 ++++++++++++++++- .../Cardano/Rpc/Server/Internal/Orphans.hs | 27 ++++++++++++++++--- 2 files changed, 47 insertions(+), 5 deletions(-) diff --git a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto index f714653c94..34625824b7 100644 --- a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto +++ b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto @@ -38,6 +38,29 @@ message MultiAsset { repeated Asset assets = 2; // List of custom assets. } +// Represents a native script in Cardano. +message NativeScript { + oneof native_script { + bytes script_pubkey = 1; // Script based on an address key hash. + NativeScriptList script_all = 2; // Script that requires all nested scripts to be satisfied. + NativeScriptList script_any = 3; // Script that requires any of the nested scripts to be satisfied. + ScriptNOfK script_n_of_k = 4; // Script that requires k out of n nested scripts to be satisfied. + uint64 invalid_before = 5; // Slot number before which the script is invalid. + uint64 invalid_hereafter = 6; // Slot number after which the script is invalid. + } +} + +// Represents a list of native scripts. +message NativeScriptList { + repeated NativeScript items = 1; // List of native scripts. +} + +// Represents a "k out of n" native script. +message ScriptNOfK { + uint32 k = 1; // The number of required satisfied scripts. + repeated NativeScript scripts = 2; // List of native scripts. +} + // Represents a constructor for Plutus data in Cardano. message Constr { uint32 tag = 1; @@ -87,7 +110,7 @@ message PlutusDataArray { // TODO u5c: removed native script representation, added plutus_v4 message Script { oneof script { - bytes native = 1; // Native script. + NativeScript native = 1; // Native script. bytes plutus_v1 = 2; // Plutus V1 script. bytes plutus_v2 = 3; // Plutus V2 script. bytes plutus_v3 = 4; // Plutus V3 script. diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs index 9bd553f7d9..d190a5f89d 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs @@ -12,12 +12,12 @@ module Cardano.Rpc.Server.Internal.Orphans () where import Cardano.Api.Address +import Cardano.Api.Block (SlotNo (..)) import Cardano.Api.Era import Cardano.Api.Error import Cardano.Api.Ledger qualified as L import Cardano.Api.Plutus import Cardano.Api.Pretty -import Cardano.Api.Serialise.Cbor import Cardano.Api.Serialise.Raw import Cardano.Api.Tx import Cardano.Api.Value @@ -79,8 +79,8 @@ instance Inject (ReferenceScript era) (Proto UtxoRpc.Script) where inject ReferenceScriptNone = defMessage inject (ReferenceScript _ (ScriptInAnyLang _ script)) = case script of - SimpleScript _ -> - defMessage & #native .~ serialiseToCBOR script + SimpleScript ss -> + defMessage & #native .~ inject ss PlutusScript PlutusScriptV1 ps -> defMessage & #plutusV1 .~ serialiseToRawBytes ps PlutusScript PlutusScriptV2 ps -> @@ -90,6 +90,25 @@ instance Inject (ReferenceScript era) (Proto UtxoRpc.Script) where PlutusScript PlutusScriptV4 ps -> defMessage & #plutusV4 .~ serialiseToRawBytes ps +instance Inject SimpleScript (Proto UtxoRpc.NativeScript) where + inject = \case + RequireSignature paymentKeyHash -> + defMessage & #scriptPubkey .~ serialiseToRawBytes paymentKeyHash + RequireTimeBefore (SlotNo slotNo) -> + defMessage & #invalidHereafter .~ slotNo + RequireTimeAfter (SlotNo slotNo) -> + defMessage & #invalidBefore .~ slotNo + RequireAllOf scripts -> + defMessage & #scriptAll . #items .~ map inject scripts + RequireAnyOf scripts -> + defMessage & #scriptAny . #items .~ map inject scripts + RequireMOf k scripts -> do + let nScriptsOf = + defMessage + & #k .~ fromIntegral k + & #scripts .~ map inject scripts + defMessage & #scriptNOfK .~ nScriptsOf + instance Inject ScriptData (Proto UtxoRpc.PlutusData) where inject = \case ScriptDataBytes bs -> @@ -122,7 +141,7 @@ instance IsCardanoEra era => Inject (UTxO era) [Proto UtxoRpc.AnyUtxoData] where toList policyAssets <&> \(assetName, Quantity qty) -> do defMessage & #name .~ serialiseToRawBytes assetName - -- we don't have access to info it the coin was minted in the transaction, + -- we don't have access to info if the coin was minted in the transaction, -- maybe we should add it later & #maybe'mintCoin .~ Nothing & #outputCoin .~ fromIntegral qty From 5089af6fbc44a2685cd9f2df2cb3167e886c78eb Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 9 Sep 2025 17:08:35 +0200 Subject: [PATCH 3/9] cardano-rpc | Add conversion Integer -> proto.BigInt --- cardano-api/src/Cardano/Api/HasTypeProxy.hs | 10 ++++++++++ cardano-api/src/Cardano/Api/Serialise/Raw.hs | 19 ++++++++++++++++++- .../Cardano/Api/Serialise/SerialiseUsing.hs | 6 ++++++ .../utxorpc/v1alpha/cardano/cardano.proto | 2 +- .../Cardano/Rpc/Server/Internal/Orphans.hs | 16 +++++++++++++--- 5 files changed, 48 insertions(+), 5 deletions(-) diff --git a/cardano-api/src/Cardano/Api/HasTypeProxy.hs b/cardano-api/src/Cardano/Api/HasTypeProxy.hs index 7606261220..4d8c0b8b23 100644 --- a/cardano-api/src/Cardano/Api/HasTypeProxy.hs +++ b/cardano-api/src/Cardano/Api/HasTypeProxy.hs @@ -13,10 +13,12 @@ module Cardano.Api.HasTypeProxy where import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as BSL import Data.Kind (Constraint, Type) import Data.Proxy (Proxy (..)) import Data.Typeable (Typeable) import Data.Word (Word16, Word8) +import Numeric.Natural (Natural) class Typeable t => HasTypeProxy t where -- | A family of singleton types used in this API to indicate which type to @@ -35,10 +37,18 @@ instance HasTypeProxy Word16 where data AsType Word16 = AsWord16 proxyToAsType _ = AsWord16 +instance HasTypeProxy Natural where + data AsType Natural = AsNatural + proxyToAsType _ = AsNatural + instance HasTypeProxy BS.ByteString where data AsType BS.ByteString = AsByteString proxyToAsType _ = AsByteString +instance HasTypeProxy BSL.ByteString where + data AsType BSL.ByteString = AsByteStringLazy + proxyToAsType _ = AsByteStringLazy + data FromSomeType (c :: Type -> Constraint) b where FromSomeType :: c a => AsType a -> (a -> b) -> FromSomeType c b diff --git a/cardano-api/src/Cardano/Api/Serialise/Raw.hs b/cardano-api/src/Cardano/Api/Serialise/Raw.hs index 0ad204498d..4f1a3205ff 100644 --- a/cardano-api/src/Cardano/Api/Serialise/Raw.hs +++ b/cardano-api/src/Cardano/Api/Serialise/Raw.hs @@ -26,13 +26,17 @@ import Data.Bits (Bits (..)) import Data.ByteString qualified as BS import Data.ByteString.Base16 qualified as Base16 import Data.ByteString.Builder qualified as BSB -import Data.ByteString.Char8 as BSC +import Data.ByteString.Char8 (ByteString) +import Data.ByteString.Char8 qualified as BSC +import Data.ByteString.Lazy qualified as BSL import Data.Data (typeRep) +import Data.Foldable qualified as F import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Typeable (TypeRep, Typeable) import Data.Word (Word16, Word8) +import Numeric.Natural (Natural) class (HasTypeProxy a, Typeable a) => SerialiseAsRawBytes a where serialiseToRawBytes :: a -> ByteString @@ -60,10 +64,23 @@ instance SerialiseAsRawBytes Word16 where throwError . SerialiseAsRawBytesError $ "Cannot decode Word16 from (hex): " <> BSC.unpack (Base16.encode bs) +instance SerialiseAsRawBytes Natural where + serialiseToRawBytes 0 = BS.singleton 0x00 + serialiseToRawBytes n = BS.toStrict . BSB.toLazyByteString $ go n mempty + where + go 0 acc = acc + go x acc = go (x `shiftR` 8) (BSB.word8 (fromIntegral (x .&. 0xFF)) <> acc) + deserialiseFromRawBytes AsNatural "\x00" = pure 0 + deserialiseFromRawBytes AsNatural input = pure . F.foldl' (\acc byte -> acc `shiftL` 8 .|. fromIntegral byte) 0 $ BS.unpack input + instance SerialiseAsRawBytes BS.ByteString where serialiseToRawBytes = id deserialiseFromRawBytes AsByteString = pure +instance SerialiseAsRawBytes BSL.ByteString where + serialiseToRawBytes = BSL.toStrict + deserialiseFromRawBytes AsByteStringLazy = pure . BSL.fromStrict + serialiseToRawBytesHex :: SerialiseAsRawBytes a => a -> ByteString serialiseToRawBytesHex = Base16.encode . serialiseToRawBytes diff --git a/cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs b/cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs index 76c01133b1..58b73576e7 100644 --- a/cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs +++ b/cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs @@ -17,8 +17,10 @@ import Cardano.Api.Serialise.Json import Cardano.Api.Serialise.Raw import Data.Aeson.Types qualified as Aeson +import Data.ByteString qualified as B import Data.Text.Encoding qualified as Text import Data.Typeable (tyConName, typeRep, typeRepTyCon) +import Numeric (showBin) -- | For use with @deriving via@, to provide 'ToCBOR' and 'FromCBOR' instances, -- based on the 'SerialiseAsRawBytes' instance. @@ -39,6 +41,10 @@ instance SerialiseAsRawBytes a => FromCBOR (UsingRawBytes a) where ttoken = proxyToAsType (Proxy :: Proxy a) tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a) +-- | Prints the representation in binary format, quoted +instance SerialiseAsRawBytes a => Show (UsingRawBytes a) where + showsPrec _ (UsingRawBytes x) = showChar '"' . mconcat (map showBin . B.unpack $ serialiseToRawBytes x) . showChar '"' + -- | For use with @deriving via@, to provide instances for any\/all of 'Show', -- 'ToJSON', 'FromJSON', 'ToJSONKey', FromJSONKey' using a hex -- encoding, based on the 'SerialiseAsRawBytes' instance. diff --git a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto index 34625824b7..7d421ac009 100644 --- a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto +++ b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto @@ -71,7 +71,7 @@ message Constr { // Represents a big integer for Plutus data in Cardano. message BigInt { oneof big_int { - int64 int = 1; + int64 int = 1 [jstype = JS_STRING]; bytes big_u_int = 2; bytes big_n_int = 3; } diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs index d190a5f89d..908285c01e 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs @@ -9,8 +9,9 @@ {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Cardano.Rpc.Server.Internal.Orphans () where +module Cardano.Rpc.Server.Internal.Orphans where +import Cardano.Api (SerialiseAsCBOR (serialiseToCBOR), ToCBOR (..)) import Cardano.Api.Address import Cardano.Api.Block (SlotNo (..)) import Cardano.Api.Era @@ -19,6 +20,7 @@ import Cardano.Api.Ledger qualified as L import Cardano.Api.Plutus import Cardano.Api.Pretty import Cardano.Api.Serialise.Raw +import Cardano.Api.Serialise.SerialiseUsing import Cardano.Api.Tx import Cardano.Api.Value import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc @@ -30,6 +32,7 @@ import Cardano.Ledger.Plutus qualified as L import RIO hiding (toList) +import Data.ByteString qualified as B import Data.Default import Data.Map.Strict qualified as M import Data.ProtoLens (defMessage) @@ -113,8 +116,15 @@ instance Inject ScriptData (Proto UtxoRpc.PlutusData) where inject = \case ScriptDataBytes bs -> defMessage & #boundedBytes .~ bs - ScriptDataNumber int -> - defMessage & #bigInt . #int .~ fromIntegral int + ScriptDataNumber int + | int <= fromIntegral (maxBound @Int64) + && int >= fromIntegral (minBound @Int64) -> + defMessage & #bigInt . #int .~ fromIntegral int + | int < 0 -> + -- https://www.rfc-editor.org/rfc/rfc8949.html#name-bignums see 3.4.3 for negative integers + defMessage & #bigInt . #bigNInt .~ serialiseToRawBytes (fromIntegral @_ @Natural (-1 - int)) + | otherwise -> + defMessage & #bigInt . #bigUInt .~ serialiseToRawBytes (fromIntegral @_ @Natural int) ScriptDataList sds -> defMessage & #array . #items .~ map inject sds ScriptDataMap elements -> do From 39bf22bd38ed77c13bf648c84ff27f7d059ef54d Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 12 Nov 2025 14:09:55 +0100 Subject: [PATCH 4/9] Update generated files from proto --- .../Proto/Utxorpc/V1alpha/Cardano/Cardano.hs | 6813 +++++++++++------ .../Utxorpc/V1alpha/Cardano/Cardano_Fields.hs | 260 + 2 files changed, 4936 insertions(+), 2137 deletions(-) diff --git a/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano.hs b/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano.hs index 7738578a30..80389b87d4 100644 --- a/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano.hs +++ b/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano.hs @@ -5,11 +5,21 @@ {-# OPTIONS_GHC -Wno-dodgy-exports#-} module Proto.Utxorpc.V1alpha.Cardano.Cardano ( AddressArray(), Asset(), Asset'Quantity(..), _Asset'OutputCoin, - _Asset'MintCoin, CostModel(), CostModels(), Datum(), ExPrices(), - ExUnits(), MultiAsset(), PParams(), ProtocolVersion(), - RationalNumber(), Script(), Script'Script(..), _Script'Native, - _Script'PlutusV1, _Script'PlutusV2, _Script'PlutusV3, - _Script'PlutusV4, TxOutput(), VotingThresholds() + _Asset'MintCoin, BigInt(), BigInt'BigInt(..), _BigInt'Int, + _BigInt'BigUInt, _BigInt'BigNInt, Constr(), CostModel(), + CostModels(), Datum(), ExPrices(), ExUnits(), MultiAsset(), + NativeScript(), NativeScript'NativeScript(..), + _NativeScript'ScriptPubkey, _NativeScript'ScriptAll, + _NativeScript'ScriptAny, _NativeScript'ScriptNOfK, + _NativeScript'InvalidBefore, _NativeScript'InvalidHereafter, + NativeScriptList(), PParams(), PlutusData(), + PlutusData'PlutusData(..), _PlutusData'Constr, _PlutusData'Map, + _PlutusData'BigInt, _PlutusData'BoundedBytes, _PlutusData'Array, + PlutusDataArray(), PlutusDataMap(), PlutusDataPair(), + ProtocolVersion(), RationalNumber(), Script(), Script'Script(..), + _Script'Native, _Script'PlutusV1, _Script'PlutusV2, + _Script'PlutusV3, _Script'PlutusV4, ScriptNOfK(), TxOutput(), + VotingThresholds() ) where import qualified Data.ProtoLens.Runtime.Control.DeepSeq as Control.DeepSeq import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Prism as Data.ProtoLens.Prism @@ -411,73 +421,161 @@ _Asset'MintCoin _otherwise -> Prelude.Nothing) {- | Fields : - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.values' @:: Lens' CostModel [Data.Int.Int64]@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.vec'values' @:: Lens' CostModel (Data.Vector.Unboxed.Vector Data.Int.Int64)@ -} -data CostModel - = CostModel'_constructor {_CostModel'values :: !(Data.Vector.Unboxed.Vector Data.Int.Int64), - _CostModel'_unknownFields :: !Data.ProtoLens.FieldSet} + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'bigInt' @:: Lens' BigInt (Prelude.Maybe BigInt'BigInt)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'int' @:: Lens' BigInt (Prelude.Maybe Data.Int.Int64)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.int' @:: Lens' BigInt Data.Int.Int64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'bigUInt' @:: Lens' BigInt (Prelude.Maybe Data.ByteString.ByteString)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.bigUInt' @:: Lens' BigInt Data.ByteString.ByteString@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'bigNInt' @:: Lens' BigInt (Prelude.Maybe Data.ByteString.ByteString)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.bigNInt' @:: Lens' BigInt Data.ByteString.ByteString@ -} +data BigInt + = BigInt'_constructor {_BigInt'bigInt :: !(Prelude.Maybe BigInt'BigInt), + _BigInt'_unknownFields :: !Data.ProtoLens.FieldSet} deriving stock (Prelude.Eq, Prelude.Ord) -instance Prelude.Show CostModel where +instance Prelude.Show BigInt where showsPrec _ __x __s = Prelude.showChar '{' (Prelude.showString (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField CostModel "values" [Data.Int.Int64] where +data BigInt'BigInt + = BigInt'Int !Data.Int.Int64 | + BigInt'BigUInt !Data.ByteString.ByteString | + BigInt'BigNInt !Data.ByteString.ByteString + deriving stock (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance Data.ProtoLens.Field.HasField BigInt "maybe'bigInt" (Prelude.Maybe BigInt'BigInt) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _CostModel'values (\ x__ y__ -> x__ {_CostModel'values = y__})) + _BigInt'bigInt (\ x__ y__ -> x__ {_BigInt'bigInt = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField BigInt "maybe'int" (Prelude.Maybe Data.Int.Int64) where + fieldOf _ + = (Prelude..) (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField CostModel "vec'values" (Data.Vector.Unboxed.Vector Data.Int.Int64) where + _BigInt'bigInt (\ x__ y__ -> x__ {_BigInt'bigInt = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (BigInt'Int x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap BigInt'Int y__)) +instance Data.ProtoLens.Field.HasField BigInt "int" Data.Int.Int64 where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _CostModel'values (\ x__ y__ -> x__ {_CostModel'values = y__})) - Prelude.id -instance Data.ProtoLens.Message CostModel where - messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.CostModel" + _BigInt'bigInt (\ x__ y__ -> x__ {_BigInt'bigInt = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (BigInt'Int x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap BigInt'Int y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)) +instance Data.ProtoLens.Field.HasField BigInt "maybe'bigUInt" (Prelude.Maybe Data.ByteString.ByteString) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _BigInt'bigInt (\ x__ y__ -> x__ {_BigInt'bigInt = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (BigInt'BigUInt x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap BigInt'BigUInt y__)) +instance Data.ProtoLens.Field.HasField BigInt "bigUInt" Data.ByteString.ByteString where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _BigInt'bigInt (\ x__ y__ -> x__ {_BigInt'bigInt = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (BigInt'BigUInt x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap BigInt'BigUInt y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)) +instance Data.ProtoLens.Field.HasField BigInt "maybe'bigNInt" (Prelude.Maybe Data.ByteString.ByteString) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _BigInt'bigInt (\ x__ y__ -> x__ {_BigInt'bigInt = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (BigInt'BigNInt x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap BigInt'BigNInt y__)) +instance Data.ProtoLens.Field.HasField BigInt "bigNInt" Data.ByteString.ByteString where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _BigInt'bigInt (\ x__ y__ -> x__ {_BigInt'bigInt = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (BigInt'BigNInt x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap BigInt'BigNInt y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)) +instance Data.ProtoLens.Message BigInt where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.BigInt" packedMessageDescriptor _ = "\n\ - \\tCostModel\DC2\SYN\n\ - \\ACKvalues\CAN\SOH \ETX(\ETXR\ACKvalues" + \\ACKBigInt\DC2\SYN\n\ + \\ETXint\CAN\SOH \SOH(\ETXH\NULR\ETXintB\STX0\SOH\DC2\FS\n\ + \\tbig_u_int\CAN\STX \SOH(\fH\NULR\abigUInt\DC2\FS\n\ + \\tbig_n_int\CAN\ETX \SOH(\fH\NULR\abigNIntB\t\n\ + \\abig_int" packedFileDescriptor _ = packedFileDescriptor fieldsByTag = let - values__field_descriptor + int__field_descriptor = Data.ProtoLens.FieldDescriptor - "values" + "int" (Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field :: Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Packed (Data.ProtoLens.Field.field @"values")) :: - Data.ProtoLens.FieldDescriptor CostModel + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'int")) :: + Data.ProtoLens.FieldDescriptor BigInt + bigUInt__field_descriptor + = Data.ProtoLens.FieldDescriptor + "big_u_int" + (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: + Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'bigUInt")) :: + Data.ProtoLens.FieldDescriptor BigInt + bigNInt__field_descriptor + = Data.ProtoLens.FieldDescriptor + "big_n_int" + (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: + Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'bigNInt")) :: + Data.ProtoLens.FieldDescriptor BigInt in Data.Map.fromList - [(Data.ProtoLens.Tag 1, values__field_descriptor)] + [(Data.ProtoLens.Tag 1, int__field_descriptor), + (Data.ProtoLens.Tag 2, bigUInt__field_descriptor), + (Data.ProtoLens.Tag 3, bigNInt__field_descriptor)] unknownFields = Lens.Family2.Unchecked.lens - _CostModel'_unknownFields - (\ x__ y__ -> x__ {_CostModel'_unknownFields = y__}) + _BigInt'_unknownFields + (\ x__ y__ -> x__ {_BigInt'_unknownFields = y__}) defMessage - = CostModel'_constructor - {_CostModel'values = Data.Vector.Generic.empty, - _CostModel'_unknownFields = []} + = BigInt'_constructor + {_BigInt'bigInt = Prelude.Nothing, _BigInt'_unknownFields = []} parseMessage = let - loop :: - CostModel - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Unboxed.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.Int.Int64 - -> Data.ProtoLens.Encoding.Bytes.Parser CostModel - loop x mutable'values + loop :: BigInt -> Data.ProtoLens.Encoding.Bytes.Parser BigInt + loop x = do end <- Data.ProtoLens.Encoding.Bytes.atEnd if end then - do frozen'values <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze - mutable'values) - (let missing = [] + do (let missing = [] in if Prelude.null missing then Prelude.return () @@ -488,233 +586,217 @@ instance Data.ProtoLens.Message CostModel where (Prelude.show (missing :: [Prelude.String])))) Prelude.return (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'values") frozen'values x)) + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) else do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt case tag of - 8 -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (Prelude.fmap - Prelude.fromIntegral - Data.ProtoLens.Encoding.Bytes.getVarInt) - "values" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'values y) - loop x v - 10 - -> do y <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - ((let - ploop qs - = do packedEnd <- Data.ProtoLens.Encoding.Bytes.atEnd - if packedEnd then - Prelude.return qs - else - do !q <- (Data.ProtoLens.Encoding.Bytes.) - (Prelude.fmap - Prelude.fromIntegral - Data.ProtoLens.Encoding.Bytes.getVarInt) - "values" - qs' <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append - qs q) - ploop qs' - in ploop) - mutable'values) - loop x y + 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (Prelude.fmap + Prelude.fromIntegral + Data.ProtoLens.Encoding.Bytes.getVarInt) + "int" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"int") y x) + 18 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.getBytes + (Prelude.fromIntegral len)) + "big_u_int" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"bigUInt") y x) + 26 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.getBytes + (Prelude.fromIntegral len)) + "big_n_int" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"bigNInt") y x) wire -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire wire loop (Lens.Family2.over Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - mutable'values in (Data.ProtoLens.Encoding.Bytes.) - (do mutable'values <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - loop Data.ProtoLens.defMessage mutable'values) - "CostModel" + (do loop Data.ProtoLens.defMessage) "BigInt" buildMessage = \ _x -> (Data.Monoid.<>) - (let - p = Lens.Family2.view (Data.ProtoLens.Field.field @"vec'values") _x - in - if Data.Vector.Generic.null p then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - (Data.ProtoLens.Encoding.Bytes.runBuilder - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - ((Prelude..) - Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral) - p)))) + (case + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'bigInt") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just (BigInt'Int v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 8) + ((Prelude..) + Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral v) + (Prelude.Just (BigInt'BigUInt v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 18) + ((\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + v) + (Prelude.Just (BigInt'BigNInt v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 26) + ((\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + v)) (Data.ProtoLens.Encoding.Wire.buildFieldSet (Lens.Family2.view Data.ProtoLens.unknownFields _x)) -instance Control.DeepSeq.NFData CostModel where +instance Control.DeepSeq.NFData BigInt where rnf = \ x__ -> Control.DeepSeq.deepseq - (_CostModel'_unknownFields x__) - (Control.DeepSeq.deepseq (_CostModel'values x__) ()) + (_BigInt'_unknownFields x__) + (Control.DeepSeq.deepseq (_BigInt'bigInt x__) ()) +instance Control.DeepSeq.NFData BigInt'BigInt where + rnf (BigInt'Int x__) = Control.DeepSeq.rnf x__ + rnf (BigInt'BigUInt x__) = Control.DeepSeq.rnf x__ + rnf (BigInt'BigNInt x__) = Control.DeepSeq.rnf x__ +_BigInt'Int :: + Data.ProtoLens.Prism.Prism' BigInt'BigInt Data.Int.Int64 +_BigInt'Int + = Data.ProtoLens.Prism.prism' + BigInt'Int + (\ p__ + -> case p__ of + (BigInt'Int p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_BigInt'BigUInt :: + Data.ProtoLens.Prism.Prism' BigInt'BigInt Data.ByteString.ByteString +_BigInt'BigUInt + = Data.ProtoLens.Prism.prism' + BigInt'BigUInt + (\ p__ + -> case p__ of + (BigInt'BigUInt p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_BigInt'BigNInt :: + Data.ProtoLens.Prism.Prism' BigInt'BigInt Data.ByteString.ByteString +_BigInt'BigNInt + = Data.ProtoLens.Prism.prism' + BigInt'BigNInt + (\ p__ + -> case p__ of + (BigInt'BigNInt p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) {- | Fields : - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.plutusV1' @:: Lens' CostModels CostModel@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV1' @:: Lens' CostModels (Prelude.Maybe CostModel)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.plutusV2' @:: Lens' CostModels CostModel@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV2' @:: Lens' CostModels (Prelude.Maybe CostModel)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.plutusV3' @:: Lens' CostModels CostModel@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV3' @:: Lens' CostModels (Prelude.Maybe CostModel)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.plutusV4' @:: Lens' CostModels CostModel@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV4' @:: Lens' CostModels (Prelude.Maybe CostModel)@ -} -data CostModels - = CostModels'_constructor {_CostModels'plutusV1 :: !(Prelude.Maybe CostModel), - _CostModels'plutusV2 :: !(Prelude.Maybe CostModel), - _CostModels'plutusV3 :: !(Prelude.Maybe CostModel), - _CostModels'plutusV4 :: !(Prelude.Maybe CostModel), - _CostModels'_unknownFields :: !Data.ProtoLens.FieldSet} + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.tag' @:: Lens' Constr Data.Word.Word32@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.anyConstructor' @:: Lens' Constr Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.fields' @:: Lens' Constr [PlutusData]@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.vec'fields' @:: Lens' Constr (Data.Vector.Vector PlutusData)@ -} +data Constr + = Constr'_constructor {_Constr'tag :: !Data.Word.Word32, + _Constr'anyConstructor :: !Data.Word.Word64, + _Constr'fields :: !(Data.Vector.Vector PlutusData), + _Constr'_unknownFields :: !Data.ProtoLens.FieldSet} deriving stock (Prelude.Eq, Prelude.Ord) -instance Prelude.Show CostModels where +instance Prelude.Show Constr where showsPrec _ __x __s = Prelude.showChar '{' (Prelude.showString (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField CostModels "plutusV1" CostModel where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _CostModels'plutusV1 - (\ x__ y__ -> x__ {_CostModels'plutusV1 = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField CostModels "maybe'plutusV1" (Prelude.Maybe CostModel) where +instance Data.ProtoLens.Field.HasField Constr "tag" Data.Word.Word32 where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _CostModels'plutusV1 - (\ x__ y__ -> x__ {_CostModels'plutusV1 = y__})) + _Constr'tag (\ x__ y__ -> x__ {_Constr'tag = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField CostModels "plutusV2" CostModel where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _CostModels'plutusV2 - (\ x__ y__ -> x__ {_CostModels'plutusV2 = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField CostModels "maybe'plutusV2" (Prelude.Maybe CostModel) where +instance Data.ProtoLens.Field.HasField Constr "anyConstructor" Data.Word.Word64 where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _CostModels'plutusV2 - (\ x__ y__ -> x__ {_CostModels'plutusV2 = y__})) + _Constr'anyConstructor + (\ x__ y__ -> x__ {_Constr'anyConstructor = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField CostModels "plutusV3" CostModel where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _CostModels'plutusV3 - (\ x__ y__ -> x__ {_CostModels'plutusV3 = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField CostModels "maybe'plutusV3" (Prelude.Maybe CostModel) where +instance Data.ProtoLens.Field.HasField Constr "fields" [PlutusData] where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _CostModels'plutusV3 - (\ x__ y__ -> x__ {_CostModels'plutusV3 = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField CostModels "plutusV4" CostModel where - fieldOf _ - = (Prelude..) + _Constr'fields (\ x__ y__ -> x__ {_Constr'fields = y__})) (Lens.Family2.Unchecked.lens - _CostModels'plutusV4 - (\ x__ y__ -> x__ {_CostModels'plutusV4 = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField CostModels "maybe'plutusV4" (Prelude.Maybe CostModel) where + Data.Vector.Generic.toList + (\ _ y__ -> Data.Vector.Generic.fromList y__)) +instance Data.ProtoLens.Field.HasField Constr "vec'fields" (Data.Vector.Vector PlutusData) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _CostModels'plutusV4 - (\ x__ y__ -> x__ {_CostModels'plutusV4 = y__})) + _Constr'fields (\ x__ y__ -> x__ {_Constr'fields = y__})) Prelude.id -instance Data.ProtoLens.Message CostModels where - messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.CostModels" +instance Data.ProtoLens.Message Constr where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.Constr" packedMessageDescriptor _ = "\n\ - \\n\ - \CostModels\DC2?\n\ - \\tplutus_v1\CAN\SOH \SOH(\v2\".utxorpc.v1alpha.cardano.CostModelR\bplutusV1\DC2?\n\ - \\tplutus_v2\CAN\STX \SOH(\v2\".utxorpc.v1alpha.cardano.CostModelR\bplutusV2\DC2?\n\ - \\tplutus_v3\CAN\ETX \SOH(\v2\".utxorpc.v1alpha.cardano.CostModelR\bplutusV3\DC2?\n\ - \\tplutus_v4\CAN\EOT \SOH(\v2\".utxorpc.v1alpha.cardano.CostModelR\bplutusV4" + \\ACKConstr\DC2\DLE\n\ + \\ETXtag\CAN\SOH \SOH(\rR\ETXtag\DC2'\n\ + \\SIany_constructor\CAN\STX \SOH(\EOTR\SOanyConstructor\DC2;\n\ + \\ACKfields\CAN\ETX \ETX(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\ACKfields" packedFileDescriptor _ = packedFileDescriptor fieldsByTag = let - plutusV1__field_descriptor - = Data.ProtoLens.FieldDescriptor - "plutus_v1" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor CostModel) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'plutusV1")) :: - Data.ProtoLens.FieldDescriptor CostModels - plutusV2__field_descriptor + tag__field_descriptor = Data.ProtoLens.FieldDescriptor - "plutus_v2" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor CostModel) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'plutusV2")) :: - Data.ProtoLens.FieldDescriptor CostModels - plutusV3__field_descriptor + "tag" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt32Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"tag")) :: + Data.ProtoLens.FieldDescriptor Constr + anyConstructor__field_descriptor = Data.ProtoLens.FieldDescriptor - "plutus_v3" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor CostModel) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'plutusV3")) :: - Data.ProtoLens.FieldDescriptor CostModels - plutusV4__field_descriptor + "any_constructor" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"anyConstructor")) :: + Data.ProtoLens.FieldDescriptor Constr + fields__field_descriptor = Data.ProtoLens.FieldDescriptor - "plutus_v4" + "fields" (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor CostModel) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'plutusV4")) :: - Data.ProtoLens.FieldDescriptor CostModels + Data.ProtoLens.FieldTypeDescriptor PlutusData) + (Data.ProtoLens.RepeatedField + Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"fields")) :: + Data.ProtoLens.FieldDescriptor Constr in Data.Map.fromList - [(Data.ProtoLens.Tag 1, plutusV1__field_descriptor), - (Data.ProtoLens.Tag 2, plutusV2__field_descriptor), - (Data.ProtoLens.Tag 3, plutusV3__field_descriptor), - (Data.ProtoLens.Tag 4, plutusV4__field_descriptor)] + [(Data.ProtoLens.Tag 1, tag__field_descriptor), + (Data.ProtoLens.Tag 2, anyConstructor__field_descriptor), + (Data.ProtoLens.Tag 3, fields__field_descriptor)] unknownFields = Lens.Family2.Unchecked.lens - _CostModels'_unknownFields - (\ x__ y__ -> x__ {_CostModels'_unknownFields = y__}) + _Constr'_unknownFields + (\ x__ y__ -> x__ {_Constr'_unknownFields = y__}) defMessage - = CostModels'_constructor - {_CostModels'plutusV1 = Prelude.Nothing, - _CostModels'plutusV2 = Prelude.Nothing, - _CostModels'plutusV3 = Prelude.Nothing, - _CostModels'plutusV4 = Prelude.Nothing, - _CostModels'_unknownFields = []} + = Constr'_constructor + {_Constr'tag = Data.ProtoLens.fieldDefault, + _Constr'anyConstructor = Data.ProtoLens.fieldDefault, + _Constr'fields = Data.Vector.Generic.empty, + _Constr'_unknownFields = []} parseMessage = let loop :: - CostModels -> Data.ProtoLens.Encoding.Bytes.Parser CostModels - loop x + Constr + -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld PlutusData + -> Data.ProtoLens.Encoding.Bytes.Parser Constr + loop x mutable'fields = do end <- Data.ProtoLens.Encoding.Bytes.atEnd if end then - do (let missing = [] + do frozen'fields <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.unsafeFreeze + mutable'fields) + (let missing = [] in if Prelude.null missing then Prelude.return () @@ -725,201 +807,168 @@ instance Data.ProtoLens.Message CostModels where (Prelude.show (missing :: [Prelude.String])))) Prelude.return (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) + (Lens.Family2.set + (Data.ProtoLens.Field.field @"vec'fields") frozen'fields x)) else do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt case tag of - 10 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "plutus_v1" + 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (Prelude.fmap + Prelude.fromIntegral + Data.ProtoLens.Encoding.Bytes.getVarInt) + "tag" loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"plutusV1") y x) - 18 + (Lens.Family2.set (Data.ProtoLens.Field.field @"tag") y x) + mutable'fields + 16 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "plutus_v2" + Data.ProtoLens.Encoding.Bytes.getVarInt "any_constructor" loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"plutusV2") y x) + (Lens.Family2.set + (Data.ProtoLens.Field.field @"anyConstructor") y x) + mutable'fields 26 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "plutus_v3" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"plutusV3") y x) - 34 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "plutus_v4" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"plutusV4") y x) + -> do !y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) + Data.ProtoLens.parseMessage) + "fields" + v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.append mutable'fields y) + loop x v wire -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire wire loop (Lens.Family2.over Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + mutable'fields in (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "CostModels" + (do mutable'fields <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + Data.ProtoLens.Encoding.Growing.new + loop Data.ProtoLens.defMessage mutable'fields) + "Constr" buildMessage = \ _x -> (Data.Monoid.<>) - (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'plutusV1") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage _v)) + (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"tag") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 8) + ((Prelude..) + Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v)) ((Data.Monoid.<>) - (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'plutusV2") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage _v)) + (let + _v + = Lens.Family2.view + (Data.ProtoLens.Field.field @"anyConstructor") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 16) + (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) ((Data.Monoid.<>) - (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'plutusV3") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 26) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage _v)) - ((Data.Monoid.<>) - (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'plutusV4") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 34) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))))) -instance Control.DeepSeq.NFData CostModels where + (Data.ProtoLens.Encoding.Bytes.foldMapBuilder + (\ _v + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 26) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'fields") _x)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)))) +instance Control.DeepSeq.NFData Constr where rnf = \ x__ -> Control.DeepSeq.deepseq - (_CostModels'_unknownFields x__) + (_Constr'_unknownFields x__) (Control.DeepSeq.deepseq - (_CostModels'plutusV1 x__) + (_Constr'tag x__) (Control.DeepSeq.deepseq - (_CostModels'plutusV2 x__) - (Control.DeepSeq.deepseq - (_CostModels'plutusV3 x__) - (Control.DeepSeq.deepseq (_CostModels'plutusV4 x__) ())))) + (_Constr'anyConstructor x__) + (Control.DeepSeq.deepseq (_Constr'fields x__) ()))) {- | Fields : - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.hash' @:: Lens' Datum Data.ByteString.ByteString@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.originalCbor' @:: Lens' Datum Data.ByteString.ByteString@ -} -data Datum - = Datum'_constructor {_Datum'hash :: !Data.ByteString.ByteString, - _Datum'originalCbor :: !Data.ByteString.ByteString, - _Datum'_unknownFields :: !Data.ProtoLens.FieldSet} + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.values' @:: Lens' CostModel [Data.Int.Int64]@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.vec'values' @:: Lens' CostModel (Data.Vector.Unboxed.Vector Data.Int.Int64)@ -} +data CostModel + = CostModel'_constructor {_CostModel'values :: !(Data.Vector.Unboxed.Vector Data.Int.Int64), + _CostModel'_unknownFields :: !Data.ProtoLens.FieldSet} deriving stock (Prelude.Eq, Prelude.Ord) -instance Prelude.Show Datum where +instance Prelude.Show CostModel where showsPrec _ __x __s = Prelude.showChar '{' (Prelude.showString (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField Datum "hash" Data.ByteString.ByteString where +instance Data.ProtoLens.Field.HasField CostModel "values" [Data.Int.Int64] where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _Datum'hash (\ x__ y__ -> x__ {_Datum'hash = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField Datum "originalCbor" Data.ByteString.ByteString where + _CostModel'values (\ x__ y__ -> x__ {_CostModel'values = y__})) + (Lens.Family2.Unchecked.lens + Data.Vector.Generic.toList + (\ _ y__ -> Data.Vector.Generic.fromList y__)) +instance Data.ProtoLens.Field.HasField CostModel "vec'values" (Data.Vector.Unboxed.Vector Data.Int.Int64) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _Datum'originalCbor (\ x__ y__ -> x__ {_Datum'originalCbor = y__})) + _CostModel'values (\ x__ y__ -> x__ {_CostModel'values = y__})) Prelude.id -instance Data.ProtoLens.Message Datum where - messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.Datum" +instance Data.ProtoLens.Message CostModel where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.CostModel" packedMessageDescriptor _ = "\n\ - \\ENQDatum\DC2\DC2\n\ - \\EOThash\CAN\SOH \SOH(\fR\EOThash\DC2#\n\ - \\roriginal_cbor\CAN\ETX \SOH(\fR\foriginalCbor" + \\tCostModel\DC2\SYN\n\ + \\ACKvalues\CAN\SOH \ETX(\ETXR\ACKvalues" packedFileDescriptor _ = packedFileDescriptor fieldsByTag = let - hash__field_descriptor - = Data.ProtoLens.FieldDescriptor - "hash" - (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: - Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"hash")) :: - Data.ProtoLens.FieldDescriptor Datum - originalCbor__field_descriptor + values__field_descriptor = Data.ProtoLens.FieldDescriptor - "original_cbor" - (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: - Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"originalCbor")) :: - Data.ProtoLens.FieldDescriptor Datum - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, hash__field_descriptor), - (Data.ProtoLens.Tag 3, originalCbor__field_descriptor)] + "values" + (Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64) + (Data.ProtoLens.RepeatedField + Data.ProtoLens.Packed (Data.ProtoLens.Field.field @"values")) :: + Data.ProtoLens.FieldDescriptor CostModel + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, values__field_descriptor)] unknownFields = Lens.Family2.Unchecked.lens - _Datum'_unknownFields - (\ x__ y__ -> x__ {_Datum'_unknownFields = y__}) + _CostModel'_unknownFields + (\ x__ y__ -> x__ {_CostModel'_unknownFields = y__}) defMessage - = Datum'_constructor - {_Datum'hash = Data.ProtoLens.fieldDefault, - _Datum'originalCbor = Data.ProtoLens.fieldDefault, - _Datum'_unknownFields = []} + = CostModel'_constructor + {_CostModel'values = Data.Vector.Generic.empty, + _CostModel'_unknownFields = []} parseMessage = let - loop :: Datum -> Data.ProtoLens.Encoding.Bytes.Parser Datum - loop x + loop :: + CostModel + -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Unboxed.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.Int.Int64 + -> Data.ProtoLens.Encoding.Bytes.Parser CostModel + loop x mutable'values = do end <- Data.ProtoLens.Encoding.Bytes.atEnd if end then - do (let missing = [] + do frozen'values <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.unsafeFreeze + mutable'values) + (let missing = [] in if Prelude.null missing then Prelude.return () @@ -930,41 +979,62 @@ instance Data.ProtoLens.Message Datum where (Prelude.show (missing :: [Prelude.String])))) Prelude.return (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) + (Lens.Family2.set + (Data.ProtoLens.Field.field @"vec'values") frozen'values x)) else do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt case tag of + 8 -> do !y <- (Data.ProtoLens.Encoding.Bytes.) + (Prelude.fmap + Prelude.fromIntegral + Data.ProtoLens.Encoding.Bytes.getVarInt) + "values" + v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.append mutable'values y) + loop x v 10 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len)) - "hash" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"hash") y x) - 26 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len)) - "original_cbor" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"originalCbor") y x) + -> do y <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) + ((let + ploop qs + = do packedEnd <- Data.ProtoLens.Encoding.Bytes.atEnd + if packedEnd then + Prelude.return qs + else + do !q <- (Data.ProtoLens.Encoding.Bytes.) + (Prelude.fmap + Prelude.fromIntegral + Data.ProtoLens.Encoding.Bytes.getVarInt) + "values" + qs' <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.append + qs q) + ploop qs' + in ploop) + mutable'values) + loop x y wire -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire wire loop (Lens.Family2.over Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + mutable'values in (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "Datum" + (do mutable'values <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + Data.ProtoLens.Encoding.Growing.new + loop Data.ProtoLens.defMessage mutable'values) + "CostModel" buildMessage = \ _x -> (Data.Monoid.<>) - (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"hash") _x + (let + p = Lens.Family2.view (Data.ProtoLens.Field.field @"vec'values") _x in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then + if Data.Vector.Generic.null p then Data.Monoid.mempty else (Data.Monoid.<>) @@ -974,115 +1044,164 @@ instance Data.ProtoLens.Message Datum where (Data.ProtoLens.Encoding.Bytes.putVarInt (Prelude.fromIntegral (Data.ByteString.length bs))) (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - _v)) - ((Data.Monoid.<>) - (let - _v - = Lens.Family2.view (Data.ProtoLens.Field.field @"originalCbor") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 26) - ((\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))) -instance Control.DeepSeq.NFData Datum where + (Data.ProtoLens.Encoding.Bytes.runBuilder + (Data.ProtoLens.Encoding.Bytes.foldMapBuilder + ((Prelude..) + Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral) + p)))) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)) +instance Control.DeepSeq.NFData CostModel where rnf = \ x__ -> Control.DeepSeq.deepseq - (_Datum'_unknownFields x__) - (Control.DeepSeq.deepseq - (_Datum'hash x__) - (Control.DeepSeq.deepseq (_Datum'originalCbor x__) ())) + (_CostModel'_unknownFields x__) + (Control.DeepSeq.deepseq (_CostModel'values x__) ()) {- | Fields : - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.steps' @:: Lens' ExPrices RationalNumber@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'steps' @:: Lens' ExPrices (Prelude.Maybe RationalNumber)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.memory' @:: Lens' ExPrices RationalNumber@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'memory' @:: Lens' ExPrices (Prelude.Maybe RationalNumber)@ -} -data ExPrices - = ExPrices'_constructor {_ExPrices'steps :: !(Prelude.Maybe RationalNumber), - _ExPrices'memory :: !(Prelude.Maybe RationalNumber), - _ExPrices'_unknownFields :: !Data.ProtoLens.FieldSet} + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.plutusV1' @:: Lens' CostModels CostModel@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV1' @:: Lens' CostModels (Prelude.Maybe CostModel)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.plutusV2' @:: Lens' CostModels CostModel@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV2' @:: Lens' CostModels (Prelude.Maybe CostModel)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.plutusV3' @:: Lens' CostModels CostModel@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV3' @:: Lens' CostModels (Prelude.Maybe CostModel)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.plutusV4' @:: Lens' CostModels CostModel@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV4' @:: Lens' CostModels (Prelude.Maybe CostModel)@ -} +data CostModels + = CostModels'_constructor {_CostModels'plutusV1 :: !(Prelude.Maybe CostModel), + _CostModels'plutusV2 :: !(Prelude.Maybe CostModel), + _CostModels'plutusV3 :: !(Prelude.Maybe CostModel), + _CostModels'plutusV4 :: !(Prelude.Maybe CostModel), + _CostModels'_unknownFields :: !Data.ProtoLens.FieldSet} deriving stock (Prelude.Eq, Prelude.Ord) -instance Prelude.Show ExPrices where +instance Prelude.Show CostModels where showsPrec _ __x __s = Prelude.showChar '{' (Prelude.showString (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField ExPrices "steps" RationalNumber where +instance Data.ProtoLens.Field.HasField CostModels "plutusV1" CostModel where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _ExPrices'steps (\ x__ y__ -> x__ {_ExPrices'steps = y__})) + _CostModels'plutusV1 + (\ x__ y__ -> x__ {_CostModels'plutusV1 = y__})) (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField ExPrices "maybe'steps" (Prelude.Maybe RationalNumber) where +instance Data.ProtoLens.Field.HasField CostModels "maybe'plutusV1" (Prelude.Maybe CostModel) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _ExPrices'steps (\ x__ y__ -> x__ {_ExPrices'steps = y__})) + _CostModels'plutusV1 + (\ x__ y__ -> x__ {_CostModels'plutusV1 = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField ExPrices "memory" RationalNumber where +instance Data.ProtoLens.Field.HasField CostModels "plutusV2" CostModel where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _ExPrices'memory (\ x__ y__ -> x__ {_ExPrices'memory = y__})) + _CostModels'plutusV2 + (\ x__ y__ -> x__ {_CostModels'plutusV2 = y__})) (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField ExPrices "maybe'memory" (Prelude.Maybe RationalNumber) where +instance Data.ProtoLens.Field.HasField CostModels "maybe'plutusV2" (Prelude.Maybe CostModel) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _ExPrices'memory (\ x__ y__ -> x__ {_ExPrices'memory = y__})) + _CostModels'plutusV2 + (\ x__ y__ -> x__ {_CostModels'plutusV2 = y__})) Prelude.id -instance Data.ProtoLens.Message ExPrices where - messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.ExPrices" +instance Data.ProtoLens.Field.HasField CostModels "plutusV3" CostModel where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _CostModels'plutusV3 + (\ x__ y__ -> x__ {_CostModels'plutusV3 = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField CostModels "maybe'plutusV3" (Prelude.Maybe CostModel) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _CostModels'plutusV3 + (\ x__ y__ -> x__ {_CostModels'plutusV3 = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField CostModels "plutusV4" CostModel where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _CostModels'plutusV4 + (\ x__ y__ -> x__ {_CostModels'plutusV4 = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField CostModels "maybe'plutusV4" (Prelude.Maybe CostModel) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _CostModels'plutusV4 + (\ x__ y__ -> x__ {_CostModels'plutusV4 = y__})) + Prelude.id +instance Data.ProtoLens.Message CostModels where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.CostModels" packedMessageDescriptor _ = "\n\ - \\bExPrices\DC2=\n\ - \\ENQsteps\CAN\SOH \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\ENQsteps\DC2?\n\ - \\ACKmemory\CAN\STX \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\ACKmemory" + \\n\ + \CostModels\DC2?\n\ + \\tplutus_v1\CAN\SOH \SOH(\v2\".utxorpc.v1alpha.cardano.CostModelR\bplutusV1\DC2?\n\ + \\tplutus_v2\CAN\STX \SOH(\v2\".utxorpc.v1alpha.cardano.CostModelR\bplutusV2\DC2?\n\ + \\tplutus_v3\CAN\ETX \SOH(\v2\".utxorpc.v1alpha.cardano.CostModelR\bplutusV3\DC2?\n\ + \\tplutus_v4\CAN\EOT \SOH(\v2\".utxorpc.v1alpha.cardano.CostModelR\bplutusV4" packedFileDescriptor _ = packedFileDescriptor fieldsByTag = let - steps__field_descriptor + plutusV1__field_descriptor = Data.ProtoLens.FieldDescriptor - "steps" + "plutus_v1" (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor RationalNumber) + Data.ProtoLens.FieldTypeDescriptor CostModel) (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'steps")) :: - Data.ProtoLens.FieldDescriptor ExPrices - memory__field_descriptor + (Data.ProtoLens.Field.field @"maybe'plutusV1")) :: + Data.ProtoLens.FieldDescriptor CostModels + plutusV2__field_descriptor = Data.ProtoLens.FieldDescriptor - "memory" + "plutus_v2" (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor RationalNumber) + Data.ProtoLens.FieldTypeDescriptor CostModel) (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'memory")) :: - Data.ProtoLens.FieldDescriptor ExPrices + (Data.ProtoLens.Field.field @"maybe'plutusV2")) :: + Data.ProtoLens.FieldDescriptor CostModels + plutusV3__field_descriptor + = Data.ProtoLens.FieldDescriptor + "plutus_v3" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor CostModel) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'plutusV3")) :: + Data.ProtoLens.FieldDescriptor CostModels + plutusV4__field_descriptor + = Data.ProtoLens.FieldDescriptor + "plutus_v4" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor CostModel) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'plutusV4")) :: + Data.ProtoLens.FieldDescriptor CostModels in Data.Map.fromList - [(Data.ProtoLens.Tag 1, steps__field_descriptor), - (Data.ProtoLens.Tag 2, memory__field_descriptor)] + [(Data.ProtoLens.Tag 1, plutusV1__field_descriptor), + (Data.ProtoLens.Tag 2, plutusV2__field_descriptor), + (Data.ProtoLens.Tag 3, plutusV3__field_descriptor), + (Data.ProtoLens.Tag 4, plutusV4__field_descriptor)] unknownFields = Lens.Family2.Unchecked.lens - _ExPrices'_unknownFields - (\ x__ y__ -> x__ {_ExPrices'_unknownFields = y__}) + _CostModels'_unknownFields + (\ x__ y__ -> x__ {_CostModels'_unknownFields = y__}) defMessage - = ExPrices'_constructor - {_ExPrices'steps = Prelude.Nothing, - _ExPrices'memory = Prelude.Nothing, _ExPrices'_unknownFields = []} - parseMessage + = CostModels'_constructor + {_CostModels'plutusV1 = Prelude.Nothing, + _CostModels'plutusV2 = Prelude.Nothing, + _CostModels'plutusV3 = Prelude.Nothing, + _CostModels'plutusV4 = Prelude.Nothing, + _CostModels'_unknownFields = []} + parseMessage = let - loop :: ExPrices -> Data.ProtoLens.Encoding.Bytes.Parser ExPrices + loop :: + CostModels -> Data.ProtoLens.Encoding.Bytes.Parser CostModels loop x = do end <- Data.ProtoLens.Encoding.Bytes.atEnd if end then @@ -1106,15 +1225,33 @@ instance Data.ProtoLens.Message ExPrices where (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt Data.ProtoLens.Encoding.Bytes.isolate (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "steps" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"steps") y x) + "plutus_v1" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"plutusV1") y x) 18 -> do y <- (Data.ProtoLens.Encoding.Bytes.) (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt Data.ProtoLens.Encoding.Bytes.isolate (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "memory" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"memory") y x) + "plutus_v2" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"plutusV2") y x) + 26 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "plutus_v3" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"plutusV3") y x) + 34 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "plutus_v4" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"plutusV4") y x) wire -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire wire @@ -1123,12 +1260,12 @@ instance Data.ProtoLens.Message ExPrices where Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) in (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "ExPrices" + (do loop Data.ProtoLens.defMessage) "CostModels" buildMessage = \ _x -> (Data.Monoid.<>) (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'steps") _x + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'plutusV1") _x of Prelude.Nothing -> Data.Monoid.mempty (Prelude.Just _v) @@ -1143,7 +1280,7 @@ instance Data.ProtoLens.Message ExPrices where Data.ProtoLens.encodeMessage _v)) ((Data.Monoid.<>) (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'memory") _x + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'plutusV2") _x of Prelude.Nothing -> Data.Monoid.mempty (Prelude.Just _v) @@ -1156,85 +1293,146 @@ instance Data.ProtoLens.Message ExPrices where (Prelude.fromIntegral (Data.ByteString.length bs))) (Data.ProtoLens.Encoding.Bytes.putBytes bs)) Data.ProtoLens.encodeMessage _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))) -instance Control.DeepSeq.NFData ExPrices where + ((Data.Monoid.<>) + (case + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'plutusV3") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just _v) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 26) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + ((Data.Monoid.<>) + (case + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'plutusV4") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just _v) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 34) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x))))) +instance Control.DeepSeq.NFData CostModels where rnf = \ x__ -> Control.DeepSeq.deepseq - (_ExPrices'_unknownFields x__) + (_CostModels'_unknownFields x__) (Control.DeepSeq.deepseq - (_ExPrices'steps x__) - (Control.DeepSeq.deepseq (_ExPrices'memory x__) ())) + (_CostModels'plutusV1 x__) + (Control.DeepSeq.deepseq + (_CostModels'plutusV2 x__) + (Control.DeepSeq.deepseq + (_CostModels'plutusV3 x__) + (Control.DeepSeq.deepseq (_CostModels'plutusV4 x__) ())))) {- | Fields : - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.steps' @:: Lens' ExUnits Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.memory' @:: Lens' ExUnits Data.Word.Word64@ -} -data ExUnits - = ExUnits'_constructor {_ExUnits'steps :: !Data.Word.Word64, - _ExUnits'memory :: !Data.Word.Word64, - _ExUnits'_unknownFields :: !Data.ProtoLens.FieldSet} + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.hash' @:: Lens' Datum Data.ByteString.ByteString@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.payload' @:: Lens' Datum PlutusData@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'payload' @:: Lens' Datum (Prelude.Maybe PlutusData)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.originalCbor' @:: Lens' Datum Data.ByteString.ByteString@ -} +data Datum + = Datum'_constructor {_Datum'hash :: !Data.ByteString.ByteString, + _Datum'payload :: !(Prelude.Maybe PlutusData), + _Datum'originalCbor :: !Data.ByteString.ByteString, + _Datum'_unknownFields :: !Data.ProtoLens.FieldSet} deriving stock (Prelude.Eq, Prelude.Ord) -instance Prelude.Show ExUnits where +instance Prelude.Show Datum where showsPrec _ __x __s = Prelude.showChar '{' (Prelude.showString (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField ExUnits "steps" Data.Word.Word64 where +instance Data.ProtoLens.Field.HasField Datum "hash" Data.ByteString.ByteString where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _ExUnits'steps (\ x__ y__ -> x__ {_ExUnits'steps = y__})) + _Datum'hash (\ x__ y__ -> x__ {_Datum'hash = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField ExUnits "memory" Data.Word.Word64 where +instance Data.ProtoLens.Field.HasField Datum "payload" PlutusData where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _ExUnits'memory (\ x__ y__ -> x__ {_ExUnits'memory = y__})) + _Datum'payload (\ x__ y__ -> x__ {_Datum'payload = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField Datum "maybe'payload" (Prelude.Maybe PlutusData) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _Datum'payload (\ x__ y__ -> x__ {_Datum'payload = y__})) Prelude.id -instance Data.ProtoLens.Message ExUnits where - messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.ExUnits" +instance Data.ProtoLens.Field.HasField Datum "originalCbor" Data.ByteString.ByteString where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _Datum'originalCbor (\ x__ y__ -> x__ {_Datum'originalCbor = y__})) + Prelude.id +instance Data.ProtoLens.Message Datum where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.Datum" packedMessageDescriptor _ = "\n\ - \\aExUnits\DC2\DC4\n\ - \\ENQsteps\CAN\SOH \SOH(\EOTR\ENQsteps\DC2\SYN\n\ - \\ACKmemory\CAN\STX \SOH(\EOTR\ACKmemory" + \\ENQDatum\DC2\DC2\n\ + \\EOThash\CAN\SOH \SOH(\fR\EOThash\DC2=\n\ + \\apayload\CAN\STX \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\apayload\DC2#\n\ + \\roriginal_cbor\CAN\ETX \SOH(\fR\foriginalCbor" packedFileDescriptor _ = packedFileDescriptor fieldsByTag = let - steps__field_descriptor + hash__field_descriptor = Data.ProtoLens.FieldDescriptor - "steps" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + "hash" + (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: + Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"steps")) :: - Data.ProtoLens.FieldDescriptor ExUnits - memory__field_descriptor + Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"hash")) :: + Data.ProtoLens.FieldDescriptor Datum + payload__field_descriptor = Data.ProtoLens.FieldDescriptor - "memory" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + "payload" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor PlutusData) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'payload")) :: + Data.ProtoLens.FieldDescriptor Datum + originalCbor__field_descriptor + = Data.ProtoLens.FieldDescriptor + "original_cbor" + (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: + Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"memory")) :: - Data.ProtoLens.FieldDescriptor ExUnits + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"originalCbor")) :: + Data.ProtoLens.FieldDescriptor Datum in Data.Map.fromList - [(Data.ProtoLens.Tag 1, steps__field_descriptor), - (Data.ProtoLens.Tag 2, memory__field_descriptor)] + [(Data.ProtoLens.Tag 1, hash__field_descriptor), + (Data.ProtoLens.Tag 2, payload__field_descriptor), + (Data.ProtoLens.Tag 3, originalCbor__field_descriptor)] unknownFields = Lens.Family2.Unchecked.lens - _ExUnits'_unknownFields - (\ x__ y__ -> x__ {_ExUnits'_unknownFields = y__}) + _Datum'_unknownFields + (\ x__ y__ -> x__ {_Datum'_unknownFields = y__}) defMessage - = ExUnits'_constructor - {_ExUnits'steps = Data.ProtoLens.fieldDefault, - _ExUnits'memory = Data.ProtoLens.fieldDefault, - _ExUnits'_unknownFields = []} + = Datum'_constructor + {_Datum'hash = Data.ProtoLens.fieldDefault, + _Datum'payload = Prelude.Nothing, + _Datum'originalCbor = Data.ProtoLens.fieldDefault, + _Datum'_unknownFields = []} parseMessage = let - loop :: ExUnits -> Data.ProtoLens.Encoding.Bytes.Parser ExUnits + loop :: Datum -> Data.ProtoLens.Encoding.Bytes.Parser Datum loop x = do end <- Data.ProtoLens.Encoding.Bytes.atEnd if end then @@ -1253,13 +1451,29 @@ instance Data.ProtoLens.Message ExUnits where else do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt case tag of - 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "steps" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"steps") y x) - 16 + 10 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "memory" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"memory") y x) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.getBytes + (Prelude.fromIntegral len)) + "hash" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"hash") y x) + 18 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "payload" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"payload") y x) + 26 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.getBytes + (Prelude.fromIntegral len)) + "original_cbor" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"originalCbor") y x) wire -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire wire @@ -1268,130 +1482,152 @@ instance Data.ProtoLens.Message ExUnits where Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) in (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "ExUnits" + (do loop Data.ProtoLens.defMessage) "Datum" buildMessage = \ _x -> (Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"steps") _x + (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"hash") _x in if (Prelude.==) _v Data.ProtoLens.fieldDefault then Data.Monoid.mempty else (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 8) - (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) + (Data.ProtoLens.Encoding.Bytes.putVarInt 10) + ((\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + _v)) ((Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"memory") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 16) - (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))) -instance Control.DeepSeq.NFData ExUnits where + (case + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'payload") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just _v) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 18) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + ((Data.Monoid.<>) + (let + _v + = Lens.Family2.view (Data.ProtoLens.Field.field @"originalCbor") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 26) + ((\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + _v)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)))) +instance Control.DeepSeq.NFData Datum where rnf = \ x__ -> Control.DeepSeq.deepseq - (_ExUnits'_unknownFields x__) + (_Datum'_unknownFields x__) (Control.DeepSeq.deepseq - (_ExUnits'steps x__) - (Control.DeepSeq.deepseq (_ExUnits'memory x__) ())) + (_Datum'hash x__) + (Control.DeepSeq.deepseq + (_Datum'payload x__) + (Control.DeepSeq.deepseq (_Datum'originalCbor x__) ()))) {- | Fields : - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.policyId' @:: Lens' MultiAsset Data.ByteString.ByteString@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.assets' @:: Lens' MultiAsset [Asset]@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.vec'assets' @:: Lens' MultiAsset (Data.Vector.Vector Asset)@ -} -data MultiAsset - = MultiAsset'_constructor {_MultiAsset'policyId :: !Data.ByteString.ByteString, - _MultiAsset'assets :: !(Data.Vector.Vector Asset), - _MultiAsset'_unknownFields :: !Data.ProtoLens.FieldSet} + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.steps' @:: Lens' ExPrices RationalNumber@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'steps' @:: Lens' ExPrices (Prelude.Maybe RationalNumber)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.memory' @:: Lens' ExPrices RationalNumber@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'memory' @:: Lens' ExPrices (Prelude.Maybe RationalNumber)@ -} +data ExPrices + = ExPrices'_constructor {_ExPrices'steps :: !(Prelude.Maybe RationalNumber), + _ExPrices'memory :: !(Prelude.Maybe RationalNumber), + _ExPrices'_unknownFields :: !Data.ProtoLens.FieldSet} deriving stock (Prelude.Eq, Prelude.Ord) -instance Prelude.Show MultiAsset where +instance Prelude.Show ExPrices where showsPrec _ __x __s = Prelude.showChar '{' (Prelude.showString (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField MultiAsset "policyId" Data.ByteString.ByteString where +instance Data.ProtoLens.Field.HasField ExPrices "steps" RationalNumber where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _MultiAsset'policyId - (\ x__ y__ -> x__ {_MultiAsset'policyId = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField MultiAsset "assets" [Asset] where + _ExPrices'steps (\ x__ y__ -> x__ {_ExPrices'steps = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField ExPrices "maybe'steps" (Prelude.Maybe RationalNumber) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _MultiAsset'assets (\ x__ y__ -> x__ {_MultiAsset'assets = y__})) + _ExPrices'steps (\ x__ y__ -> x__ {_ExPrices'steps = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField ExPrices "memory" RationalNumber where + fieldOf _ + = (Prelude..) (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField MultiAsset "vec'assets" (Data.Vector.Vector Asset) where + _ExPrices'memory (\ x__ y__ -> x__ {_ExPrices'memory = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField ExPrices "maybe'memory" (Prelude.Maybe RationalNumber) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _MultiAsset'assets (\ x__ y__ -> x__ {_MultiAsset'assets = y__})) + _ExPrices'memory (\ x__ y__ -> x__ {_ExPrices'memory = y__})) Prelude.id -instance Data.ProtoLens.Message MultiAsset where - messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.MultiAsset" +instance Data.ProtoLens.Message ExPrices where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.ExPrices" packedMessageDescriptor _ = "\n\ - \\n\ - \MultiAsset\DC2\ESC\n\ - \\tpolicy_id\CAN\SOH \SOH(\fR\bpolicyId\DC26\n\ - \\ACKassets\CAN\STX \ETX(\v2\RS.utxorpc.v1alpha.cardano.AssetR\ACKassets" + \\bExPrices\DC2=\n\ + \\ENQsteps\CAN\SOH \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\ENQsteps\DC2?\n\ + \\ACKmemory\CAN\STX \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\ACKmemory" packedFileDescriptor _ = packedFileDescriptor fieldsByTag = let - policyId__field_descriptor + steps__field_descriptor = Data.ProtoLens.FieldDescriptor - "policy_id" - (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: - Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"policyId")) :: - Data.ProtoLens.FieldDescriptor MultiAsset - assets__field_descriptor + "steps" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor RationalNumber) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'steps")) :: + Data.ProtoLens.FieldDescriptor ExPrices + memory__field_descriptor = Data.ProtoLens.FieldDescriptor - "assets" + "memory" (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor Asset) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"assets")) :: - Data.ProtoLens.FieldDescriptor MultiAsset + Data.ProtoLens.FieldTypeDescriptor RationalNumber) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'memory")) :: + Data.ProtoLens.FieldDescriptor ExPrices in Data.Map.fromList - [(Data.ProtoLens.Tag 1, policyId__field_descriptor), - (Data.ProtoLens.Tag 2, assets__field_descriptor)] + [(Data.ProtoLens.Tag 1, steps__field_descriptor), + (Data.ProtoLens.Tag 2, memory__field_descriptor)] unknownFields = Lens.Family2.Unchecked.lens - _MultiAsset'_unknownFields - (\ x__ y__ -> x__ {_MultiAsset'_unknownFields = y__}) + _ExPrices'_unknownFields + (\ x__ y__ -> x__ {_ExPrices'_unknownFields = y__}) defMessage - = MultiAsset'_constructor - {_MultiAsset'policyId = Data.ProtoLens.fieldDefault, - _MultiAsset'assets = Data.Vector.Generic.empty, - _MultiAsset'_unknownFields = []} + = ExPrices'_constructor + {_ExPrices'steps = Prelude.Nothing, + _ExPrices'memory = Prelude.Nothing, _ExPrices'_unknownFields = []} parseMessage = let - loop :: - MultiAsset - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Asset - -> Data.ProtoLens.Encoding.Bytes.Parser MultiAsset - loop x mutable'assets + loop :: ExPrices -> Data.ProtoLens.Encoding.Bytes.Parser ExPrices + loop x = do end <- Data.ProtoLens.Encoding.Bytes.atEnd if end then - do frozen'assets <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze - mutable'assets) - (let missing = [] + do (let missing = [] in if Prelude.null missing then Prelude.return () @@ -1402,848 +1638,684 @@ instance Data.ProtoLens.Message MultiAsset where (Prelude.show (missing :: [Prelude.String])))) Prelude.return (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'assets") frozen'assets x)) + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) else do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt case tag of 10 -> do y <- (Data.ProtoLens.Encoding.Bytes.) (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len)) - "policy_id" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"policyId") y x) - mutable'assets + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "steps" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"steps") y x) 18 - -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - Data.ProtoLens.parseMessage) - "assets" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'assets y) - loop x v + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "memory" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"memory") y x) wire -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire wire loop (Lens.Family2.over Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - mutable'assets in (Data.ProtoLens.Encoding.Bytes.) - (do mutable'assets <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - loop Data.ProtoLens.defMessage mutable'assets) - "MultiAsset" + (do loop Data.ProtoLens.defMessage) "ExPrices" buildMessage = \ _x -> (Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"policyId") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - _v)) + (case + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'steps") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just _v) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 10) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) ((Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - (\ _v - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage _v)) - (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'assets") _x)) + (case + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'memory") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just _v) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 18) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) (Data.ProtoLens.Encoding.Wire.buildFieldSet (Lens.Family2.view Data.ProtoLens.unknownFields _x))) -instance Control.DeepSeq.NFData MultiAsset where +instance Control.DeepSeq.NFData ExPrices where rnf = \ x__ -> Control.DeepSeq.deepseq - (_MultiAsset'_unknownFields x__) + (_ExPrices'_unknownFields x__) (Control.DeepSeq.deepseq - (_MultiAsset'policyId x__) - (Control.DeepSeq.deepseq (_MultiAsset'assets x__) ())) + (_ExPrices'steps x__) + (Control.DeepSeq.deepseq (_ExPrices'memory x__) ())) {- | Fields : - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.coinsPerUtxoByte' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxTxSize' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minFeeCoefficient' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minFeeConstant' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxBlockBodySize' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxBlockHeaderSize' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.stakeKeyDeposit' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.poolDeposit' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.poolRetirementEpochBound' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.desiredNumberOfPools' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.poolInfluence' @:: Lens' PParams RationalNumber@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'poolInfluence' @:: Lens' PParams (Prelude.Maybe RationalNumber)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.monetaryExpansion' @:: Lens' PParams RationalNumber@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'monetaryExpansion' @:: Lens' PParams (Prelude.Maybe RationalNumber)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.treasuryExpansion' @:: Lens' PParams RationalNumber@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'treasuryExpansion' @:: Lens' PParams (Prelude.Maybe RationalNumber)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minPoolCost' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.protocolVersion' @:: Lens' PParams ProtocolVersion@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'protocolVersion' @:: Lens' PParams (Prelude.Maybe ProtocolVersion)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxValueSize' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.collateralPercentage' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxCollateralInputs' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.costModels' @:: Lens' PParams CostModels@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'costModels' @:: Lens' PParams (Prelude.Maybe CostModels)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.prices' @:: Lens' PParams ExPrices@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'prices' @:: Lens' PParams (Prelude.Maybe ExPrices)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxExecutionUnitsPerTransaction' @:: Lens' PParams ExUnits@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'maxExecutionUnitsPerTransaction' @:: Lens' PParams (Prelude.Maybe ExUnits)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxExecutionUnitsPerBlock' @:: Lens' PParams ExUnits@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'maxExecutionUnitsPerBlock' @:: Lens' PParams (Prelude.Maybe ExUnits)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minFeeScriptRefCostPerByte' @:: Lens' PParams RationalNumber@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'minFeeScriptRefCostPerByte' @:: Lens' PParams (Prelude.Maybe RationalNumber)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.poolVotingThresholds' @:: Lens' PParams VotingThresholds@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'poolVotingThresholds' @:: Lens' PParams (Prelude.Maybe VotingThresholds)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.drepVotingThresholds' @:: Lens' PParams VotingThresholds@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'drepVotingThresholds' @:: Lens' PParams (Prelude.Maybe VotingThresholds)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minCommitteeSize' @:: Lens' PParams Data.Word.Word32@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.committeeTermLimit' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.governanceActionValidityPeriod' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.governanceActionDeposit' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.drepDeposit' @:: Lens' PParams Data.Word.Word64@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.drepInactivityPeriod' @:: Lens' PParams Data.Word.Word64@ -} -data PParams - = PParams'_constructor {_PParams'coinsPerUtxoByte :: !Data.Word.Word64, - _PParams'maxTxSize :: !Data.Word.Word64, - _PParams'minFeeCoefficient :: !Data.Word.Word64, - _PParams'minFeeConstant :: !Data.Word.Word64, - _PParams'maxBlockBodySize :: !Data.Word.Word64, - _PParams'maxBlockHeaderSize :: !Data.Word.Word64, - _PParams'stakeKeyDeposit :: !Data.Word.Word64, - _PParams'poolDeposit :: !Data.Word.Word64, - _PParams'poolRetirementEpochBound :: !Data.Word.Word64, - _PParams'desiredNumberOfPools :: !Data.Word.Word64, - _PParams'poolInfluence :: !(Prelude.Maybe RationalNumber), - _PParams'monetaryExpansion :: !(Prelude.Maybe RationalNumber), - _PParams'treasuryExpansion :: !(Prelude.Maybe RationalNumber), - _PParams'minPoolCost :: !Data.Word.Word64, - _PParams'protocolVersion :: !(Prelude.Maybe ProtocolVersion), - _PParams'maxValueSize :: !Data.Word.Word64, - _PParams'collateralPercentage :: !Data.Word.Word64, - _PParams'maxCollateralInputs :: !Data.Word.Word64, - _PParams'costModels :: !(Prelude.Maybe CostModels), - _PParams'prices :: !(Prelude.Maybe ExPrices), - _PParams'maxExecutionUnitsPerTransaction :: !(Prelude.Maybe ExUnits), - _PParams'maxExecutionUnitsPerBlock :: !(Prelude.Maybe ExUnits), - _PParams'minFeeScriptRefCostPerByte :: !(Prelude.Maybe RationalNumber), - _PParams'poolVotingThresholds :: !(Prelude.Maybe VotingThresholds), - _PParams'drepVotingThresholds :: !(Prelude.Maybe VotingThresholds), - _PParams'minCommitteeSize :: !Data.Word.Word32, - _PParams'committeeTermLimit :: !Data.Word.Word64, - _PParams'governanceActionValidityPeriod :: !Data.Word.Word64, - _PParams'governanceActionDeposit :: !Data.Word.Word64, - _PParams'drepDeposit :: !Data.Word.Word64, - _PParams'drepInactivityPeriod :: !Data.Word.Word64, - _PParams'_unknownFields :: !Data.ProtoLens.FieldSet} + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.steps' @:: Lens' ExUnits Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.memory' @:: Lens' ExUnits Data.Word.Word64@ -} +data ExUnits + = ExUnits'_constructor {_ExUnits'steps :: !Data.Word.Word64, + _ExUnits'memory :: !Data.Word.Word64, + _ExUnits'_unknownFields :: !Data.ProtoLens.FieldSet} deriving stock (Prelude.Eq, Prelude.Ord) -instance Prelude.Show PParams where +instance Prelude.Show ExUnits where showsPrec _ __x __s = Prelude.showChar '{' (Prelude.showString (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField PParams "coinsPerUtxoByte" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'coinsPerUtxoByte - (\ x__ y__ -> x__ {_PParams'coinsPerUtxoByte = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "maxTxSize" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'maxTxSize (\ x__ y__ -> x__ {_PParams'maxTxSize = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "minFeeCoefficient" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'minFeeCoefficient - (\ x__ y__ -> x__ {_PParams'minFeeCoefficient = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "minFeeConstant" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'minFeeConstant - (\ x__ y__ -> x__ {_PParams'minFeeConstant = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "maxBlockBodySize" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'maxBlockBodySize - (\ x__ y__ -> x__ {_PParams'maxBlockBodySize = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "maxBlockHeaderSize" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'maxBlockHeaderSize - (\ x__ y__ -> x__ {_PParams'maxBlockHeaderSize = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "stakeKeyDeposit" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'stakeKeyDeposit - (\ x__ y__ -> x__ {_PParams'stakeKeyDeposit = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "poolDeposit" Data.Word.Word64 where +instance Data.ProtoLens.Field.HasField ExUnits "steps" Data.Word.Word64 where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'poolDeposit - (\ x__ y__ -> x__ {_PParams'poolDeposit = y__})) + _ExUnits'steps (\ x__ y__ -> x__ {_ExUnits'steps = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField PParams "poolRetirementEpochBound" Data.Word.Word64 where +instance Data.ProtoLens.Field.HasField ExUnits "memory" Data.Word.Word64 where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'poolRetirementEpochBound - (\ x__ y__ -> x__ {_PParams'poolRetirementEpochBound = y__})) + _ExUnits'memory (\ x__ y__ -> x__ {_ExUnits'memory = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField PParams "desiredNumberOfPools" Data.Word.Word64 where +instance Data.ProtoLens.Message ExUnits where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.ExUnits" + packedMessageDescriptor _ + = "\n\ + \\aExUnits\DC2\DC4\n\ + \\ENQsteps\CAN\SOH \SOH(\EOTR\ENQsteps\DC2\SYN\n\ + \\ACKmemory\CAN\STX \SOH(\EOTR\ACKmemory" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + steps__field_descriptor + = Data.ProtoLens.FieldDescriptor + "steps" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"steps")) :: + Data.ProtoLens.FieldDescriptor ExUnits + memory__field_descriptor + = Data.ProtoLens.FieldDescriptor + "memory" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"memory")) :: + Data.ProtoLens.FieldDescriptor ExUnits + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, steps__field_descriptor), + (Data.ProtoLens.Tag 2, memory__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _ExUnits'_unknownFields + (\ x__ y__ -> x__ {_ExUnits'_unknownFields = y__}) + defMessage + = ExUnits'_constructor + {_ExUnits'steps = Data.ProtoLens.fieldDefault, + _ExUnits'memory = Data.ProtoLens.fieldDefault, + _ExUnits'_unknownFields = []} + parseMessage + = let + loop :: ExUnits -> Data.ProtoLens.Encoding.Bytes.Parser ExUnits + loop x + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "steps" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"steps") y x) + 16 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "memory" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"memory") y x) + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + in + (Data.ProtoLens.Encoding.Bytes.) + (do loop Data.ProtoLens.defMessage) "ExUnits" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (let + _v = Lens.Family2.view (Data.ProtoLens.Field.field @"steps") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 8) + (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) + ((Data.Monoid.<>) + (let + _v = Lens.Family2.view (Data.ProtoLens.Field.field @"memory") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 16) + (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x))) +instance Control.DeepSeq.NFData ExUnits where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_ExUnits'_unknownFields x__) + (Control.DeepSeq.deepseq + (_ExUnits'steps x__) + (Control.DeepSeq.deepseq (_ExUnits'memory x__) ())) +{- | Fields : + + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.policyId' @:: Lens' MultiAsset Data.ByteString.ByteString@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.assets' @:: Lens' MultiAsset [Asset]@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.vec'assets' @:: Lens' MultiAsset (Data.Vector.Vector Asset)@ -} +data MultiAsset + = MultiAsset'_constructor {_MultiAsset'policyId :: !Data.ByteString.ByteString, + _MultiAsset'assets :: !(Data.Vector.Vector Asset), + _MultiAsset'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show MultiAsset where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +instance Data.ProtoLens.Field.HasField MultiAsset "policyId" Data.ByteString.ByteString where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'desiredNumberOfPools - (\ x__ y__ -> x__ {_PParams'desiredNumberOfPools = y__})) + _MultiAsset'policyId + (\ x__ y__ -> x__ {_MultiAsset'policyId = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField PParams "poolInfluence" RationalNumber where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'poolInfluence - (\ x__ y__ -> x__ {_PParams'poolInfluence = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'poolInfluence" (Prelude.Maybe RationalNumber) where +instance Data.ProtoLens.Field.HasField MultiAsset "assets" [Asset] where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'poolInfluence - (\ x__ y__ -> x__ {_PParams'poolInfluence = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "monetaryExpansion" RationalNumber where - fieldOf _ - = (Prelude..) + _MultiAsset'assets (\ x__ y__ -> x__ {_MultiAsset'assets = y__})) (Lens.Family2.Unchecked.lens - _PParams'monetaryExpansion - (\ x__ y__ -> x__ {_PParams'monetaryExpansion = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'monetaryExpansion" (Prelude.Maybe RationalNumber) where + Data.Vector.Generic.toList + (\ _ y__ -> Data.Vector.Generic.fromList y__)) +instance Data.ProtoLens.Field.HasField MultiAsset "vec'assets" (Data.Vector.Vector Asset) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'monetaryExpansion - (\ x__ y__ -> x__ {_PParams'monetaryExpansion = y__})) + _MultiAsset'assets (\ x__ y__ -> x__ {_MultiAsset'assets = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField PParams "treasuryExpansion" RationalNumber where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'treasuryExpansion - (\ x__ y__ -> x__ {_PParams'treasuryExpansion = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'treasuryExpansion" (Prelude.Maybe RationalNumber) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'treasuryExpansion - (\ x__ y__ -> x__ {_PParams'treasuryExpansion = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "minPoolCost" Data.Word.Word64 where +instance Data.ProtoLens.Message MultiAsset where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.MultiAsset" + packedMessageDescriptor _ + = "\n\ + \\n\ + \MultiAsset\DC2\ESC\n\ + \\tpolicy_id\CAN\SOH \SOH(\fR\bpolicyId\DC26\n\ + \\ACKassets\CAN\STX \ETX(\v2\RS.utxorpc.v1alpha.cardano.AssetR\ACKassets" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + policyId__field_descriptor + = Data.ProtoLens.FieldDescriptor + "policy_id" + (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: + Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"policyId")) :: + Data.ProtoLens.FieldDescriptor MultiAsset + assets__field_descriptor + = Data.ProtoLens.FieldDescriptor + "assets" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor Asset) + (Data.ProtoLens.RepeatedField + Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"assets")) :: + Data.ProtoLens.FieldDescriptor MultiAsset + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, policyId__field_descriptor), + (Data.ProtoLens.Tag 2, assets__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _MultiAsset'_unknownFields + (\ x__ y__ -> x__ {_MultiAsset'_unknownFields = y__}) + defMessage + = MultiAsset'_constructor + {_MultiAsset'policyId = Data.ProtoLens.fieldDefault, + _MultiAsset'assets = Data.Vector.Generic.empty, + _MultiAsset'_unknownFields = []} + parseMessage + = let + loop :: + MultiAsset + -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Asset + -> Data.ProtoLens.Encoding.Bytes.Parser MultiAsset + loop x mutable'assets + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do frozen'assets <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.unsafeFreeze + mutable'assets) + (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) + (Lens.Family2.set + (Data.ProtoLens.Field.field @"vec'assets") frozen'assets x)) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 10 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.getBytes + (Prelude.fromIntegral len)) + "policy_id" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"policyId") y x) + mutable'assets + 18 + -> do !y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) + Data.ProtoLens.parseMessage) + "assets" + v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.append mutable'assets y) + loop x v + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + mutable'assets + in + (Data.ProtoLens.Encoding.Bytes.) + (do mutable'assets <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + Data.ProtoLens.Encoding.Growing.new + loop Data.ProtoLens.defMessage mutable'assets) + "MultiAsset" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (let + _v = Lens.Family2.view (Data.ProtoLens.Field.field @"policyId") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 10) + ((\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + _v)) + ((Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.foldMapBuilder + (\ _v + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 18) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'assets") _x)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x))) +instance Control.DeepSeq.NFData MultiAsset where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_MultiAsset'_unknownFields x__) + (Control.DeepSeq.deepseq + (_MultiAsset'policyId x__) + (Control.DeepSeq.deepseq (_MultiAsset'assets x__) ())) +{- | Fields : + + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'nativeScript' @:: Lens' NativeScript (Prelude.Maybe NativeScript'NativeScript)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'scriptPubkey' @:: Lens' NativeScript (Prelude.Maybe Data.ByteString.ByteString)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.scriptPubkey' @:: Lens' NativeScript Data.ByteString.ByteString@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'scriptAll' @:: Lens' NativeScript (Prelude.Maybe NativeScriptList)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.scriptAll' @:: Lens' NativeScript NativeScriptList@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'scriptAny' @:: Lens' NativeScript (Prelude.Maybe NativeScriptList)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.scriptAny' @:: Lens' NativeScript NativeScriptList@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'scriptNOfK' @:: Lens' NativeScript (Prelude.Maybe ScriptNOfK)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.scriptNOfK' @:: Lens' NativeScript ScriptNOfK@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'invalidBefore' @:: Lens' NativeScript (Prelude.Maybe Data.Word.Word64)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.invalidBefore' @:: Lens' NativeScript Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'invalidHereafter' @:: Lens' NativeScript (Prelude.Maybe Data.Word.Word64)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.invalidHereafter' @:: Lens' NativeScript Data.Word.Word64@ -} +data NativeScript + = NativeScript'_constructor {_NativeScript'nativeScript :: !(Prelude.Maybe NativeScript'NativeScript), + _NativeScript'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show NativeScript where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +data NativeScript'NativeScript + = NativeScript'ScriptPubkey !Data.ByteString.ByteString | + NativeScript'ScriptAll !NativeScriptList | + NativeScript'ScriptAny !NativeScriptList | + NativeScript'ScriptNOfK !ScriptNOfK | + NativeScript'InvalidBefore !Data.Word.Word64 | + NativeScript'InvalidHereafter !Data.Word.Word64 + deriving stock (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance Data.ProtoLens.Field.HasField NativeScript "maybe'nativeScript" (Prelude.Maybe NativeScript'NativeScript) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'minPoolCost - (\ x__ y__ -> x__ {_PParams'minPoolCost = y__})) + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField PParams "protocolVersion" ProtocolVersion where +instance Data.ProtoLens.Field.HasField NativeScript "maybe'scriptPubkey" (Prelude.Maybe Data.ByteString.ByteString) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'protocolVersion - (\ x__ y__ -> x__ {_PParams'protocolVersion = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'protocolVersion" (Prelude.Maybe ProtocolVersion) where - fieldOf _ - = (Prelude..) + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) (Lens.Family2.Unchecked.lens - _PParams'protocolVersion - (\ x__ y__ -> x__ {_PParams'protocolVersion = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "maxValueSize" Data.Word.Word64 where + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'ScriptPubkey x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'ScriptPubkey y__)) +instance Data.ProtoLens.Field.HasField NativeScript "scriptPubkey" Data.ByteString.ByteString where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'maxValueSize - (\ x__ y__ -> x__ {_PParams'maxValueSize = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "collateralPercentage" Data.Word.Word64 where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'ScriptPubkey x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'ScriptPubkey y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)) +instance Data.ProtoLens.Field.HasField NativeScript "maybe'scriptAll" (Prelude.Maybe NativeScriptList) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'collateralPercentage - (\ x__ y__ -> x__ {_PParams'collateralPercentage = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "maxCollateralInputs" Data.Word.Word64 where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'ScriptAll x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'ScriptAll y__)) +instance Data.ProtoLens.Field.HasField NativeScript "scriptAll" NativeScriptList where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'maxCollateralInputs - (\ x__ y__ -> x__ {_PParams'maxCollateralInputs = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "costModels" CostModels where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'ScriptAll x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'ScriptAll y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) +instance Data.ProtoLens.Field.HasField NativeScript "maybe'scriptAny" (Prelude.Maybe NativeScriptList) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'costModels (\ x__ y__ -> x__ {_PParams'costModels = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'costModels" (Prelude.Maybe CostModels) where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'ScriptAny x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'ScriptAny y__)) +instance Data.ProtoLens.Field.HasField NativeScript "scriptAny" NativeScriptList where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'costModels (\ x__ y__ -> x__ {_PParams'costModels = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "prices" ExPrices where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'ScriptAny x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'ScriptAny y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) +instance Data.ProtoLens.Field.HasField NativeScript "maybe'scriptNOfK" (Prelude.Maybe ScriptNOfK) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'prices (\ x__ y__ -> x__ {_PParams'prices = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'prices" (Prelude.Maybe ExPrices) where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'ScriptNOfK x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'ScriptNOfK y__)) +instance Data.ProtoLens.Field.HasField NativeScript "scriptNOfK" ScriptNOfK where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'prices (\ x__ y__ -> x__ {_PParams'prices = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "maxExecutionUnitsPerTransaction" ExUnits where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'ScriptNOfK x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'ScriptNOfK y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) +instance Data.ProtoLens.Field.HasField NativeScript "maybe'invalidBefore" (Prelude.Maybe Data.Word.Word64) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'maxExecutionUnitsPerTransaction - (\ x__ y__ - -> x__ {_PParams'maxExecutionUnitsPerTransaction = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'maxExecutionUnitsPerTransaction" (Prelude.Maybe ExUnits) where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'InvalidBefore x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'InvalidBefore y__)) +instance Data.ProtoLens.Field.HasField NativeScript "invalidBefore" Data.Word.Word64 where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'maxExecutionUnitsPerTransaction - (\ x__ y__ - -> x__ {_PParams'maxExecutionUnitsPerTransaction = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "maxExecutionUnitsPerBlock" ExUnits where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'InvalidBefore x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'InvalidBefore y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)) +instance Data.ProtoLens.Field.HasField NativeScript "maybe'invalidHereafter" (Prelude.Maybe Data.Word.Word64) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'maxExecutionUnitsPerBlock - (\ x__ y__ -> x__ {_PParams'maxExecutionUnitsPerBlock = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'maxExecutionUnitsPerBlock" (Prelude.Maybe ExUnits) where + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'InvalidHereafter x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'InvalidHereafter y__)) +instance Data.ProtoLens.Field.HasField NativeScript "invalidHereafter" Data.Word.Word64 where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens - _PParams'maxExecutionUnitsPerBlock - (\ x__ y__ -> x__ {_PParams'maxExecutionUnitsPerBlock = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "minFeeScriptRefCostPerByte" RationalNumber where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'minFeeScriptRefCostPerByte - (\ x__ y__ -> x__ {_PParams'minFeeScriptRefCostPerByte = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'minFeeScriptRefCostPerByte" (Prelude.Maybe RationalNumber) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'minFeeScriptRefCostPerByte - (\ x__ y__ -> x__ {_PParams'minFeeScriptRefCostPerByte = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "poolVotingThresholds" VotingThresholds where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'poolVotingThresholds - (\ x__ y__ -> x__ {_PParams'poolVotingThresholds = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'poolVotingThresholds" (Prelude.Maybe VotingThresholds) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'poolVotingThresholds - (\ x__ y__ -> x__ {_PParams'poolVotingThresholds = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "drepVotingThresholds" VotingThresholds where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'drepVotingThresholds - (\ x__ y__ -> x__ {_PParams'drepVotingThresholds = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField PParams "maybe'drepVotingThresholds" (Prelude.Maybe VotingThresholds) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'drepVotingThresholds - (\ x__ y__ -> x__ {_PParams'drepVotingThresholds = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "minCommitteeSize" Data.Word.Word32 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'minCommitteeSize - (\ x__ y__ -> x__ {_PParams'minCommitteeSize = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "committeeTermLimit" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'committeeTermLimit - (\ x__ y__ -> x__ {_PParams'committeeTermLimit = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "governanceActionValidityPeriod" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'governanceActionValidityPeriod - (\ x__ y__ -> x__ {_PParams'governanceActionValidityPeriod = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "governanceActionDeposit" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'governanceActionDeposit - (\ x__ y__ -> x__ {_PParams'governanceActionDeposit = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "drepDeposit" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'drepDeposit - (\ x__ y__ -> x__ {_PParams'drepDeposit = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField PParams "drepInactivityPeriod" Data.Word.Word64 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _PParams'drepInactivityPeriod - (\ x__ y__ -> x__ {_PParams'drepInactivityPeriod = y__})) - Prelude.id -instance Data.ProtoLens.Message PParams where - messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.PParams" + _NativeScript'nativeScript + (\ x__ y__ -> x__ {_NativeScript'nativeScript = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (NativeScript'InvalidHereafter x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap NativeScript'InvalidHereafter y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)) +instance Data.ProtoLens.Message NativeScript where + messageName _ + = Data.Text.pack "utxorpc.v1alpha.cardano.NativeScript" packedMessageDescriptor _ = "\n\ - \\aPParams\DC21\n\ - \\DC3coins_per_utxo_byte\CAN\SOH \SOH(\EOTR\DLEcoinsPerUtxoByteB\STX0\SOH\DC2\"\n\ - \\vmax_tx_size\CAN\STX \SOH(\EOTR\tmaxTxSizeB\STX0\SOH\DC22\n\ - \\DC3min_fee_coefficient\CAN\ETX \SOH(\EOTR\DC1minFeeCoefficientB\STX0\SOH\DC2,\n\ - \\DLEmin_fee_constant\CAN\EOT \SOH(\EOTR\SOminFeeConstantB\STX0\SOH\DC21\n\ - \\DC3max_block_body_size\CAN\ENQ \SOH(\EOTR\DLEmaxBlockBodySizeB\STX0\SOH\DC25\n\ - \\NAKmax_block_header_size\CAN\ACK \SOH(\EOTR\DC2maxBlockHeaderSizeB\STX0\SOH\DC2.\n\ - \\DC1stake_key_deposit\CAN\a \SOH(\EOTR\SIstakeKeyDepositB\STX0\SOH\DC2%\n\ - \\fpool_deposit\CAN\b \SOH(\EOTR\vpoolDepositB\STX0\SOH\DC2=\n\ - \\ESCpool_retirement_epoch_bound\CAN\t \SOH(\EOTR\CANpoolRetirementEpochBound\DC25\n\ - \\ETBdesired_number_of_pools\CAN\n\ - \ \SOH(\EOTR\DC4desiredNumberOfPools\DC2N\n\ - \\SOpool_influence\CAN\v \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\rpoolInfluence\DC2V\n\ - \\DC2monetary_expansion\CAN\f \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\DC1monetaryExpansion\DC2V\n\ - \\DC2treasury_expansion\CAN\r \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\DC1treasuryExpansion\DC2&\n\ - \\rmin_pool_cost\CAN\SO \SOH(\EOTR\vminPoolCostB\STX0\SOH\DC2S\n\ - \\DLEprotocol_version\CAN\SI \SOH(\v2(.utxorpc.v1alpha.cardano.ProtocolVersionR\SIprotocolVersion\DC2(\n\ - \\SOmax_value_size\CAN\DLE \SOH(\EOTR\fmaxValueSizeB\STX0\SOH\DC27\n\ - \\NAKcollateral_percentage\CAN\DC1 \SOH(\EOTR\DC4collateralPercentageB\STX0\SOH\DC26\n\ - \\NAKmax_collateral_inputs\CAN\DC2 \SOH(\EOTR\DC3maxCollateralInputsB\STX0\SOH\DC2D\n\ - \\vcost_models\CAN\DC3 \SOH(\v2#.utxorpc.v1alpha.cardano.CostModelsR\n\ - \costModels\DC29\n\ - \\ACKprices\CAN\DC4 \SOH(\v2!.utxorpc.v1alpha.cardano.ExPricesR\ACKprices\DC2n\n\ - \#max_execution_units_per_transaction\CAN\NAK \SOH(\v2 .utxorpc.v1alpha.cardano.ExUnitsR\USmaxExecutionUnitsPerTransaction\DC2b\n\ - \\GSmax_execution_units_per_block\CAN\SYN \SOH(\v2 .utxorpc.v1alpha.cardano.ExUnitsR\EMmaxExecutionUnitsPerBlock\DC2m\n\ - \ min_fee_script_ref_cost_per_byte\CAN\ETB \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\SUBminFeeScriptRefCostPerByte\DC2_\n\ - \\SYNpool_voting_thresholds\CAN\CAN \SOH(\v2).utxorpc.v1alpha.cardano.VotingThresholdsR\DC4poolVotingThresholds\DC2_\n\ - \\SYNdrep_voting_thresholds\CAN\EM \SOH(\v2).utxorpc.v1alpha.cardano.VotingThresholdsR\DC4drepVotingThresholds\DC2,\n\ - \\DC2min_committee_size\CAN\SUB \SOH(\rR\DLEminCommitteeSize\DC20\n\ - \\DC4committee_term_limit\CAN\ESC \SOH(\EOTR\DC2committeeTermLimit\DC2I\n\ - \!governance_action_validity_period\CAN\FS \SOH(\EOTR\RSgovernanceActionValidityPeriod\DC2>\n\ - \\EMgovernance_action_deposit\CAN\GS \SOH(\EOTR\ETBgovernanceActionDepositB\STX0\SOH\DC2%\n\ - \\fdrep_deposit\CAN\RS \SOH(\EOTR\vdrepDepositB\STX0\SOH\DC24\n\ - \\SYNdrep_inactivity_period\CAN\US \SOH(\EOTR\DC4drepInactivityPeriod" + \\fNativeScript\DC2%\n\ + \\rscript_pubkey\CAN\SOH \SOH(\fH\NULR\fscriptPubkey\DC2J\n\ + \\n\ + \script_all\CAN\STX \SOH(\v2).utxorpc.v1alpha.cardano.NativeScriptListH\NULR\tscriptAll\DC2J\n\ + \\n\ + \script_any\CAN\ETX \SOH(\v2).utxorpc.v1alpha.cardano.NativeScriptListH\NULR\tscriptAny\DC2H\n\ + \\rscript_n_of_k\CAN\EOT \SOH(\v2#.utxorpc.v1alpha.cardano.ScriptNOfKH\NULR\n\ + \scriptNOfK\DC2'\n\ + \\SOinvalid_before\CAN\ENQ \SOH(\EOTH\NULR\rinvalidBefore\DC2-\n\ + \\DC1invalid_hereafter\CAN\ACK \SOH(\EOTH\NULR\DLEinvalidHereafterB\SI\n\ + \\rnative_script" packedFileDescriptor _ = packedFileDescriptor fieldsByTag = let - coinsPerUtxoByte__field_descriptor - = Data.ProtoLens.FieldDescriptor - "coins_per_utxo_byte" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"coinsPerUtxoByte")) :: - Data.ProtoLens.FieldDescriptor PParams - maxTxSize__field_descriptor - = Data.ProtoLens.FieldDescriptor - "max_tx_size" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"maxTxSize")) :: - Data.ProtoLens.FieldDescriptor PParams - minFeeCoefficient__field_descriptor - = Data.ProtoLens.FieldDescriptor - "min_fee_coefficient" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"minFeeCoefficient")) :: - Data.ProtoLens.FieldDescriptor PParams - minFeeConstant__field_descriptor - = Data.ProtoLens.FieldDescriptor - "min_fee_constant" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"minFeeConstant")) :: - Data.ProtoLens.FieldDescriptor PParams - maxBlockBodySize__field_descriptor - = Data.ProtoLens.FieldDescriptor - "max_block_body_size" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"maxBlockBodySize")) :: - Data.ProtoLens.FieldDescriptor PParams - maxBlockHeaderSize__field_descriptor - = Data.ProtoLens.FieldDescriptor - "max_block_header_size" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"maxBlockHeaderSize")) :: - Data.ProtoLens.FieldDescriptor PParams - stakeKeyDeposit__field_descriptor - = Data.ProtoLens.FieldDescriptor - "stake_key_deposit" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"stakeKeyDeposit")) :: - Data.ProtoLens.FieldDescriptor PParams - poolDeposit__field_descriptor - = Data.ProtoLens.FieldDescriptor - "pool_deposit" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"poolDeposit")) :: - Data.ProtoLens.FieldDescriptor PParams - poolRetirementEpochBound__field_descriptor - = Data.ProtoLens.FieldDescriptor - "pool_retirement_epoch_bound" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"poolRetirementEpochBound")) :: - Data.ProtoLens.FieldDescriptor PParams - desiredNumberOfPools__field_descriptor + scriptPubkey__field_descriptor = Data.ProtoLens.FieldDescriptor - "desired_number_of_pools" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"desiredNumberOfPools")) :: - Data.ProtoLens.FieldDescriptor PParams - poolInfluence__field_descriptor + "script_pubkey" + (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: + Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'scriptPubkey")) :: + Data.ProtoLens.FieldDescriptor NativeScript + scriptAll__field_descriptor = Data.ProtoLens.FieldDescriptor - "pool_influence" + "script_all" (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor RationalNumber) + Data.ProtoLens.FieldTypeDescriptor NativeScriptList) (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'poolInfluence")) :: - Data.ProtoLens.FieldDescriptor PParams - monetaryExpansion__field_descriptor + (Data.ProtoLens.Field.field @"maybe'scriptAll")) :: + Data.ProtoLens.FieldDescriptor NativeScript + scriptAny__field_descriptor = Data.ProtoLens.FieldDescriptor - "monetary_expansion" + "script_any" (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor RationalNumber) + Data.ProtoLens.FieldTypeDescriptor NativeScriptList) (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'monetaryExpansion")) :: - Data.ProtoLens.FieldDescriptor PParams - treasuryExpansion__field_descriptor + (Data.ProtoLens.Field.field @"maybe'scriptAny")) :: + Data.ProtoLens.FieldDescriptor NativeScript + scriptNOfK__field_descriptor = Data.ProtoLens.FieldDescriptor - "treasury_expansion" + "script_n_of_k" (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor RationalNumber) + Data.ProtoLens.FieldTypeDescriptor ScriptNOfK) (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'treasuryExpansion")) :: - Data.ProtoLens.FieldDescriptor PParams - minPoolCost__field_descriptor + (Data.ProtoLens.Field.field @"maybe'scriptNOfK")) :: + Data.ProtoLens.FieldDescriptor NativeScript + invalidBefore__field_descriptor = Data.ProtoLens.FieldDescriptor - "min_pool_cost" + "invalid_before" (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"minPoolCost")) :: - Data.ProtoLens.FieldDescriptor PParams - protocolVersion__field_descriptor - = Data.ProtoLens.FieldDescriptor - "protocol_version" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor ProtocolVersion) (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'protocolVersion")) :: - Data.ProtoLens.FieldDescriptor PParams - maxValueSize__field_descriptor + (Data.ProtoLens.Field.field @"maybe'invalidBefore")) :: + Data.ProtoLens.FieldDescriptor NativeScript + invalidHereafter__field_descriptor = Data.ProtoLens.FieldDescriptor - "max_value_size" + "invalid_hereafter" (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"maxValueSize")) :: - Data.ProtoLens.FieldDescriptor PParams - collateralPercentage__field_descriptor - = Data.ProtoLens.FieldDescriptor - "collateral_percentage" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"collateralPercentage")) :: - Data.ProtoLens.FieldDescriptor PParams - maxCollateralInputs__field_descriptor - = Data.ProtoLens.FieldDescriptor - "max_collateral_inputs" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"maxCollateralInputs")) :: - Data.ProtoLens.FieldDescriptor PParams - costModels__field_descriptor - = Data.ProtoLens.FieldDescriptor - "cost_models" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor CostModels) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'costModels")) :: - Data.ProtoLens.FieldDescriptor PParams - prices__field_descriptor - = Data.ProtoLens.FieldDescriptor - "prices" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor ExPrices) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'prices")) :: - Data.ProtoLens.FieldDescriptor PParams - maxExecutionUnitsPerTransaction__field_descriptor - = Data.ProtoLens.FieldDescriptor - "max_execution_units_per_transaction" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor ExUnits) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field - @"maybe'maxExecutionUnitsPerTransaction")) :: - Data.ProtoLens.FieldDescriptor PParams - maxExecutionUnitsPerBlock__field_descriptor - = Data.ProtoLens.FieldDescriptor - "max_execution_units_per_block" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor ExUnits) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'maxExecutionUnitsPerBlock")) :: - Data.ProtoLens.FieldDescriptor PParams - minFeeScriptRefCostPerByte__field_descriptor - = Data.ProtoLens.FieldDescriptor - "min_fee_script_ref_cost_per_byte" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor RationalNumber) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field - @"maybe'minFeeScriptRefCostPerByte")) :: - Data.ProtoLens.FieldDescriptor PParams - poolVotingThresholds__field_descriptor - = Data.ProtoLens.FieldDescriptor - "pool_voting_thresholds" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor VotingThresholds) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'poolVotingThresholds")) :: - Data.ProtoLens.FieldDescriptor PParams - drepVotingThresholds__field_descriptor - = Data.ProtoLens.FieldDescriptor - "drep_voting_thresholds" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor VotingThresholds) (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'drepVotingThresholds")) :: - Data.ProtoLens.FieldDescriptor PParams - minCommitteeSize__field_descriptor - = Data.ProtoLens.FieldDescriptor - "min_committee_size" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt32Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"minCommitteeSize")) :: - Data.ProtoLens.FieldDescriptor PParams - committeeTermLimit__field_descriptor - = Data.ProtoLens.FieldDescriptor - "committee_term_limit" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"committeeTermLimit")) :: - Data.ProtoLens.FieldDescriptor PParams - governanceActionValidityPeriod__field_descriptor - = Data.ProtoLens.FieldDescriptor - "governance_action_validity_period" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"governanceActionValidityPeriod")) :: - Data.ProtoLens.FieldDescriptor PParams - governanceActionDeposit__field_descriptor - = Data.ProtoLens.FieldDescriptor - "governance_action_deposit" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"governanceActionDeposit")) :: - Data.ProtoLens.FieldDescriptor PParams - drepDeposit__field_descriptor - = Data.ProtoLens.FieldDescriptor - "drep_deposit" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"drepDeposit")) :: - Data.ProtoLens.FieldDescriptor PParams - drepInactivityPeriod__field_descriptor - = Data.ProtoLens.FieldDescriptor - "drep_inactivity_period" - (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"drepInactivityPeriod")) :: - Data.ProtoLens.FieldDescriptor PParams + (Data.ProtoLens.Field.field @"maybe'invalidHereafter")) :: + Data.ProtoLens.FieldDescriptor NativeScript in Data.Map.fromList - [(Data.ProtoLens.Tag 1, coinsPerUtxoByte__field_descriptor), - (Data.ProtoLens.Tag 2, maxTxSize__field_descriptor), - (Data.ProtoLens.Tag 3, minFeeCoefficient__field_descriptor), - (Data.ProtoLens.Tag 4, minFeeConstant__field_descriptor), - (Data.ProtoLens.Tag 5, maxBlockBodySize__field_descriptor), - (Data.ProtoLens.Tag 6, maxBlockHeaderSize__field_descriptor), - (Data.ProtoLens.Tag 7, stakeKeyDeposit__field_descriptor), - (Data.ProtoLens.Tag 8, poolDeposit__field_descriptor), - (Data.ProtoLens.Tag 9, poolRetirementEpochBound__field_descriptor), - (Data.ProtoLens.Tag 10, desiredNumberOfPools__field_descriptor), - (Data.ProtoLens.Tag 11, poolInfluence__field_descriptor), - (Data.ProtoLens.Tag 12, monetaryExpansion__field_descriptor), - (Data.ProtoLens.Tag 13, treasuryExpansion__field_descriptor), - (Data.ProtoLens.Tag 14, minPoolCost__field_descriptor), - (Data.ProtoLens.Tag 15, protocolVersion__field_descriptor), - (Data.ProtoLens.Tag 16, maxValueSize__field_descriptor), - (Data.ProtoLens.Tag 17, collateralPercentage__field_descriptor), - (Data.ProtoLens.Tag 18, maxCollateralInputs__field_descriptor), - (Data.ProtoLens.Tag 19, costModels__field_descriptor), - (Data.ProtoLens.Tag 20, prices__field_descriptor), - (Data.ProtoLens.Tag 21, - maxExecutionUnitsPerTransaction__field_descriptor), - (Data.ProtoLens.Tag 22, - maxExecutionUnitsPerBlock__field_descriptor), - (Data.ProtoLens.Tag 23, - minFeeScriptRefCostPerByte__field_descriptor), - (Data.ProtoLens.Tag 24, poolVotingThresholds__field_descriptor), - (Data.ProtoLens.Tag 25, drepVotingThresholds__field_descriptor), - (Data.ProtoLens.Tag 26, minCommitteeSize__field_descriptor), - (Data.ProtoLens.Tag 27, committeeTermLimit__field_descriptor), - (Data.ProtoLens.Tag 28, - governanceActionValidityPeriod__field_descriptor), - (Data.ProtoLens.Tag 29, governanceActionDeposit__field_descriptor), - (Data.ProtoLens.Tag 30, drepDeposit__field_descriptor), - (Data.ProtoLens.Tag 31, drepInactivityPeriod__field_descriptor)] + [(Data.ProtoLens.Tag 1, scriptPubkey__field_descriptor), + (Data.ProtoLens.Tag 2, scriptAll__field_descriptor), + (Data.ProtoLens.Tag 3, scriptAny__field_descriptor), + (Data.ProtoLens.Tag 4, scriptNOfK__field_descriptor), + (Data.ProtoLens.Tag 5, invalidBefore__field_descriptor), + (Data.ProtoLens.Tag 6, invalidHereafter__field_descriptor)] unknownFields = Lens.Family2.Unchecked.lens - _PParams'_unknownFields - (\ x__ y__ -> x__ {_PParams'_unknownFields = y__}) + _NativeScript'_unknownFields + (\ x__ y__ -> x__ {_NativeScript'_unknownFields = y__}) defMessage - = PParams'_constructor - {_PParams'coinsPerUtxoByte = Data.ProtoLens.fieldDefault, - _PParams'maxTxSize = Data.ProtoLens.fieldDefault, - _PParams'minFeeCoefficient = Data.ProtoLens.fieldDefault, - _PParams'minFeeConstant = Data.ProtoLens.fieldDefault, - _PParams'maxBlockBodySize = Data.ProtoLens.fieldDefault, - _PParams'maxBlockHeaderSize = Data.ProtoLens.fieldDefault, - _PParams'stakeKeyDeposit = Data.ProtoLens.fieldDefault, - _PParams'poolDeposit = Data.ProtoLens.fieldDefault, - _PParams'poolRetirementEpochBound = Data.ProtoLens.fieldDefault, - _PParams'desiredNumberOfPools = Data.ProtoLens.fieldDefault, - _PParams'poolInfluence = Prelude.Nothing, - _PParams'monetaryExpansion = Prelude.Nothing, - _PParams'treasuryExpansion = Prelude.Nothing, - _PParams'minPoolCost = Data.ProtoLens.fieldDefault, - _PParams'protocolVersion = Prelude.Nothing, - _PParams'maxValueSize = Data.ProtoLens.fieldDefault, - _PParams'collateralPercentage = Data.ProtoLens.fieldDefault, - _PParams'maxCollateralInputs = Data.ProtoLens.fieldDefault, - _PParams'costModels = Prelude.Nothing, - _PParams'prices = Prelude.Nothing, - _PParams'maxExecutionUnitsPerTransaction = Prelude.Nothing, - _PParams'maxExecutionUnitsPerBlock = Prelude.Nothing, - _PParams'minFeeScriptRefCostPerByte = Prelude.Nothing, - _PParams'poolVotingThresholds = Prelude.Nothing, - _PParams'drepVotingThresholds = Prelude.Nothing, - _PParams'minCommitteeSize = Data.ProtoLens.fieldDefault, - _PParams'committeeTermLimit = Data.ProtoLens.fieldDefault, - _PParams'governanceActionValidityPeriod = Data.ProtoLens.fieldDefault, - _PParams'governanceActionDeposit = Data.ProtoLens.fieldDefault, - _PParams'drepDeposit = Data.ProtoLens.fieldDefault, - _PParams'drepInactivityPeriod = Data.ProtoLens.fieldDefault, - _PParams'_unknownFields = []} + = NativeScript'_constructor + {_NativeScript'nativeScript = Prelude.Nothing, + _NativeScript'_unknownFields = []} parseMessage = let - loop :: PParams -> Data.ProtoLens.Encoding.Bytes.Parser PParams + loop :: + NativeScript -> Data.ProtoLens.Encoding.Bytes.Parser NativeScript loop x = do end <- Data.ProtoLens.Encoding.Bytes.atEnd if end then @@ -2262,319 +2334,1411 @@ instance Data.ProtoLens.Message PParams where else do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt case tag of - 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "coins_per_utxo_byte" + 10 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.getBytes + (Prelude.fromIntegral len)) + "script_pubkey" loop (Lens.Family2.set - (Data.ProtoLens.Field.field @"coinsPerUtxoByte") y x) - 16 + (Data.ProtoLens.Field.field @"scriptPubkey") y x) + 18 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "max_tx_size" + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "script_all" loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"maxTxSize") y x) - 24 + (Lens.Family2.set (Data.ProtoLens.Field.field @"scriptAll") y x) + 26 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "min_fee_coefficient" + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "script_any" loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"minFeeCoefficient") y x) - 32 + (Lens.Family2.set (Data.ProtoLens.Field.field @"scriptAny") y x) + 34 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "min_fee_constant" + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "script_n_of_k" loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"minFeeConstant") y x) + (Lens.Family2.set (Data.ProtoLens.Field.field @"scriptNOfK") y x) 40 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "max_block_body_size" + Data.ProtoLens.Encoding.Bytes.getVarInt "invalid_before" loop (Lens.Family2.set - (Data.ProtoLens.Field.field @"maxBlockBodySize") y x) + (Data.ProtoLens.Field.field @"invalidBefore") y x) 48 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt - "max_block_header_size" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"maxBlockHeaderSize") y x) - 56 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "stake_key_deposit" + Data.ProtoLens.Encoding.Bytes.getVarInt "invalid_hereafter" loop (Lens.Family2.set - (Data.ProtoLens.Field.field @"stakeKeyDeposit") y x) - 64 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "pool_deposit" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"poolDeposit") y x) - 72 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt - "pool_retirement_epoch_bound" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"poolRetirementEpochBound") y x) - 80 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt - "desired_number_of_pools" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"desiredNumberOfPools") y x) - 90 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "pool_influence" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"poolInfluence") y x) - 98 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "monetary_expansion" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"monetaryExpansion") y x) - 106 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "treasury_expansion" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"treasuryExpansion") y x) - 112 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "min_pool_cost" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"minPoolCost") y x) - 122 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "protocol_version" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"protocolVersion") y x) - 128 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "max_value_size" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"maxValueSize") y x) - 136 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt - "collateral_percentage" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"collateralPercentage") y x) - 144 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt - "max_collateral_inputs" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"maxCollateralInputs") y x) - 154 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "cost_models" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"costModels") y x) - 162 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "prices" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"prices") y x) - 170 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "max_execution_units_per_transaction" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"maxExecutionUnitsPerTransaction") - y x) - 178 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "max_execution_units_per_block" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"maxExecutionUnitsPerBlock") y x) - 186 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "min_fee_script_ref_cost_per_byte" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"minFeeScriptRefCostPerByte") y x) - 194 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "pool_voting_thresholds" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"poolVotingThresholds") y x) - 202 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "drep_voting_thresholds" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"drepVotingThresholds") y x) - 208 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (Prelude.fmap - Prelude.fromIntegral - Data.ProtoLens.Encoding.Bytes.getVarInt) - "min_committee_size" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"minCommitteeSize") y x) - 216 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt - "committee_term_limit" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"committeeTermLimit") y x) - 224 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt - "governance_action_validity_period" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"governanceActionValidityPeriod") - y x) - 232 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt - "governance_action_deposit" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"governanceActionDeposit") y x) - 240 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt "drep_deposit" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"drepDeposit") y x) - 248 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - Data.ProtoLens.Encoding.Bytes.getVarInt - "drep_inactivity_period" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"drepInactivityPeriod") y x) - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire + (Data.ProtoLens.Field.field @"invalidHereafter") y x) + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire loop (Lens.Family2.over Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) in (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "PParams" + (do loop Data.ProtoLens.defMessage) "NativeScript" buildMessage = \ _x -> (Data.Monoid.<>) - (let - _v - = Lens.Family2.view - (Data.ProtoLens.Field.field @"coinsPerUtxoByte") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 8) - (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) - ((Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"maxTxSize") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 16) - (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) - ((Data.Monoid.<>) - (let - _v - = Lens.Family2.view - (Data.ProtoLens.Field.field @"minFeeCoefficient") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 24) - (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) - ((Data.Monoid.<>) - (let - _v - = Lens.Family2.view - (Data.ProtoLens.Field.field @"minFeeConstant") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 32) - (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) - ((Data.Monoid.<>) - (let - _v - = Lens.Family2.view - (Data.ProtoLens.Field.field @"maxBlockBodySize") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 40) - (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) - ((Data.Monoid.<>) - (let - _v - = Lens.Family2.view - (Data.ProtoLens.Field.field @"maxBlockHeaderSize") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 48) - (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) - ((Data.Monoid.<>) - (let - _v - = Lens.Family2.view - (Data.ProtoLens.Field.field @"stakeKeyDeposit") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then + (case + Lens.Family2.view + (Data.ProtoLens.Field.field @"maybe'nativeScript") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just (NativeScript'ScriptPubkey v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 10) + ((\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + v) + (Prelude.Just (NativeScript'ScriptAll v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 18) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage v) + (Prelude.Just (NativeScript'ScriptAny v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 26) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage v) + (Prelude.Just (NativeScript'ScriptNOfK v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 34) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage v) + (Prelude.Just (NativeScript'InvalidBefore v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 40) + (Data.ProtoLens.Encoding.Bytes.putVarInt v) + (Prelude.Just (NativeScript'InvalidHereafter v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 48) + (Data.ProtoLens.Encoding.Bytes.putVarInt v)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)) +instance Control.DeepSeq.NFData NativeScript where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_NativeScript'_unknownFields x__) + (Control.DeepSeq.deepseq (_NativeScript'nativeScript x__) ()) +instance Control.DeepSeq.NFData NativeScript'NativeScript where + rnf (NativeScript'ScriptPubkey x__) = Control.DeepSeq.rnf x__ + rnf (NativeScript'ScriptAll x__) = Control.DeepSeq.rnf x__ + rnf (NativeScript'ScriptAny x__) = Control.DeepSeq.rnf x__ + rnf (NativeScript'ScriptNOfK x__) = Control.DeepSeq.rnf x__ + rnf (NativeScript'InvalidBefore x__) = Control.DeepSeq.rnf x__ + rnf (NativeScript'InvalidHereafter x__) = Control.DeepSeq.rnf x__ +_NativeScript'ScriptPubkey :: + Data.ProtoLens.Prism.Prism' NativeScript'NativeScript Data.ByteString.ByteString +_NativeScript'ScriptPubkey + = Data.ProtoLens.Prism.prism' + NativeScript'ScriptPubkey + (\ p__ + -> case p__ of + (NativeScript'ScriptPubkey p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_NativeScript'ScriptAll :: + Data.ProtoLens.Prism.Prism' NativeScript'NativeScript NativeScriptList +_NativeScript'ScriptAll + = Data.ProtoLens.Prism.prism' + NativeScript'ScriptAll + (\ p__ + -> case p__ of + (NativeScript'ScriptAll p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_NativeScript'ScriptAny :: + Data.ProtoLens.Prism.Prism' NativeScript'NativeScript NativeScriptList +_NativeScript'ScriptAny + = Data.ProtoLens.Prism.prism' + NativeScript'ScriptAny + (\ p__ + -> case p__ of + (NativeScript'ScriptAny p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_NativeScript'ScriptNOfK :: + Data.ProtoLens.Prism.Prism' NativeScript'NativeScript ScriptNOfK +_NativeScript'ScriptNOfK + = Data.ProtoLens.Prism.prism' + NativeScript'ScriptNOfK + (\ p__ + -> case p__ of + (NativeScript'ScriptNOfK p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_NativeScript'InvalidBefore :: + Data.ProtoLens.Prism.Prism' NativeScript'NativeScript Data.Word.Word64 +_NativeScript'InvalidBefore + = Data.ProtoLens.Prism.prism' + NativeScript'InvalidBefore + (\ p__ + -> case p__ of + (NativeScript'InvalidBefore p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_NativeScript'InvalidHereafter :: + Data.ProtoLens.Prism.Prism' NativeScript'NativeScript Data.Word.Word64 +_NativeScript'InvalidHereafter + = Data.ProtoLens.Prism.prism' + NativeScript'InvalidHereafter + (\ p__ + -> case p__ of + (NativeScript'InvalidHereafter p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +{- | Fields : + + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.items' @:: Lens' NativeScriptList [NativeScript]@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.vec'items' @:: Lens' NativeScriptList (Data.Vector.Vector NativeScript)@ -} +data NativeScriptList + = NativeScriptList'_constructor {_NativeScriptList'items :: !(Data.Vector.Vector NativeScript), + _NativeScriptList'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show NativeScriptList where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +instance Data.ProtoLens.Field.HasField NativeScriptList "items" [NativeScript] where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _NativeScriptList'items + (\ x__ y__ -> x__ {_NativeScriptList'items = y__})) + (Lens.Family2.Unchecked.lens + Data.Vector.Generic.toList + (\ _ y__ -> Data.Vector.Generic.fromList y__)) +instance Data.ProtoLens.Field.HasField NativeScriptList "vec'items" (Data.Vector.Vector NativeScript) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _NativeScriptList'items + (\ x__ y__ -> x__ {_NativeScriptList'items = y__})) + Prelude.id +instance Data.ProtoLens.Message NativeScriptList where + messageName _ + = Data.Text.pack "utxorpc.v1alpha.cardano.NativeScriptList" + packedMessageDescriptor _ + = "\n\ + \\DLENativeScriptList\DC2;\n\ + \\ENQitems\CAN\SOH \ETX(\v2%.utxorpc.v1alpha.cardano.NativeScriptR\ENQitems" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + items__field_descriptor + = Data.ProtoLens.FieldDescriptor + "items" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor NativeScript) + (Data.ProtoLens.RepeatedField + Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"items")) :: + Data.ProtoLens.FieldDescriptor NativeScriptList + in + Data.Map.fromList [(Data.ProtoLens.Tag 1, items__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _NativeScriptList'_unknownFields + (\ x__ y__ -> x__ {_NativeScriptList'_unknownFields = y__}) + defMessage + = NativeScriptList'_constructor + {_NativeScriptList'items = Data.Vector.Generic.empty, + _NativeScriptList'_unknownFields = []} + parseMessage + = let + loop :: + NativeScriptList + -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld NativeScript + -> Data.ProtoLens.Encoding.Bytes.Parser NativeScriptList + loop x mutable'items + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do frozen'items <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'items) + (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) + (Lens.Family2.set + (Data.ProtoLens.Field.field @"vec'items") frozen'items x)) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 10 + -> do !y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) + Data.ProtoLens.parseMessage) + "items" + v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.append mutable'items y) + loop x v + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + mutable'items + in + (Data.ProtoLens.Encoding.Bytes.) + (do mutable'items <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + Data.ProtoLens.Encoding.Growing.new + loop Data.ProtoLens.defMessage mutable'items) + "NativeScriptList" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.foldMapBuilder + (\ _v + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 10) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'items") _x)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)) +instance Control.DeepSeq.NFData NativeScriptList where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_NativeScriptList'_unknownFields x__) + (Control.DeepSeq.deepseq (_NativeScriptList'items x__) ()) +{- | Fields : + + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.coinsPerUtxoByte' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxTxSize' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minFeeCoefficient' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minFeeConstant' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxBlockBodySize' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxBlockHeaderSize' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.stakeKeyDeposit' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.poolDeposit' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.poolRetirementEpochBound' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.desiredNumberOfPools' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.poolInfluence' @:: Lens' PParams RationalNumber@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'poolInfluence' @:: Lens' PParams (Prelude.Maybe RationalNumber)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.monetaryExpansion' @:: Lens' PParams RationalNumber@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'monetaryExpansion' @:: Lens' PParams (Prelude.Maybe RationalNumber)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.treasuryExpansion' @:: Lens' PParams RationalNumber@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'treasuryExpansion' @:: Lens' PParams (Prelude.Maybe RationalNumber)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minPoolCost' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.protocolVersion' @:: Lens' PParams ProtocolVersion@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'protocolVersion' @:: Lens' PParams (Prelude.Maybe ProtocolVersion)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxValueSize' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.collateralPercentage' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxCollateralInputs' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.costModels' @:: Lens' PParams CostModels@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'costModels' @:: Lens' PParams (Prelude.Maybe CostModels)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.prices' @:: Lens' PParams ExPrices@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'prices' @:: Lens' PParams (Prelude.Maybe ExPrices)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxExecutionUnitsPerTransaction' @:: Lens' PParams ExUnits@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'maxExecutionUnitsPerTransaction' @:: Lens' PParams (Prelude.Maybe ExUnits)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maxExecutionUnitsPerBlock' @:: Lens' PParams ExUnits@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'maxExecutionUnitsPerBlock' @:: Lens' PParams (Prelude.Maybe ExUnits)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minFeeScriptRefCostPerByte' @:: Lens' PParams RationalNumber@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'minFeeScriptRefCostPerByte' @:: Lens' PParams (Prelude.Maybe RationalNumber)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.poolVotingThresholds' @:: Lens' PParams VotingThresholds@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'poolVotingThresholds' @:: Lens' PParams (Prelude.Maybe VotingThresholds)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.drepVotingThresholds' @:: Lens' PParams VotingThresholds@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'drepVotingThresholds' @:: Lens' PParams (Prelude.Maybe VotingThresholds)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.minCommitteeSize' @:: Lens' PParams Data.Word.Word32@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.committeeTermLimit' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.governanceActionValidityPeriod' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.governanceActionDeposit' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.drepDeposit' @:: Lens' PParams Data.Word.Word64@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.drepInactivityPeriod' @:: Lens' PParams Data.Word.Word64@ -} +data PParams + = PParams'_constructor {_PParams'coinsPerUtxoByte :: !Data.Word.Word64, + _PParams'maxTxSize :: !Data.Word.Word64, + _PParams'minFeeCoefficient :: !Data.Word.Word64, + _PParams'minFeeConstant :: !Data.Word.Word64, + _PParams'maxBlockBodySize :: !Data.Word.Word64, + _PParams'maxBlockHeaderSize :: !Data.Word.Word64, + _PParams'stakeKeyDeposit :: !Data.Word.Word64, + _PParams'poolDeposit :: !Data.Word.Word64, + _PParams'poolRetirementEpochBound :: !Data.Word.Word64, + _PParams'desiredNumberOfPools :: !Data.Word.Word64, + _PParams'poolInfluence :: !(Prelude.Maybe RationalNumber), + _PParams'monetaryExpansion :: !(Prelude.Maybe RationalNumber), + _PParams'treasuryExpansion :: !(Prelude.Maybe RationalNumber), + _PParams'minPoolCost :: !Data.Word.Word64, + _PParams'protocolVersion :: !(Prelude.Maybe ProtocolVersion), + _PParams'maxValueSize :: !Data.Word.Word64, + _PParams'collateralPercentage :: !Data.Word.Word64, + _PParams'maxCollateralInputs :: !Data.Word.Word64, + _PParams'costModels :: !(Prelude.Maybe CostModels), + _PParams'prices :: !(Prelude.Maybe ExPrices), + _PParams'maxExecutionUnitsPerTransaction :: !(Prelude.Maybe ExUnits), + _PParams'maxExecutionUnitsPerBlock :: !(Prelude.Maybe ExUnits), + _PParams'minFeeScriptRefCostPerByte :: !(Prelude.Maybe RationalNumber), + _PParams'poolVotingThresholds :: !(Prelude.Maybe VotingThresholds), + _PParams'drepVotingThresholds :: !(Prelude.Maybe VotingThresholds), + _PParams'minCommitteeSize :: !Data.Word.Word32, + _PParams'committeeTermLimit :: !Data.Word.Word64, + _PParams'governanceActionValidityPeriod :: !Data.Word.Word64, + _PParams'governanceActionDeposit :: !Data.Word.Word64, + _PParams'drepDeposit :: !Data.Word.Word64, + _PParams'drepInactivityPeriod :: !Data.Word.Word64, + _PParams'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show PParams where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +instance Data.ProtoLens.Field.HasField PParams "coinsPerUtxoByte" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'coinsPerUtxoByte + (\ x__ y__ -> x__ {_PParams'coinsPerUtxoByte = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "maxTxSize" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'maxTxSize (\ x__ y__ -> x__ {_PParams'maxTxSize = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "minFeeCoefficient" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'minFeeCoefficient + (\ x__ y__ -> x__ {_PParams'minFeeCoefficient = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "minFeeConstant" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'minFeeConstant + (\ x__ y__ -> x__ {_PParams'minFeeConstant = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "maxBlockBodySize" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'maxBlockBodySize + (\ x__ y__ -> x__ {_PParams'maxBlockBodySize = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "maxBlockHeaderSize" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'maxBlockHeaderSize + (\ x__ y__ -> x__ {_PParams'maxBlockHeaderSize = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "stakeKeyDeposit" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'stakeKeyDeposit + (\ x__ y__ -> x__ {_PParams'stakeKeyDeposit = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "poolDeposit" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'poolDeposit + (\ x__ y__ -> x__ {_PParams'poolDeposit = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "poolRetirementEpochBound" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'poolRetirementEpochBound + (\ x__ y__ -> x__ {_PParams'poolRetirementEpochBound = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "desiredNumberOfPools" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'desiredNumberOfPools + (\ x__ y__ -> x__ {_PParams'desiredNumberOfPools = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "poolInfluence" RationalNumber where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'poolInfluence + (\ x__ y__ -> x__ {_PParams'poolInfluence = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'poolInfluence" (Prelude.Maybe RationalNumber) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'poolInfluence + (\ x__ y__ -> x__ {_PParams'poolInfluence = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "monetaryExpansion" RationalNumber where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'monetaryExpansion + (\ x__ y__ -> x__ {_PParams'monetaryExpansion = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'monetaryExpansion" (Prelude.Maybe RationalNumber) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'monetaryExpansion + (\ x__ y__ -> x__ {_PParams'monetaryExpansion = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "treasuryExpansion" RationalNumber where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'treasuryExpansion + (\ x__ y__ -> x__ {_PParams'treasuryExpansion = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'treasuryExpansion" (Prelude.Maybe RationalNumber) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'treasuryExpansion + (\ x__ y__ -> x__ {_PParams'treasuryExpansion = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "minPoolCost" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'minPoolCost + (\ x__ y__ -> x__ {_PParams'minPoolCost = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "protocolVersion" ProtocolVersion where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'protocolVersion + (\ x__ y__ -> x__ {_PParams'protocolVersion = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'protocolVersion" (Prelude.Maybe ProtocolVersion) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'protocolVersion + (\ x__ y__ -> x__ {_PParams'protocolVersion = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "maxValueSize" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'maxValueSize + (\ x__ y__ -> x__ {_PParams'maxValueSize = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "collateralPercentage" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'collateralPercentage + (\ x__ y__ -> x__ {_PParams'collateralPercentage = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "maxCollateralInputs" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'maxCollateralInputs + (\ x__ y__ -> x__ {_PParams'maxCollateralInputs = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "costModels" CostModels where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'costModels (\ x__ y__ -> x__ {_PParams'costModels = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'costModels" (Prelude.Maybe CostModels) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'costModels (\ x__ y__ -> x__ {_PParams'costModels = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "prices" ExPrices where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'prices (\ x__ y__ -> x__ {_PParams'prices = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'prices" (Prelude.Maybe ExPrices) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'prices (\ x__ y__ -> x__ {_PParams'prices = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "maxExecutionUnitsPerTransaction" ExUnits where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'maxExecutionUnitsPerTransaction + (\ x__ y__ + -> x__ {_PParams'maxExecutionUnitsPerTransaction = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'maxExecutionUnitsPerTransaction" (Prelude.Maybe ExUnits) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'maxExecutionUnitsPerTransaction + (\ x__ y__ + -> x__ {_PParams'maxExecutionUnitsPerTransaction = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "maxExecutionUnitsPerBlock" ExUnits where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'maxExecutionUnitsPerBlock + (\ x__ y__ -> x__ {_PParams'maxExecutionUnitsPerBlock = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'maxExecutionUnitsPerBlock" (Prelude.Maybe ExUnits) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'maxExecutionUnitsPerBlock + (\ x__ y__ -> x__ {_PParams'maxExecutionUnitsPerBlock = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "minFeeScriptRefCostPerByte" RationalNumber where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'minFeeScriptRefCostPerByte + (\ x__ y__ -> x__ {_PParams'minFeeScriptRefCostPerByte = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'minFeeScriptRefCostPerByte" (Prelude.Maybe RationalNumber) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'minFeeScriptRefCostPerByte + (\ x__ y__ -> x__ {_PParams'minFeeScriptRefCostPerByte = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "poolVotingThresholds" VotingThresholds where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'poolVotingThresholds + (\ x__ y__ -> x__ {_PParams'poolVotingThresholds = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'poolVotingThresholds" (Prelude.Maybe VotingThresholds) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'poolVotingThresholds + (\ x__ y__ -> x__ {_PParams'poolVotingThresholds = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "drepVotingThresholds" VotingThresholds where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'drepVotingThresholds + (\ x__ y__ -> x__ {_PParams'drepVotingThresholds = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PParams "maybe'drepVotingThresholds" (Prelude.Maybe VotingThresholds) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'drepVotingThresholds + (\ x__ y__ -> x__ {_PParams'drepVotingThresholds = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "minCommitteeSize" Data.Word.Word32 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'minCommitteeSize + (\ x__ y__ -> x__ {_PParams'minCommitteeSize = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "committeeTermLimit" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'committeeTermLimit + (\ x__ y__ -> x__ {_PParams'committeeTermLimit = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "governanceActionValidityPeriod" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'governanceActionValidityPeriod + (\ x__ y__ -> x__ {_PParams'governanceActionValidityPeriod = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "governanceActionDeposit" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'governanceActionDeposit + (\ x__ y__ -> x__ {_PParams'governanceActionDeposit = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "drepDeposit" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'drepDeposit + (\ x__ y__ -> x__ {_PParams'drepDeposit = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PParams "drepInactivityPeriod" Data.Word.Word64 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PParams'drepInactivityPeriod + (\ x__ y__ -> x__ {_PParams'drepInactivityPeriod = y__})) + Prelude.id +instance Data.ProtoLens.Message PParams where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.PParams" + packedMessageDescriptor _ + = "\n\ + \\aPParams\DC21\n\ + \\DC3coins_per_utxo_byte\CAN\SOH \SOH(\EOTR\DLEcoinsPerUtxoByteB\STX0\SOH\DC2\"\n\ + \\vmax_tx_size\CAN\STX \SOH(\EOTR\tmaxTxSizeB\STX0\SOH\DC22\n\ + \\DC3min_fee_coefficient\CAN\ETX \SOH(\EOTR\DC1minFeeCoefficientB\STX0\SOH\DC2,\n\ + \\DLEmin_fee_constant\CAN\EOT \SOH(\EOTR\SOminFeeConstantB\STX0\SOH\DC21\n\ + \\DC3max_block_body_size\CAN\ENQ \SOH(\EOTR\DLEmaxBlockBodySizeB\STX0\SOH\DC25\n\ + \\NAKmax_block_header_size\CAN\ACK \SOH(\EOTR\DC2maxBlockHeaderSizeB\STX0\SOH\DC2.\n\ + \\DC1stake_key_deposit\CAN\a \SOH(\EOTR\SIstakeKeyDepositB\STX0\SOH\DC2%\n\ + \\fpool_deposit\CAN\b \SOH(\EOTR\vpoolDepositB\STX0\SOH\DC2=\n\ + \\ESCpool_retirement_epoch_bound\CAN\t \SOH(\EOTR\CANpoolRetirementEpochBound\DC25\n\ + \\ETBdesired_number_of_pools\CAN\n\ + \ \SOH(\EOTR\DC4desiredNumberOfPools\DC2N\n\ + \\SOpool_influence\CAN\v \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\rpoolInfluence\DC2V\n\ + \\DC2monetary_expansion\CAN\f \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\DC1monetaryExpansion\DC2V\n\ + \\DC2treasury_expansion\CAN\r \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\DC1treasuryExpansion\DC2&\n\ + \\rmin_pool_cost\CAN\SO \SOH(\EOTR\vminPoolCostB\STX0\SOH\DC2S\n\ + \\DLEprotocol_version\CAN\SI \SOH(\v2(.utxorpc.v1alpha.cardano.ProtocolVersionR\SIprotocolVersion\DC2(\n\ + \\SOmax_value_size\CAN\DLE \SOH(\EOTR\fmaxValueSizeB\STX0\SOH\DC27\n\ + \\NAKcollateral_percentage\CAN\DC1 \SOH(\EOTR\DC4collateralPercentageB\STX0\SOH\DC26\n\ + \\NAKmax_collateral_inputs\CAN\DC2 \SOH(\EOTR\DC3maxCollateralInputsB\STX0\SOH\DC2D\n\ + \\vcost_models\CAN\DC3 \SOH(\v2#.utxorpc.v1alpha.cardano.CostModelsR\n\ + \costModels\DC29\n\ + \\ACKprices\CAN\DC4 \SOH(\v2!.utxorpc.v1alpha.cardano.ExPricesR\ACKprices\DC2n\n\ + \#max_execution_units_per_transaction\CAN\NAK \SOH(\v2 .utxorpc.v1alpha.cardano.ExUnitsR\USmaxExecutionUnitsPerTransaction\DC2b\n\ + \\GSmax_execution_units_per_block\CAN\SYN \SOH(\v2 .utxorpc.v1alpha.cardano.ExUnitsR\EMmaxExecutionUnitsPerBlock\DC2m\n\ + \ min_fee_script_ref_cost_per_byte\CAN\ETB \SOH(\v2'.utxorpc.v1alpha.cardano.RationalNumberR\SUBminFeeScriptRefCostPerByte\DC2_\n\ + \\SYNpool_voting_thresholds\CAN\CAN \SOH(\v2).utxorpc.v1alpha.cardano.VotingThresholdsR\DC4poolVotingThresholds\DC2_\n\ + \\SYNdrep_voting_thresholds\CAN\EM \SOH(\v2).utxorpc.v1alpha.cardano.VotingThresholdsR\DC4drepVotingThresholds\DC2,\n\ + \\DC2min_committee_size\CAN\SUB \SOH(\rR\DLEminCommitteeSize\DC20\n\ + \\DC4committee_term_limit\CAN\ESC \SOH(\EOTR\DC2committeeTermLimit\DC2I\n\ + \!governance_action_validity_period\CAN\FS \SOH(\EOTR\RSgovernanceActionValidityPeriod\DC2>\n\ + \\EMgovernance_action_deposit\CAN\GS \SOH(\EOTR\ETBgovernanceActionDepositB\STX0\SOH\DC2%\n\ + \\fdrep_deposit\CAN\RS \SOH(\EOTR\vdrepDepositB\STX0\SOH\DC24\n\ + \\SYNdrep_inactivity_period\CAN\US \SOH(\EOTR\DC4drepInactivityPeriod" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + coinsPerUtxoByte__field_descriptor + = Data.ProtoLens.FieldDescriptor + "coins_per_utxo_byte" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"coinsPerUtxoByte")) :: + Data.ProtoLens.FieldDescriptor PParams + maxTxSize__field_descriptor + = Data.ProtoLens.FieldDescriptor + "max_tx_size" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"maxTxSize")) :: + Data.ProtoLens.FieldDescriptor PParams + minFeeCoefficient__field_descriptor + = Data.ProtoLens.FieldDescriptor + "min_fee_coefficient" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"minFeeCoefficient")) :: + Data.ProtoLens.FieldDescriptor PParams + minFeeConstant__field_descriptor + = Data.ProtoLens.FieldDescriptor + "min_fee_constant" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"minFeeConstant")) :: + Data.ProtoLens.FieldDescriptor PParams + maxBlockBodySize__field_descriptor + = Data.ProtoLens.FieldDescriptor + "max_block_body_size" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"maxBlockBodySize")) :: + Data.ProtoLens.FieldDescriptor PParams + maxBlockHeaderSize__field_descriptor + = Data.ProtoLens.FieldDescriptor + "max_block_header_size" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"maxBlockHeaderSize")) :: + Data.ProtoLens.FieldDescriptor PParams + stakeKeyDeposit__field_descriptor + = Data.ProtoLens.FieldDescriptor + "stake_key_deposit" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"stakeKeyDeposit")) :: + Data.ProtoLens.FieldDescriptor PParams + poolDeposit__field_descriptor + = Data.ProtoLens.FieldDescriptor + "pool_deposit" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"poolDeposit")) :: + Data.ProtoLens.FieldDescriptor PParams + poolRetirementEpochBound__field_descriptor + = Data.ProtoLens.FieldDescriptor + "pool_retirement_epoch_bound" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"poolRetirementEpochBound")) :: + Data.ProtoLens.FieldDescriptor PParams + desiredNumberOfPools__field_descriptor + = Data.ProtoLens.FieldDescriptor + "desired_number_of_pools" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"desiredNumberOfPools")) :: + Data.ProtoLens.FieldDescriptor PParams + poolInfluence__field_descriptor + = Data.ProtoLens.FieldDescriptor + "pool_influence" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor RationalNumber) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'poolInfluence")) :: + Data.ProtoLens.FieldDescriptor PParams + monetaryExpansion__field_descriptor + = Data.ProtoLens.FieldDescriptor + "monetary_expansion" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor RationalNumber) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'monetaryExpansion")) :: + Data.ProtoLens.FieldDescriptor PParams + treasuryExpansion__field_descriptor + = Data.ProtoLens.FieldDescriptor + "treasury_expansion" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor RationalNumber) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'treasuryExpansion")) :: + Data.ProtoLens.FieldDescriptor PParams + minPoolCost__field_descriptor + = Data.ProtoLens.FieldDescriptor + "min_pool_cost" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"minPoolCost")) :: + Data.ProtoLens.FieldDescriptor PParams + protocolVersion__field_descriptor + = Data.ProtoLens.FieldDescriptor + "protocol_version" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor ProtocolVersion) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'protocolVersion")) :: + Data.ProtoLens.FieldDescriptor PParams + maxValueSize__field_descriptor + = Data.ProtoLens.FieldDescriptor + "max_value_size" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"maxValueSize")) :: + Data.ProtoLens.FieldDescriptor PParams + collateralPercentage__field_descriptor + = Data.ProtoLens.FieldDescriptor + "collateral_percentage" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"collateralPercentage")) :: + Data.ProtoLens.FieldDescriptor PParams + maxCollateralInputs__field_descriptor + = Data.ProtoLens.FieldDescriptor + "max_collateral_inputs" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"maxCollateralInputs")) :: + Data.ProtoLens.FieldDescriptor PParams + costModels__field_descriptor + = Data.ProtoLens.FieldDescriptor + "cost_models" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor CostModels) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'costModels")) :: + Data.ProtoLens.FieldDescriptor PParams + prices__field_descriptor + = Data.ProtoLens.FieldDescriptor + "prices" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor ExPrices) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'prices")) :: + Data.ProtoLens.FieldDescriptor PParams + maxExecutionUnitsPerTransaction__field_descriptor + = Data.ProtoLens.FieldDescriptor + "max_execution_units_per_transaction" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor ExUnits) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field + @"maybe'maxExecutionUnitsPerTransaction")) :: + Data.ProtoLens.FieldDescriptor PParams + maxExecutionUnitsPerBlock__field_descriptor + = Data.ProtoLens.FieldDescriptor + "max_execution_units_per_block" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor ExUnits) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'maxExecutionUnitsPerBlock")) :: + Data.ProtoLens.FieldDescriptor PParams + minFeeScriptRefCostPerByte__field_descriptor + = Data.ProtoLens.FieldDescriptor + "min_fee_script_ref_cost_per_byte" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor RationalNumber) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field + @"maybe'minFeeScriptRefCostPerByte")) :: + Data.ProtoLens.FieldDescriptor PParams + poolVotingThresholds__field_descriptor + = Data.ProtoLens.FieldDescriptor + "pool_voting_thresholds" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor VotingThresholds) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'poolVotingThresholds")) :: + Data.ProtoLens.FieldDescriptor PParams + drepVotingThresholds__field_descriptor + = Data.ProtoLens.FieldDescriptor + "drep_voting_thresholds" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor VotingThresholds) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'drepVotingThresholds")) :: + Data.ProtoLens.FieldDescriptor PParams + minCommitteeSize__field_descriptor + = Data.ProtoLens.FieldDescriptor + "min_committee_size" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt32Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"minCommitteeSize")) :: + Data.ProtoLens.FieldDescriptor PParams + committeeTermLimit__field_descriptor + = Data.ProtoLens.FieldDescriptor + "committee_term_limit" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"committeeTermLimit")) :: + Data.ProtoLens.FieldDescriptor PParams + governanceActionValidityPeriod__field_descriptor + = Data.ProtoLens.FieldDescriptor + "governance_action_validity_period" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"governanceActionValidityPeriod")) :: + Data.ProtoLens.FieldDescriptor PParams + governanceActionDeposit__field_descriptor + = Data.ProtoLens.FieldDescriptor + "governance_action_deposit" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"governanceActionDeposit")) :: + Data.ProtoLens.FieldDescriptor PParams + drepDeposit__field_descriptor + = Data.ProtoLens.FieldDescriptor + "drep_deposit" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"drepDeposit")) :: + Data.ProtoLens.FieldDescriptor PParams + drepInactivityPeriod__field_descriptor + = Data.ProtoLens.FieldDescriptor + "drep_inactivity_period" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional + (Data.ProtoLens.Field.field @"drepInactivityPeriod")) :: + Data.ProtoLens.FieldDescriptor PParams + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, coinsPerUtxoByte__field_descriptor), + (Data.ProtoLens.Tag 2, maxTxSize__field_descriptor), + (Data.ProtoLens.Tag 3, minFeeCoefficient__field_descriptor), + (Data.ProtoLens.Tag 4, minFeeConstant__field_descriptor), + (Data.ProtoLens.Tag 5, maxBlockBodySize__field_descriptor), + (Data.ProtoLens.Tag 6, maxBlockHeaderSize__field_descriptor), + (Data.ProtoLens.Tag 7, stakeKeyDeposit__field_descriptor), + (Data.ProtoLens.Tag 8, poolDeposit__field_descriptor), + (Data.ProtoLens.Tag 9, poolRetirementEpochBound__field_descriptor), + (Data.ProtoLens.Tag 10, desiredNumberOfPools__field_descriptor), + (Data.ProtoLens.Tag 11, poolInfluence__field_descriptor), + (Data.ProtoLens.Tag 12, monetaryExpansion__field_descriptor), + (Data.ProtoLens.Tag 13, treasuryExpansion__field_descriptor), + (Data.ProtoLens.Tag 14, minPoolCost__field_descriptor), + (Data.ProtoLens.Tag 15, protocolVersion__field_descriptor), + (Data.ProtoLens.Tag 16, maxValueSize__field_descriptor), + (Data.ProtoLens.Tag 17, collateralPercentage__field_descriptor), + (Data.ProtoLens.Tag 18, maxCollateralInputs__field_descriptor), + (Data.ProtoLens.Tag 19, costModels__field_descriptor), + (Data.ProtoLens.Tag 20, prices__field_descriptor), + (Data.ProtoLens.Tag 21, + maxExecutionUnitsPerTransaction__field_descriptor), + (Data.ProtoLens.Tag 22, + maxExecutionUnitsPerBlock__field_descriptor), + (Data.ProtoLens.Tag 23, + minFeeScriptRefCostPerByte__field_descriptor), + (Data.ProtoLens.Tag 24, poolVotingThresholds__field_descriptor), + (Data.ProtoLens.Tag 25, drepVotingThresholds__field_descriptor), + (Data.ProtoLens.Tag 26, minCommitteeSize__field_descriptor), + (Data.ProtoLens.Tag 27, committeeTermLimit__field_descriptor), + (Data.ProtoLens.Tag 28, + governanceActionValidityPeriod__field_descriptor), + (Data.ProtoLens.Tag 29, governanceActionDeposit__field_descriptor), + (Data.ProtoLens.Tag 30, drepDeposit__field_descriptor), + (Data.ProtoLens.Tag 31, drepInactivityPeriod__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _PParams'_unknownFields + (\ x__ y__ -> x__ {_PParams'_unknownFields = y__}) + defMessage + = PParams'_constructor + {_PParams'coinsPerUtxoByte = Data.ProtoLens.fieldDefault, + _PParams'maxTxSize = Data.ProtoLens.fieldDefault, + _PParams'minFeeCoefficient = Data.ProtoLens.fieldDefault, + _PParams'minFeeConstant = Data.ProtoLens.fieldDefault, + _PParams'maxBlockBodySize = Data.ProtoLens.fieldDefault, + _PParams'maxBlockHeaderSize = Data.ProtoLens.fieldDefault, + _PParams'stakeKeyDeposit = Data.ProtoLens.fieldDefault, + _PParams'poolDeposit = Data.ProtoLens.fieldDefault, + _PParams'poolRetirementEpochBound = Data.ProtoLens.fieldDefault, + _PParams'desiredNumberOfPools = Data.ProtoLens.fieldDefault, + _PParams'poolInfluence = Prelude.Nothing, + _PParams'monetaryExpansion = Prelude.Nothing, + _PParams'treasuryExpansion = Prelude.Nothing, + _PParams'minPoolCost = Data.ProtoLens.fieldDefault, + _PParams'protocolVersion = Prelude.Nothing, + _PParams'maxValueSize = Data.ProtoLens.fieldDefault, + _PParams'collateralPercentage = Data.ProtoLens.fieldDefault, + _PParams'maxCollateralInputs = Data.ProtoLens.fieldDefault, + _PParams'costModels = Prelude.Nothing, + _PParams'prices = Prelude.Nothing, + _PParams'maxExecutionUnitsPerTransaction = Prelude.Nothing, + _PParams'maxExecutionUnitsPerBlock = Prelude.Nothing, + _PParams'minFeeScriptRefCostPerByte = Prelude.Nothing, + _PParams'poolVotingThresholds = Prelude.Nothing, + _PParams'drepVotingThresholds = Prelude.Nothing, + _PParams'minCommitteeSize = Data.ProtoLens.fieldDefault, + _PParams'committeeTermLimit = Data.ProtoLens.fieldDefault, + _PParams'governanceActionValidityPeriod = Data.ProtoLens.fieldDefault, + _PParams'governanceActionDeposit = Data.ProtoLens.fieldDefault, + _PParams'drepDeposit = Data.ProtoLens.fieldDefault, + _PParams'drepInactivityPeriod = Data.ProtoLens.fieldDefault, + _PParams'_unknownFields = []} + parseMessage + = let + loop :: PParams -> Data.ProtoLens.Encoding.Bytes.Parser PParams + loop x + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "coins_per_utxo_byte" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"coinsPerUtxoByte") y x) + 16 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "max_tx_size" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"maxTxSize") y x) + 24 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "min_fee_coefficient" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"minFeeCoefficient") y x) + 32 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "min_fee_constant" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"minFeeConstant") y x) + 40 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "max_block_body_size" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"maxBlockBodySize") y x) + 48 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt + "max_block_header_size" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"maxBlockHeaderSize") y x) + 56 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "stake_key_deposit" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"stakeKeyDeposit") y x) + 64 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "pool_deposit" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"poolDeposit") y x) + 72 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt + "pool_retirement_epoch_bound" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"poolRetirementEpochBound") y x) + 80 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt + "desired_number_of_pools" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"desiredNumberOfPools") y x) + 90 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "pool_influence" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"poolInfluence") y x) + 98 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "monetary_expansion" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"monetaryExpansion") y x) + 106 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "treasury_expansion" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"treasuryExpansion") y x) + 112 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "min_pool_cost" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"minPoolCost") y x) + 122 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "protocol_version" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"protocolVersion") y x) + 128 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "max_value_size" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"maxValueSize") y x) + 136 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt + "collateral_percentage" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"collateralPercentage") y x) + 144 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt + "max_collateral_inputs" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"maxCollateralInputs") y x) + 154 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "cost_models" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"costModels") y x) + 162 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "prices" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"prices") y x) + 170 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "max_execution_units_per_transaction" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"maxExecutionUnitsPerTransaction") + y x) + 178 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "max_execution_units_per_block" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"maxExecutionUnitsPerBlock") y x) + 186 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "min_fee_script_ref_cost_per_byte" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"minFeeScriptRefCostPerByte") y x) + 194 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "pool_voting_thresholds" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"poolVotingThresholds") y x) + 202 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "drep_voting_thresholds" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"drepVotingThresholds") y x) + 208 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (Prelude.fmap + Prelude.fromIntegral + Data.ProtoLens.Encoding.Bytes.getVarInt) + "min_committee_size" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"minCommitteeSize") y x) + 216 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt + "committee_term_limit" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"committeeTermLimit") y x) + 224 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt + "governance_action_validity_period" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"governanceActionValidityPeriod") + y x) + 232 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt + "governance_action_deposit" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"governanceActionDeposit") y x) + 240 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt "drep_deposit" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"drepDeposit") y x) + 248 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + Data.ProtoLens.Encoding.Bytes.getVarInt + "drep_inactivity_period" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"drepInactivityPeriod") y x) + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + in + (Data.ProtoLens.Encoding.Bytes.) + (do loop Data.ProtoLens.defMessage) "PParams" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (let + _v + = Lens.Family2.view + (Data.ProtoLens.Field.field @"coinsPerUtxoByte") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 8) + (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) + ((Data.Monoid.<>) + (let + _v = Lens.Family2.view (Data.ProtoLens.Field.field @"maxTxSize") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 16) + (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) + ((Data.Monoid.<>) + (let + _v + = Lens.Family2.view + (Data.ProtoLens.Field.field @"minFeeCoefficient") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 24) + (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) + ((Data.Monoid.<>) + (let + _v + = Lens.Family2.view + (Data.ProtoLens.Field.field @"minFeeConstant") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 32) + (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) + ((Data.Monoid.<>) + (let + _v + = Lens.Family2.view + (Data.ProtoLens.Field.field @"maxBlockBodySize") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 40) + (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) + ((Data.Monoid.<>) + (let + _v + = Lens.Family2.view + (Data.ProtoLens.Field.field @"maxBlockHeaderSize") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 48) + (Data.ProtoLens.Encoding.Bytes.putVarInt _v)) + ((Data.Monoid.<>) + (let + _v + = Lens.Family2.view + (Data.ProtoLens.Field.field @"stakeKeyDeposit") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then Data.Monoid.mempty else (Data.Monoid.<>) @@ -3063,82 +4227,940 @@ instance Control.DeepSeq.NFData PParams where rnf = \ x__ -> Control.DeepSeq.deepseq - (_PParams'_unknownFields x__) + (_PParams'_unknownFields x__) + (Control.DeepSeq.deepseq + (_PParams'coinsPerUtxoByte x__) + (Control.DeepSeq.deepseq + (_PParams'maxTxSize x__) + (Control.DeepSeq.deepseq + (_PParams'minFeeCoefficient x__) + (Control.DeepSeq.deepseq + (_PParams'minFeeConstant x__) + (Control.DeepSeq.deepseq + (_PParams'maxBlockBodySize x__) + (Control.DeepSeq.deepseq + (_PParams'maxBlockHeaderSize x__) + (Control.DeepSeq.deepseq + (_PParams'stakeKeyDeposit x__) + (Control.DeepSeq.deepseq + (_PParams'poolDeposit x__) + (Control.DeepSeq.deepseq + (_PParams'poolRetirementEpochBound x__) + (Control.DeepSeq.deepseq + (_PParams'desiredNumberOfPools x__) + (Control.DeepSeq.deepseq + (_PParams'poolInfluence x__) + (Control.DeepSeq.deepseq + (_PParams'monetaryExpansion x__) + (Control.DeepSeq.deepseq + (_PParams'treasuryExpansion x__) + (Control.DeepSeq.deepseq + (_PParams'minPoolCost x__) + (Control.DeepSeq.deepseq + (_PParams'protocolVersion x__) + (Control.DeepSeq.deepseq + (_PParams'maxValueSize x__) + (Control.DeepSeq.deepseq + (_PParams'collateralPercentage x__) + (Control.DeepSeq.deepseq + (_PParams'maxCollateralInputs + x__) + (Control.DeepSeq.deepseq + (_PParams'costModels x__) + (Control.DeepSeq.deepseq + (_PParams'prices x__) + (Control.DeepSeq.deepseq + (_PParams'maxExecutionUnitsPerTransaction + x__) + (Control.DeepSeq.deepseq + (_PParams'maxExecutionUnitsPerBlock + x__) + (Control.DeepSeq.deepseq + (_PParams'minFeeScriptRefCostPerByte + x__) + (Control.DeepSeq.deepseq + (_PParams'poolVotingThresholds + x__) + (Control.DeepSeq.deepseq + (_PParams'drepVotingThresholds + x__) + (Control.DeepSeq.deepseq + (_PParams'minCommitteeSize + x__) + (Control.DeepSeq.deepseq + (_PParams'committeeTermLimit + x__) + (Control.DeepSeq.deepseq + (_PParams'governanceActionValidityPeriod + x__) + (Control.DeepSeq.deepseq + (_PParams'governanceActionDeposit + x__) + (Control.DeepSeq.deepseq + (_PParams'drepDeposit + x__) + (Control.DeepSeq.deepseq + (_PParams'drepInactivityPeriod + x__) + ()))))))))))))))))))))))))))))))) +{- | Fields : + + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusData' @:: Lens' PlutusData (Prelude.Maybe PlutusData'PlutusData)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'constr' @:: Lens' PlutusData (Prelude.Maybe Constr)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.constr' @:: Lens' PlutusData Constr@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'map' @:: Lens' PlutusData (Prelude.Maybe PlutusDataMap)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.map' @:: Lens' PlutusData PlutusDataMap@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'bigInt' @:: Lens' PlutusData (Prelude.Maybe BigInt)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.bigInt' @:: Lens' PlutusData BigInt@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'boundedBytes' @:: Lens' PlutusData (Prelude.Maybe Data.ByteString.ByteString)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.boundedBytes' @:: Lens' PlutusData Data.ByteString.ByteString@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'array' @:: Lens' PlutusData (Prelude.Maybe PlutusDataArray)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.array' @:: Lens' PlutusData PlutusDataArray@ -} +data PlutusData + = PlutusData'_constructor {_PlutusData'plutusData :: !(Prelude.Maybe PlutusData'PlutusData), + _PlutusData'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show PlutusData where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +data PlutusData'PlutusData + = PlutusData'Constr !Constr | + PlutusData'Map !PlutusDataMap | + PlutusData'BigInt !BigInt | + PlutusData'BoundedBytes !Data.ByteString.ByteString | + PlutusData'Array !PlutusDataArray + deriving stock (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance Data.ProtoLens.Field.HasField PlutusData "maybe'plutusData" (Prelude.Maybe PlutusData'PlutusData) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PlutusData "maybe'constr" (Prelude.Maybe Constr) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'Constr x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'Constr y__)) +instance Data.ProtoLens.Field.HasField PlutusData "constr" Constr where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'Constr x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'Constr y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) +instance Data.ProtoLens.Field.HasField PlutusData "maybe'map" (Prelude.Maybe PlutusDataMap) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'Map x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'Map y__)) +instance Data.ProtoLens.Field.HasField PlutusData "map" PlutusDataMap where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'Map x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'Map y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) +instance Data.ProtoLens.Field.HasField PlutusData "maybe'bigInt" (Prelude.Maybe BigInt) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'BigInt x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'BigInt y__)) +instance Data.ProtoLens.Field.HasField PlutusData "bigInt" BigInt where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'BigInt x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'BigInt y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) +instance Data.ProtoLens.Field.HasField PlutusData "maybe'boundedBytes" (Prelude.Maybe Data.ByteString.ByteString) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'BoundedBytes x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'BoundedBytes y__)) +instance Data.ProtoLens.Field.HasField PlutusData "boundedBytes" Data.ByteString.ByteString where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'BoundedBytes x__val)) + -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'BoundedBytes y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)) +instance Data.ProtoLens.Field.HasField PlutusData "maybe'array" (Prelude.Maybe PlutusDataArray) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'Array x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'Array y__)) +instance Data.ProtoLens.Field.HasField PlutusData "array" PlutusDataArray where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusData'plutusData + (\ x__ y__ -> x__ {_PlutusData'plutusData = y__})) + ((Prelude..) + (Lens.Family2.Unchecked.lens + (\ x__ + -> case x__ of + (Prelude.Just (PlutusData'Array x__val)) -> Prelude.Just x__val + _otherwise -> Prelude.Nothing) + (\ _ y__ -> Prelude.fmap PlutusData'Array y__)) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) +instance Data.ProtoLens.Message PlutusData where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.PlutusData" + packedMessageDescriptor _ + = "\n\ + \\n\ + \PlutusData\DC29\n\ + \\ACKconstr\CAN\STX \SOH(\v2\US.utxorpc.v1alpha.cardano.ConstrH\NULR\ACKconstr\DC2:\n\ + \\ETXmap\CAN\ETX \SOH(\v2&.utxorpc.v1alpha.cardano.PlutusDataMapH\NULR\ETXmap\DC2:\n\ + \\abig_int\CAN\EOT \SOH(\v2\US.utxorpc.v1alpha.cardano.BigIntH\NULR\ACKbigInt\DC2%\n\ + \\rbounded_bytes\CAN\ENQ \SOH(\fH\NULR\fboundedBytes\DC2@\n\ + \\ENQarray\CAN\ACK \SOH(\v2(.utxorpc.v1alpha.cardano.PlutusDataArrayH\NULR\ENQarrayB\r\n\ + \\vplutus_data" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + constr__field_descriptor + = Data.ProtoLens.FieldDescriptor + "constr" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor Constr) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'constr")) :: + Data.ProtoLens.FieldDescriptor PlutusData + map__field_descriptor + = Data.ProtoLens.FieldDescriptor + "map" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor PlutusDataMap) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'map")) :: + Data.ProtoLens.FieldDescriptor PlutusData + bigInt__field_descriptor + = Data.ProtoLens.FieldDescriptor + "big_int" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor BigInt) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'bigInt")) :: + Data.ProtoLens.FieldDescriptor PlutusData + boundedBytes__field_descriptor + = Data.ProtoLens.FieldDescriptor + "bounded_bytes" + (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: + Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'boundedBytes")) :: + Data.ProtoLens.FieldDescriptor PlutusData + array__field_descriptor + = Data.ProtoLens.FieldDescriptor + "array" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor PlutusDataArray) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'array")) :: + Data.ProtoLens.FieldDescriptor PlutusData + in + Data.Map.fromList + [(Data.ProtoLens.Tag 2, constr__field_descriptor), + (Data.ProtoLens.Tag 3, map__field_descriptor), + (Data.ProtoLens.Tag 4, bigInt__field_descriptor), + (Data.ProtoLens.Tag 5, boundedBytes__field_descriptor), + (Data.ProtoLens.Tag 6, array__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _PlutusData'_unknownFields + (\ x__ y__ -> x__ {_PlutusData'_unknownFields = y__}) + defMessage + = PlutusData'_constructor + {_PlutusData'plutusData = Prelude.Nothing, + _PlutusData'_unknownFields = []} + parseMessage + = let + loop :: + PlutusData -> Data.ProtoLens.Encoding.Bytes.Parser PlutusData + loop x + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 18 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "constr" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"constr") y x) + 26 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "map" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"map") y x) + 34 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "big_int" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"bigInt") y x) + 42 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.getBytes + (Prelude.fromIntegral len)) + "bounded_bytes" + loop + (Lens.Family2.set + (Data.ProtoLens.Field.field @"boundedBytes") y x) + 50 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "array" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"array") y x) + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + in + (Data.ProtoLens.Encoding.Bytes.) + (do loop Data.ProtoLens.defMessage) "PlutusData" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (case + Lens.Family2.view + (Data.ProtoLens.Field.field @"maybe'plutusData") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just (PlutusData'Constr v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 18) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage v) + (Prelude.Just (PlutusData'Map v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 26) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage v) + (Prelude.Just (PlutusData'BigInt v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 34) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage v) + (Prelude.Just (PlutusData'BoundedBytes v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 42) + ((\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + v) + (Prelude.Just (PlutusData'Array v)) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 50) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage v)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)) +instance Control.DeepSeq.NFData PlutusData where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_PlutusData'_unknownFields x__) + (Control.DeepSeq.deepseq (_PlutusData'plutusData x__) ()) +instance Control.DeepSeq.NFData PlutusData'PlutusData where + rnf (PlutusData'Constr x__) = Control.DeepSeq.rnf x__ + rnf (PlutusData'Map x__) = Control.DeepSeq.rnf x__ + rnf (PlutusData'BigInt x__) = Control.DeepSeq.rnf x__ + rnf (PlutusData'BoundedBytes x__) = Control.DeepSeq.rnf x__ + rnf (PlutusData'Array x__) = Control.DeepSeq.rnf x__ +_PlutusData'Constr :: + Data.ProtoLens.Prism.Prism' PlutusData'PlutusData Constr +_PlutusData'Constr + = Data.ProtoLens.Prism.prism' + PlutusData'Constr + (\ p__ + -> case p__ of + (PlutusData'Constr p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_PlutusData'Map :: + Data.ProtoLens.Prism.Prism' PlutusData'PlutusData PlutusDataMap +_PlutusData'Map + = Data.ProtoLens.Prism.prism' + PlutusData'Map + (\ p__ + -> case p__ of + (PlutusData'Map p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_PlutusData'BigInt :: + Data.ProtoLens.Prism.Prism' PlutusData'PlutusData BigInt +_PlutusData'BigInt + = Data.ProtoLens.Prism.prism' + PlutusData'BigInt + (\ p__ + -> case p__ of + (PlutusData'BigInt p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_PlutusData'BoundedBytes :: + Data.ProtoLens.Prism.Prism' PlutusData'PlutusData Data.ByteString.ByteString +_PlutusData'BoundedBytes + = Data.ProtoLens.Prism.prism' + PlutusData'BoundedBytes + (\ p__ + -> case p__ of + (PlutusData'BoundedBytes p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_PlutusData'Array :: + Data.ProtoLens.Prism.Prism' PlutusData'PlutusData PlutusDataArray +_PlutusData'Array + = Data.ProtoLens.Prism.prism' + PlutusData'Array + (\ p__ + -> case p__ of + (PlutusData'Array p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +{- | Fields : + + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.items' @:: Lens' PlutusDataArray [PlutusData]@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.vec'items' @:: Lens' PlutusDataArray (Data.Vector.Vector PlutusData)@ -} +data PlutusDataArray + = PlutusDataArray'_constructor {_PlutusDataArray'items :: !(Data.Vector.Vector PlutusData), + _PlutusDataArray'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show PlutusDataArray where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +instance Data.ProtoLens.Field.HasField PlutusDataArray "items" [PlutusData] where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusDataArray'items + (\ x__ y__ -> x__ {_PlutusDataArray'items = y__})) + (Lens.Family2.Unchecked.lens + Data.Vector.Generic.toList + (\ _ y__ -> Data.Vector.Generic.fromList y__)) +instance Data.ProtoLens.Field.HasField PlutusDataArray "vec'items" (Data.Vector.Vector PlutusData) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusDataArray'items + (\ x__ y__ -> x__ {_PlutusDataArray'items = y__})) + Prelude.id +instance Data.ProtoLens.Message PlutusDataArray where + messageName _ + = Data.Text.pack "utxorpc.v1alpha.cardano.PlutusDataArray" + packedMessageDescriptor _ + = "\n\ + \\SIPlutusDataArray\DC29\n\ + \\ENQitems\CAN\SOH \ETX(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\ENQitems" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + items__field_descriptor + = Data.ProtoLens.FieldDescriptor + "items" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor PlutusData) + (Data.ProtoLens.RepeatedField + Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"items")) :: + Data.ProtoLens.FieldDescriptor PlutusDataArray + in + Data.Map.fromList [(Data.ProtoLens.Tag 1, items__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _PlutusDataArray'_unknownFields + (\ x__ y__ -> x__ {_PlutusDataArray'_unknownFields = y__}) + defMessage + = PlutusDataArray'_constructor + {_PlutusDataArray'items = Data.Vector.Generic.empty, + _PlutusDataArray'_unknownFields = []} + parseMessage + = let + loop :: + PlutusDataArray + -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld PlutusData + -> Data.ProtoLens.Encoding.Bytes.Parser PlutusDataArray + loop x mutable'items + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do frozen'items <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'items) + (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) + (Lens.Family2.set + (Data.ProtoLens.Field.field @"vec'items") frozen'items x)) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 10 + -> do !y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) + Data.ProtoLens.parseMessage) + "items" + v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.append mutable'items y) + loop x v + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + mutable'items + in + (Data.ProtoLens.Encoding.Bytes.) + (do mutable'items <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + Data.ProtoLens.Encoding.Growing.new + loop Data.ProtoLens.defMessage mutable'items) + "PlutusDataArray" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.foldMapBuilder + (\ _v + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 10) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'items") _x)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)) +instance Control.DeepSeq.NFData PlutusDataArray where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_PlutusDataArray'_unknownFields x__) + (Control.DeepSeq.deepseq (_PlutusDataArray'items x__) ()) +{- | Fields : + + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.pairs' @:: Lens' PlutusDataMap [PlutusDataPair]@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.vec'pairs' @:: Lens' PlutusDataMap (Data.Vector.Vector PlutusDataPair)@ -} +data PlutusDataMap + = PlutusDataMap'_constructor {_PlutusDataMap'pairs :: !(Data.Vector.Vector PlutusDataPair), + _PlutusDataMap'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show PlutusDataMap where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +instance Data.ProtoLens.Field.HasField PlutusDataMap "pairs" [PlutusDataPair] where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusDataMap'pairs + (\ x__ y__ -> x__ {_PlutusDataMap'pairs = y__})) + (Lens.Family2.Unchecked.lens + Data.Vector.Generic.toList + (\ _ y__ -> Data.Vector.Generic.fromList y__)) +instance Data.ProtoLens.Field.HasField PlutusDataMap "vec'pairs" (Data.Vector.Vector PlutusDataPair) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusDataMap'pairs + (\ x__ y__ -> x__ {_PlutusDataMap'pairs = y__})) + Prelude.id +instance Data.ProtoLens.Message PlutusDataMap where + messageName _ + = Data.Text.pack "utxorpc.v1alpha.cardano.PlutusDataMap" + packedMessageDescriptor _ + = "\n\ + \\rPlutusDataMap\DC2=\n\ + \\ENQpairs\CAN\SOH \ETX(\v2'.utxorpc.v1alpha.cardano.PlutusDataPairR\ENQpairs" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + pairs__field_descriptor + = Data.ProtoLens.FieldDescriptor + "pairs" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor PlutusDataPair) + (Data.ProtoLens.RepeatedField + Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"pairs")) :: + Data.ProtoLens.FieldDescriptor PlutusDataMap + in + Data.Map.fromList [(Data.ProtoLens.Tag 1, pairs__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _PlutusDataMap'_unknownFields + (\ x__ y__ -> x__ {_PlutusDataMap'_unknownFields = y__}) + defMessage + = PlutusDataMap'_constructor + {_PlutusDataMap'pairs = Data.Vector.Generic.empty, + _PlutusDataMap'_unknownFields = []} + parseMessage + = let + loop :: + PlutusDataMap + -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld PlutusDataPair + -> Data.ProtoLens.Encoding.Bytes.Parser PlutusDataMap + loop x mutable'pairs + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do frozen'pairs <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'pairs) + (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) + (Lens.Family2.set + (Data.ProtoLens.Field.field @"vec'pairs") frozen'pairs x)) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 10 + -> do !y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) + Data.ProtoLens.parseMessage) + "pairs" + v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.append mutable'pairs y) + loop x v + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + mutable'pairs + in + (Data.ProtoLens.Encoding.Bytes.) + (do mutable'pairs <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + Data.ProtoLens.Encoding.Growing.new + loop Data.ProtoLens.defMessage mutable'pairs) + "PlutusDataMap" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.foldMapBuilder + (\ _v + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 10) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'pairs") _x)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)) +instance Control.DeepSeq.NFData PlutusDataMap where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_PlutusDataMap'_unknownFields x__) + (Control.DeepSeq.deepseq (_PlutusDataMap'pairs x__) ()) +{- | Fields : + + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.key' @:: Lens' PlutusDataPair PlutusData@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'key' @:: Lens' PlutusDataPair (Prelude.Maybe PlutusData)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.value' @:: Lens' PlutusDataPair PlutusData@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'value' @:: Lens' PlutusDataPair (Prelude.Maybe PlutusData)@ -} +data PlutusDataPair + = PlutusDataPair'_constructor {_PlutusDataPair'key :: !(Prelude.Maybe PlutusData), + _PlutusDataPair'value :: !(Prelude.Maybe PlutusData), + _PlutusDataPair'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show PlutusDataPair where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +instance Data.ProtoLens.Field.HasField PlutusDataPair "key" PlutusData where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusDataPair'key (\ x__ y__ -> x__ {_PlutusDataPair'key = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PlutusDataPair "maybe'key" (Prelude.Maybe PlutusData) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusDataPair'key (\ x__ y__ -> x__ {_PlutusDataPair'key = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField PlutusDataPair "value" PlutusData where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusDataPair'value + (\ x__ y__ -> x__ {_PlutusDataPair'value = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) +instance Data.ProtoLens.Field.HasField PlutusDataPair "maybe'value" (Prelude.Maybe PlutusData) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _PlutusDataPair'value + (\ x__ y__ -> x__ {_PlutusDataPair'value = y__})) + Prelude.id +instance Data.ProtoLens.Message PlutusDataPair where + messageName _ + = Data.Text.pack "utxorpc.v1alpha.cardano.PlutusDataPair" + packedMessageDescriptor _ + = "\n\ + \\SOPlutusDataPair\DC25\n\ + \\ETXkey\CAN\SOH \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\ETXkey\DC29\n\ + \\ENQvalue\CAN\STX \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\ENQvalue" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + key__field_descriptor + = Data.ProtoLens.FieldDescriptor + "key" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor PlutusData) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'key")) :: + Data.ProtoLens.FieldDescriptor PlutusDataPair + value__field_descriptor + = Data.ProtoLens.FieldDescriptor + "value" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor PlutusData) + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'value")) :: + Data.ProtoLens.FieldDescriptor PlutusDataPair + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, key__field_descriptor), + (Data.ProtoLens.Tag 2, value__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _PlutusDataPair'_unknownFields + (\ x__ y__ -> x__ {_PlutusDataPair'_unknownFields = y__}) + defMessage + = PlutusDataPair'_constructor + {_PlutusDataPair'key = Prelude.Nothing, + _PlutusDataPair'value = Prelude.Nothing, + _PlutusDataPair'_unknownFields = []} + parseMessage + = let + loop :: + PlutusDataPair + -> Data.ProtoLens.Encoding.Bytes.Parser PlutusDataPair + loop x + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 10 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "key" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"key") y x) + 18 + -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) + "value" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"value") y x) + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + in + (Data.ProtoLens.Encoding.Bytes.) + (do loop Data.ProtoLens.defMessage) "PlutusDataPair" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (case + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'key") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just _v) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 10) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + ((Data.Monoid.<>) + (case + Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'value") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just _v) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 18) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x))) +instance Control.DeepSeq.NFData PlutusDataPair where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_PlutusDataPair'_unknownFields x__) (Control.DeepSeq.deepseq - (_PParams'coinsPerUtxoByte x__) - (Control.DeepSeq.deepseq - (_PParams'maxTxSize x__) - (Control.DeepSeq.deepseq - (_PParams'minFeeCoefficient x__) - (Control.DeepSeq.deepseq - (_PParams'minFeeConstant x__) - (Control.DeepSeq.deepseq - (_PParams'maxBlockBodySize x__) - (Control.DeepSeq.deepseq - (_PParams'maxBlockHeaderSize x__) - (Control.DeepSeq.deepseq - (_PParams'stakeKeyDeposit x__) - (Control.DeepSeq.deepseq - (_PParams'poolDeposit x__) - (Control.DeepSeq.deepseq - (_PParams'poolRetirementEpochBound x__) - (Control.DeepSeq.deepseq - (_PParams'desiredNumberOfPools x__) - (Control.DeepSeq.deepseq - (_PParams'poolInfluence x__) - (Control.DeepSeq.deepseq - (_PParams'monetaryExpansion x__) - (Control.DeepSeq.deepseq - (_PParams'treasuryExpansion x__) - (Control.DeepSeq.deepseq - (_PParams'minPoolCost x__) - (Control.DeepSeq.deepseq - (_PParams'protocolVersion x__) - (Control.DeepSeq.deepseq - (_PParams'maxValueSize x__) - (Control.DeepSeq.deepseq - (_PParams'collateralPercentage x__) - (Control.DeepSeq.deepseq - (_PParams'maxCollateralInputs - x__) - (Control.DeepSeq.deepseq - (_PParams'costModels x__) - (Control.DeepSeq.deepseq - (_PParams'prices x__) - (Control.DeepSeq.deepseq - (_PParams'maxExecutionUnitsPerTransaction - x__) - (Control.DeepSeq.deepseq - (_PParams'maxExecutionUnitsPerBlock - x__) - (Control.DeepSeq.deepseq - (_PParams'minFeeScriptRefCostPerByte - x__) - (Control.DeepSeq.deepseq - (_PParams'poolVotingThresholds - x__) - (Control.DeepSeq.deepseq - (_PParams'drepVotingThresholds - x__) - (Control.DeepSeq.deepseq - (_PParams'minCommitteeSize - x__) - (Control.DeepSeq.deepseq - (_PParams'committeeTermLimit - x__) - (Control.DeepSeq.deepseq - (_PParams'governanceActionValidityPeriod - x__) - (Control.DeepSeq.deepseq - (_PParams'governanceActionDeposit - x__) - (Control.DeepSeq.deepseq - (_PParams'drepDeposit - x__) - (Control.DeepSeq.deepseq - (_PParams'drepInactivityPeriod - x__) - ()))))))))))))))))))))))))))))))) + (_PlutusDataPair'key x__) + (Control.DeepSeq.deepseq (_PlutusDataPair'value x__) ())) {- | Fields : * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.major' @:: Lens' ProtocolVersion Data.Word.Word32@ @@ -3439,8 +5461,8 @@ instance Control.DeepSeq.NFData RationalNumber where {- | Fields : * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'script' @:: Lens' Script (Prelude.Maybe Script'Script)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'native' @:: Lens' Script (Prelude.Maybe Data.ByteString.ByteString)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.native' @:: Lens' Script Data.ByteString.ByteString@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'native' @:: Lens' Script (Prelude.Maybe NativeScript)@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.native' @:: Lens' Script NativeScript@ * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV1' @:: Lens' Script (Prelude.Maybe Data.ByteString.ByteString)@ * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.plutusV1' @:: Lens' Script Data.ByteString.ByteString@ * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'plutusV2' @:: Lens' Script (Prelude.Maybe Data.ByteString.ByteString)@ @@ -3460,7 +5482,7 @@ instance Prelude.Show Script where (Prelude.showString (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) data Script'Script - = Script'Native !Data.ByteString.ByteString | + = Script'Native !NativeScript | Script'PlutusV1 !Data.ByteString.ByteString | Script'PlutusV2 !Data.ByteString.ByteString | Script'PlutusV3 !Data.ByteString.ByteString | @@ -3472,7 +5494,7 @@ instance Data.ProtoLens.Field.HasField Script "maybe'script" (Prelude.Maybe Scri (Lens.Family2.Unchecked.lens _Script'script (\ x__ y__ -> x__ {_Script'script = y__})) Prelude.id -instance Data.ProtoLens.Field.HasField Script "maybe'native" (Prelude.Maybe Data.ByteString.ByteString) where +instance Data.ProtoLens.Field.HasField Script "maybe'native" (Prelude.Maybe NativeScript) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens @@ -3483,7 +5505,7 @@ instance Data.ProtoLens.Field.HasField Script "maybe'native" (Prelude.Maybe Data (Prelude.Just (Script'Native x__val)) -> Prelude.Just x__val _otherwise -> Prelude.Nothing) (\ _ y__ -> Prelude.fmap Script'Native y__)) -instance Data.ProtoLens.Field.HasField Script "native" Data.ByteString.ByteString where +instance Data.ProtoLens.Field.HasField Script "native" NativeScript where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens @@ -3495,7 +5517,7 @@ instance Data.ProtoLens.Field.HasField Script "native" Data.ByteString.ByteStrin (Prelude.Just (Script'Native x__val)) -> Prelude.Just x__val _otherwise -> Prelude.Nothing) (\ _ y__ -> Prelude.fmap Script'Native y__)) - (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)) + (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) instance Data.ProtoLens.Field.HasField Script "maybe'plutusV1" (Prelude.Maybe Data.ByteString.ByteString) where fieldOf _ = (Prelude..) @@ -3596,8 +5618,8 @@ instance Data.ProtoLens.Message Script where messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.Script" packedMessageDescriptor _ = "\n\ - \\ACKScript\DC2\CAN\n\ - \\ACKnative\CAN\SOH \SOH(\fH\NULR\ACKnative\DC2\GS\n\ + \\ACKScript\DC2?\n\ + \\ACKnative\CAN\SOH \SOH(\v2%.utxorpc.v1alpha.cardano.NativeScriptH\NULR\ACKnative\DC2\GS\n\ \\tplutus_v1\CAN\STX \SOH(\fH\NULR\bplutusV1\DC2\GS\n\ \\tplutus_v2\CAN\ETX \SOH(\fH\NULR\bplutusV2\DC2\GS\n\ \\tplutus_v3\CAN\EOT \SOH(\fH\NULR\bplutusV3\DC2\GS\n\ @@ -3609,8 +5631,8 @@ instance Data.ProtoLens.Message Script where native__field_descriptor = Data.ProtoLens.FieldDescriptor "native" - (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: - Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor NativeScript) (Data.ProtoLens.OptionalField (Data.ProtoLens.Field.field @"maybe'native")) :: Data.ProtoLens.FieldDescriptor Script @@ -3684,8 +5706,8 @@ instance Data.ProtoLens.Message Script where 10 -> do y <- (Data.ProtoLens.Encoding.Bytes.) (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len)) + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) "native" loop (Lens.Family2.set (Data.ProtoLens.Field.field @"native") y x) 18 @@ -3739,12 +5761,13 @@ instance Data.ProtoLens.Message Script where (Prelude.Just (Script'Native v)) -> (Data.Monoid.<>) (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - v) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage v) (Prelude.Just (Script'PlutusV1 v)) -> (Data.Monoid.<>) (Data.ProtoLens.Encoding.Bytes.putVarInt 18) @@ -3787,59 +5810,230 @@ instance Control.DeepSeq.NFData Script where rnf = \ x__ -> Control.DeepSeq.deepseq - (_Script'_unknownFields x__) - (Control.DeepSeq.deepseq (_Script'script x__) ()) -instance Control.DeepSeq.NFData Script'Script where - rnf (Script'Native x__) = Control.DeepSeq.rnf x__ - rnf (Script'PlutusV1 x__) = Control.DeepSeq.rnf x__ - rnf (Script'PlutusV2 x__) = Control.DeepSeq.rnf x__ - rnf (Script'PlutusV3 x__) = Control.DeepSeq.rnf x__ - rnf (Script'PlutusV4 x__) = Control.DeepSeq.rnf x__ -_Script'Native :: - Data.ProtoLens.Prism.Prism' Script'Script Data.ByteString.ByteString -_Script'Native - = Data.ProtoLens.Prism.prism' - Script'Native - (\ p__ - -> case p__ of - (Script'Native p__val) -> Prelude.Just p__val - _otherwise -> Prelude.Nothing) -_Script'PlutusV1 :: - Data.ProtoLens.Prism.Prism' Script'Script Data.ByteString.ByteString -_Script'PlutusV1 - = Data.ProtoLens.Prism.prism' - Script'PlutusV1 - (\ p__ - -> case p__ of - (Script'PlutusV1 p__val) -> Prelude.Just p__val - _otherwise -> Prelude.Nothing) -_Script'PlutusV2 :: - Data.ProtoLens.Prism.Prism' Script'Script Data.ByteString.ByteString -_Script'PlutusV2 - = Data.ProtoLens.Prism.prism' - Script'PlutusV2 - (\ p__ - -> case p__ of - (Script'PlutusV2 p__val) -> Prelude.Just p__val - _otherwise -> Prelude.Nothing) -_Script'PlutusV3 :: - Data.ProtoLens.Prism.Prism' Script'Script Data.ByteString.ByteString -_Script'PlutusV3 - = Data.ProtoLens.Prism.prism' - Script'PlutusV3 - (\ p__ - -> case p__ of - (Script'PlutusV3 p__val) -> Prelude.Just p__val - _otherwise -> Prelude.Nothing) -_Script'PlutusV4 :: - Data.ProtoLens.Prism.Prism' Script'Script Data.ByteString.ByteString -_Script'PlutusV4 - = Data.ProtoLens.Prism.prism' - Script'PlutusV4 - (\ p__ - -> case p__ of - (Script'PlutusV4 p__val) -> Prelude.Just p__val - _otherwise -> Prelude.Nothing) + (_Script'_unknownFields x__) + (Control.DeepSeq.deepseq (_Script'script x__) ()) +instance Control.DeepSeq.NFData Script'Script where + rnf (Script'Native x__) = Control.DeepSeq.rnf x__ + rnf (Script'PlutusV1 x__) = Control.DeepSeq.rnf x__ + rnf (Script'PlutusV2 x__) = Control.DeepSeq.rnf x__ + rnf (Script'PlutusV3 x__) = Control.DeepSeq.rnf x__ + rnf (Script'PlutusV4 x__) = Control.DeepSeq.rnf x__ +_Script'Native :: + Data.ProtoLens.Prism.Prism' Script'Script NativeScript +_Script'Native + = Data.ProtoLens.Prism.prism' + Script'Native + (\ p__ + -> case p__ of + (Script'Native p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_Script'PlutusV1 :: + Data.ProtoLens.Prism.Prism' Script'Script Data.ByteString.ByteString +_Script'PlutusV1 + = Data.ProtoLens.Prism.prism' + Script'PlutusV1 + (\ p__ + -> case p__ of + (Script'PlutusV1 p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_Script'PlutusV2 :: + Data.ProtoLens.Prism.Prism' Script'Script Data.ByteString.ByteString +_Script'PlutusV2 + = Data.ProtoLens.Prism.prism' + Script'PlutusV2 + (\ p__ + -> case p__ of + (Script'PlutusV2 p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_Script'PlutusV3 :: + Data.ProtoLens.Prism.Prism' Script'Script Data.ByteString.ByteString +_Script'PlutusV3 + = Data.ProtoLens.Prism.prism' + Script'PlutusV3 + (\ p__ + -> case p__ of + (Script'PlutusV3 p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +_Script'PlutusV4 :: + Data.ProtoLens.Prism.Prism' Script'Script Data.ByteString.ByteString +_Script'PlutusV4 + = Data.ProtoLens.Prism.prism' + Script'PlutusV4 + (\ p__ + -> case p__ of + (Script'PlutusV4 p__val) -> Prelude.Just p__val + _otherwise -> Prelude.Nothing) +{- | Fields : + + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.k' @:: Lens' ScriptNOfK Data.Word.Word32@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.scripts' @:: Lens' ScriptNOfK [NativeScript]@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.vec'scripts' @:: Lens' ScriptNOfK (Data.Vector.Vector NativeScript)@ -} +data ScriptNOfK + = ScriptNOfK'_constructor {_ScriptNOfK'k :: !Data.Word.Word32, + _ScriptNOfK'scripts :: !(Data.Vector.Vector NativeScript), + _ScriptNOfK'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show ScriptNOfK where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +instance Data.ProtoLens.Field.HasField ScriptNOfK "k" Data.Word.Word32 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _ScriptNOfK'k (\ x__ y__ -> x__ {_ScriptNOfK'k = y__})) + Prelude.id +instance Data.ProtoLens.Field.HasField ScriptNOfK "scripts" [NativeScript] where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _ScriptNOfK'scripts (\ x__ y__ -> x__ {_ScriptNOfK'scripts = y__})) + (Lens.Family2.Unchecked.lens + Data.Vector.Generic.toList + (\ _ y__ -> Data.Vector.Generic.fromList y__)) +instance Data.ProtoLens.Field.HasField ScriptNOfK "vec'scripts" (Data.Vector.Vector NativeScript) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _ScriptNOfK'scripts (\ x__ y__ -> x__ {_ScriptNOfK'scripts = y__})) + Prelude.id +instance Data.ProtoLens.Message ScriptNOfK where + messageName _ = Data.Text.pack "utxorpc.v1alpha.cardano.ScriptNOfK" + packedMessageDescriptor _ + = "\n\ + \\n\ + \ScriptNOfK\DC2\f\n\ + \\SOHk\CAN\SOH \SOH(\rR\SOHk\DC2?\n\ + \\ascripts\CAN\STX \ETX(\v2%.utxorpc.v1alpha.cardano.NativeScriptR\ascripts" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + k__field_descriptor + = Data.ProtoLens.FieldDescriptor + "k" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt32Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32) + (Data.ProtoLens.PlainField + Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"k")) :: + Data.ProtoLens.FieldDescriptor ScriptNOfK + scripts__field_descriptor + = Data.ProtoLens.FieldDescriptor + "scripts" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor NativeScript) + (Data.ProtoLens.RepeatedField + Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"scripts")) :: + Data.ProtoLens.FieldDescriptor ScriptNOfK + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, k__field_descriptor), + (Data.ProtoLens.Tag 2, scripts__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _ScriptNOfK'_unknownFields + (\ x__ y__ -> x__ {_ScriptNOfK'_unknownFields = y__}) + defMessage + = ScriptNOfK'_constructor + {_ScriptNOfK'k = Data.ProtoLens.fieldDefault, + _ScriptNOfK'scripts = Data.Vector.Generic.empty, + _ScriptNOfK'_unknownFields = []} + parseMessage + = let + loop :: + ScriptNOfK + -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld NativeScript + -> Data.ProtoLens.Encoding.Bytes.Parser ScriptNOfK + loop x mutable'scripts + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do frozen'scripts <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.unsafeFreeze + mutable'scripts) + (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) + (Lens.Family2.set + (Data.ProtoLens.Field.field @"vec'scripts") frozen'scripts x)) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (Prelude.fmap + Prelude.fromIntegral + Data.ProtoLens.Encoding.Bytes.getVarInt) + "k" + loop + (Lens.Family2.set (Data.ProtoLens.Field.field @"k") y x) + mutable'scripts + 18 + -> do !y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) + Data.ProtoLens.parseMessage) + "scripts" + v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.append mutable'scripts y) + loop x v + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + mutable'scripts + in + (Data.ProtoLens.Encoding.Bytes.) + (do mutable'scripts <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + Data.ProtoLens.Encoding.Growing.new + loop Data.ProtoLens.defMessage mutable'scripts) + "ScriptNOfK" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"k") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 8) + ((Prelude..) + Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v)) + ((Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.foldMapBuilder + (\ _v + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 18) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage _v)) + (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'scripts") _x)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x))) +instance Control.DeepSeq.NFData ScriptNOfK where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_ScriptNOfK'_unknownFields x__) + (Control.DeepSeq.deepseq + (_ScriptNOfK'k x__) + (Control.DeepSeq.deepseq (_ScriptNOfK'scripts x__) ())) {- | Fields : * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.address' @:: Lens' TxOutput Data.ByteString.ByteString@ @@ -4305,9 +6499,10 @@ packedFileDescriptor \\ENQdatum\CAN\EOT \SOH(\v2\RS.utxorpc.v1alpha.cardano.DatumR\ENQdatum\DC27\n\ \\ACKscript\CAN\ENQ \SOH(\v2\US.utxorpc.v1alpha.cardano.ScriptR\ACKscript\"$\n\ \\fAddressArray\DC2\DC4\n\ - \\ENQitems\CAN\SOH \ETX(\fR\ENQitems\"@\n\ + \\ENQitems\CAN\SOH \ETX(\fR\ENQitems\"\DEL\n\ \\ENQDatum\DC2\DC2\n\ - \\EOThash\CAN\SOH \SOH(\fR\EOThash\DC2#\n\ + \\EOThash\CAN\SOH \SOH(\fR\EOThash\DC2=\n\ + \\apayload\CAN\STX \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\apayload\DC2#\n\ \\roriginal_cbor\CAN\ETX \SOH(\fR\foriginalCbor\"q\n\ \\ENQAsset\DC2\DC2\n\ \\EOTname\CAN\SOH \SOH(\fR\EOTname\DC2%\n\ @@ -4319,9 +6514,50 @@ packedFileDescriptor \\n\ \MultiAsset\DC2\ESC\n\ \\tpolicy_id\CAN\SOH \SOH(\fR\bpolicyId\DC26\n\ - \\ACKassets\CAN\STX \ETX(\v2\RS.utxorpc.v1alpha.cardano.AssetR\ACKassets\"\168\SOH\n\ - \\ACKScript\DC2\CAN\n\ - \\ACKnative\CAN\SOH \SOH(\fH\NULR\ACKnative\DC2\GS\n\ + \\ACKassets\CAN\STX \ETX(\v2\RS.utxorpc.v1alpha.cardano.AssetR\ACKassets\"\128\ETX\n\ + \\fNativeScript\DC2%\n\ + \\rscript_pubkey\CAN\SOH \SOH(\fH\NULR\fscriptPubkey\DC2J\n\ + \\n\ + \script_all\CAN\STX \SOH(\v2).utxorpc.v1alpha.cardano.NativeScriptListH\NULR\tscriptAll\DC2J\n\ + \\n\ + \script_any\CAN\ETX \SOH(\v2).utxorpc.v1alpha.cardano.NativeScriptListH\NULR\tscriptAny\DC2H\n\ + \\rscript_n_of_k\CAN\EOT \SOH(\v2#.utxorpc.v1alpha.cardano.ScriptNOfKH\NULR\n\ + \scriptNOfK\DC2'\n\ + \\SOinvalid_before\CAN\ENQ \SOH(\EOTH\NULR\rinvalidBefore\DC2-\n\ + \\DC1invalid_hereafter\CAN\ACK \SOH(\EOTH\NULR\DLEinvalidHereafterB\SI\n\ + \\rnative_script\"O\n\ + \\DLENativeScriptList\DC2;\n\ + \\ENQitems\CAN\SOH \ETX(\v2%.utxorpc.v1alpha.cardano.NativeScriptR\ENQitems\"[\n\ + \\n\ + \ScriptNOfK\DC2\f\n\ + \\SOHk\CAN\SOH \SOH(\rR\SOHk\DC2?\n\ + \\ascripts\CAN\STX \ETX(\v2%.utxorpc.v1alpha.cardano.NativeScriptR\ascripts\"\128\SOH\n\ + \\ACKConstr\DC2\DLE\n\ + \\ETXtag\CAN\SOH \SOH(\rR\ETXtag\DC2'\n\ + \\SIany_constructor\CAN\STX \SOH(\EOTR\SOanyConstructor\DC2;\n\ + \\ACKfields\CAN\ETX \ETX(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\ACKfields\"g\n\ + \\ACKBigInt\DC2\SYN\n\ + \\ETXint\CAN\SOH \SOH(\ETXH\NULR\ETXintB\STX0\SOH\DC2\FS\n\ + \\tbig_u_int\CAN\STX \SOH(\fH\NULR\abigUInt\DC2\FS\n\ + \\tbig_n_int\CAN\ETX \SOH(\fH\NULR\abigNIntB\t\n\ + \\abig_int\"\130\SOH\n\ + \\SOPlutusDataPair\DC25\n\ + \\ETXkey\CAN\SOH \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\ETXkey\DC29\n\ + \\ENQvalue\CAN\STX \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\ENQvalue\"\183\STX\n\ + \\n\ + \PlutusData\DC29\n\ + \\ACKconstr\CAN\STX \SOH(\v2\US.utxorpc.v1alpha.cardano.ConstrH\NULR\ACKconstr\DC2:\n\ + \\ETXmap\CAN\ETX \SOH(\v2&.utxorpc.v1alpha.cardano.PlutusDataMapH\NULR\ETXmap\DC2:\n\ + \\abig_int\CAN\EOT \SOH(\v2\US.utxorpc.v1alpha.cardano.BigIntH\NULR\ACKbigInt\DC2%\n\ + \\rbounded_bytes\CAN\ENQ \SOH(\fH\NULR\fboundedBytes\DC2@\n\ + \\ENQarray\CAN\ACK \SOH(\v2(.utxorpc.v1alpha.cardano.PlutusDataArrayH\NULR\ENQarrayB\r\n\ + \\vplutus_data\"N\n\ + \\rPlutusDataMap\DC2=\n\ + \\ENQpairs\CAN\SOH \ETX(\v2'.utxorpc.v1alpha.cardano.PlutusDataPairR\ENQpairs\"L\n\ + \\SIPlutusDataArray\DC29\n\ + \\ENQitems\CAN\SOH \ETX(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\ENQitems\"\207\SOH\n\ + \\ACKScript\DC2?\n\ + \\ACKnative\CAN\SOH \SOH(\v2%.utxorpc.v1alpha.cardano.NativeScriptH\NULR\ACKnative\DC2\GS\n\ \\tplutus_v1\CAN\STX \SOH(\fH\NULR\bplutusV1\DC2\GS\n\ \\tplutus_v2\CAN\ETX \SOH(\fH\NULR\bplutusV2\DC2\GS\n\ \\tplutus_v3\CAN\EOT \SOH(\fH\NULR\bplutusV3\DC2\GS\n\ @@ -4385,8 +6621,8 @@ packedFileDescriptor \\EMgovernance_action_deposit\CAN\GS \SOH(\EOTR\ETBgovernanceActionDepositB\STX0\SOH\DC2%\n\ \\fdrep_deposit\CAN\RS \SOH(\EOTR\vdrepDepositB\STX0\SOH\DC24\n\ \\SYNdrep_inactivity_period\CAN\US \SOH(\EOTR\DC4drepInactivityPeriodB\169\SOH\n\ - \\ESCcom.utxorpc.v1alpha.cardanoB\fCardanoProtoP\SOH\162\STX\ETXUVC\170\STX\ETBUtxorpc.V1alpha.Cardano\202\STX\ETBUtxorpc\\V1alpha\\Cardano\226\STX#Utxorpc\\V1alpha\\Cardano\\GPBMetadata\234\STX\EMUtxorpc::V1alpha::CardanoJ\180\&3\n\ - \\ACK\DC2\EOT\NUL\NUL|\SOH\n\ + \\ESCcom.utxorpc.v1alpha.cardanoB\fCardanoProtoP\SOH\162\STX\ETXUVC\170\STX\ETBUtxorpc.V1alpha.Cardano\202\STX\ETBUtxorpc\\V1alpha\\Cardano\226\STX#Utxorpc\\V1alpha\\Cardano\\GPBMetadata\234\STX\EMUtxorpc::V1alpha::CardanoJ\157K\n\ + \\a\DC2\ENQ\NUL\NUL\192\SOH\SOH\n\ \\b\n\ \\SOH\f\DC2\ETX\NUL\NUL\DC2\n\ \\b\n\ @@ -4470,30 +6706,39 @@ packedFileDescriptor \\ENQ\EOT\SOH\STX\NUL\SOH\DC2\ETX\SI\DC1\SYN\n\ \\f\n\ \\ENQ\EOT\SOH\STX\NUL\ETX\DC2\ETX\SI\EM\SUB\n\ - \<\n\ - \\STX\EOT\STX\DC2\EOT\DC3\NUL\SYN\SOH\SUB0 TODO u5c: replaced plutus_data with just bytes\n\ \\n\ \\n\ + \\STX\EOT\STX\DC2\EOT\DC2\NUL\SYN\SOH\n\ + \\n\ \\n\ - \\ETX\EOT\STX\SOH\DC2\ETX\DC3\b\r\n\ + \\ETX\EOT\STX\SOH\DC2\ETX\DC2\b\r\n\ \2\n\ - \\EOT\EOT\STX\STX\NUL\DC2\ETX\DC4\STX\DC1\"% Hash of this datum as seen on-chain\n\ + \\EOT\EOT\STX\STX\NUL\DC2\ETX\DC3\STX\DC1\"% Hash of this datum as seen on-chain\n\ + \\n\ + \\f\n\ + \\ENQ\EOT\STX\STX\NUL\ENQ\DC2\ETX\DC3\STX\a\n\ + \\f\n\ + \\ENQ\EOT\STX\STX\NUL\SOH\DC2\ETX\DC3\b\f\n\ + \\f\n\ + \\ENQ\EOT\STX\STX\NUL\ETX\DC2\ETX\DC3\SI\DLE\n\ + \)\n\ + \\EOT\EOT\STX\STX\SOH\DC2\ETX\DC4\STX\EM\"\FS Parsed Plutus data payload\n\ \\n\ \\f\n\ - \\ENQ\EOT\STX\STX\NUL\ENQ\DC2\ETX\DC4\STX\a\n\ + \\ENQ\EOT\STX\STX\SOH\ACK\DC2\ETX\DC4\STX\f\n\ \\f\n\ - \\ENQ\EOT\STX\STX\NUL\SOH\DC2\ETX\DC4\b\f\n\ + \\ENQ\EOT\STX\STX\SOH\SOH\DC2\ETX\DC4\r\DC4\n\ \\f\n\ - \\ENQ\EOT\STX\STX\NUL\ETX\DC2\ETX\DC4\SI\DLE\n\ + \\ENQ\EOT\STX\STX\SOH\ETX\DC2\ETX\DC4\ETB\CAN\n\ \:\n\ - \\EOT\EOT\STX\STX\SOH\DC2\ETX\NAK\STX\SUB\"- Original cbor-encoded data as seen on-chain\n\ + \\EOT\EOT\STX\STX\STX\DC2\ETX\NAK\STX\SUB\"- Original cbor-encoded data as seen on-chain\n\ \\n\ \\f\n\ - \\ENQ\EOT\STX\STX\SOH\ENQ\DC2\ETX\NAK\STX\a\n\ + \\ENQ\EOT\STX\STX\STX\ENQ\DC2\ETX\NAK\STX\a\n\ \\f\n\ - \\ENQ\EOT\STX\STX\SOH\SOH\DC2\ETX\NAK\b\NAK\n\ + \\ENQ\EOT\STX\STX\STX\SOH\DC2\ETX\NAK\b\NAK\n\ \\f\n\ - \\ENQ\EOT\STX\STX\SOH\ETX\DC2\ETX\NAK\CAN\EM\n\ + \\ENQ\EOT\STX\STX\STX\ETX\DC2\ETX\NAK\CAN\EM\n\ \B\n\ \\STX\EOT\ETX\DC2\EOT\EM\NUL\US\SOH\SUB6 Represents a custom asset in the Cardano blockchain.\n\ \\n\ @@ -4569,589 +6814,883 @@ packedFileDescriptor \\ENQ\EOT\EOT\STX\SOH\SOH\DC2\ETX%\DC1\ETB\n\ \\f\n\ \\ENQ\EOT\EOT\STX\SOH\ETX\DC2\ETX%\SUB\ESC\n\ - \n\n\ - \\STX\EOT\ENQ\DC2\EOT*\NUL2\SOH\SUBb Represents a script in Cardano.\n\ - \ TODO u5c: removed native script representation, added plutus_v4\n\ + \4\n\ + \\STX\EOT\ENQ\DC2\EOT)\NUL2\SOH\SUB( Represents a native script in Cardano.\n\ \\n\ \\n\ \\n\ - \\ETX\EOT\ENQ\SOH\DC2\ETX*\b\SO\n\ + \\ETX\EOT\ENQ\SOH\DC2\ETX)\b\DC4\n\ \\f\n\ - \\EOT\EOT\ENQ\b\NUL\DC2\EOT+\STX1\ETX\n\ + \\EOT\EOT\ENQ\b\NUL\DC2\EOT*\STX1\ETX\n\ \\f\n\ - \\ENQ\EOT\ENQ\b\NUL\SOH\DC2\ETX+\b\SO\n\ - \\GS\n\ - \\EOT\EOT\ENQ\STX\NUL\DC2\ETX,\EOT\NAK\"\DLE Native script.\n\ + \\ENQ\EOT\ENQ\b\NUL\SOH\DC2\ETX*\b\NAK\n\ + \3\n\ + \\EOT\EOT\ENQ\STX\NUL\DC2\ETX+\EOT\FS\"& Script based on an address key hash.\n\ \\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\NUL\ENQ\DC2\ETX,\EOT\t\n\ + \\ENQ\EOT\ENQ\STX\NUL\ENQ\DC2\ETX+\EOT\t\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\NUL\SOH\DC2\ETX,\n\ - \\DLE\n\ + \\ENQ\EOT\ENQ\STX\NUL\SOH\DC2\ETX+\n\ + \\ETB\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\NUL\ETX\DC2\ETX,\DC3\DC4\n\ - \ \n\ - \\EOT\EOT\ENQ\STX\SOH\DC2\ETX-\EOT\CAN\"\DC3 Plutus V1 script.\n\ + \\ENQ\EOT\ENQ\STX\NUL\ETX\DC2\ETX+\SUB\ESC\n\ + \G\n\ + \\EOT\EOT\ENQ\STX\SOH\DC2\ETX,\EOT$\": Script that requires all nested scripts to be satisfied.\n\ \\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\SOH\ENQ\DC2\ETX-\EOT\t\n\ + \\ENQ\EOT\ENQ\STX\SOH\ACK\DC2\ETX,\EOT\DC4\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\SOH\SOH\DC2\ETX-\n\ - \\DC3\n\ + \\ENQ\EOT\ENQ\STX\SOH\SOH\DC2\ETX,\NAK\US\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\SOH\ETX\DC2\ETX-\SYN\ETB\n\ - \ \n\ - \\EOT\EOT\ENQ\STX\STX\DC2\ETX.\EOT\CAN\"\DC3 Plutus V2 script.\n\ + \\ENQ\EOT\ENQ\STX\SOH\ETX\DC2\ETX,\"#\n\ + \N\n\ + \\EOT\EOT\ENQ\STX\STX\DC2\ETX-\EOT$\"A Script that requires any of the nested scripts to be satisfied.\n\ \\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\STX\ENQ\DC2\ETX.\EOT\t\n\ + \\ENQ\EOT\ENQ\STX\STX\ACK\DC2\ETX-\EOT\DC4\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\STX\SOH\DC2\ETX.\n\ - \\DC3\n\ + \\ENQ\EOT\ENQ\STX\STX\SOH\DC2\ETX-\NAK\US\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\STX\ETX\DC2\ETX.\SYN\ETB\n\ - \ \n\ - \\EOT\EOT\ENQ\STX\ETX\DC2\ETX/\EOT\CAN\"\DC3 Plutus V3 script.\n\ + \\ENQ\EOT\ENQ\STX\STX\ETX\DC2\ETX-\"#\n\ + \N\n\ + \\EOT\EOT\ENQ\STX\ETX\DC2\ETX.\EOT!\"A Script that requires k out of n nested scripts to be satisfied.\n\ \\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\ETX\ENQ\DC2\ETX/\EOT\t\n\ + \\ENQ\EOT\ENQ\STX\ETX\ACK\DC2\ETX.\EOT\SO\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\ETX\SOH\DC2\ETX/\n\ - \\DC3\n\ + \\ENQ\EOT\ENQ\STX\ETX\SOH\DC2\ETX.\SI\FS\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\ETX\ETX\DC2\ETX/\SYN\ETB\n\ - \ \n\ - \\EOT\EOT\ENQ\STX\EOT\DC2\ETX0\EOT\CAN\"\DC3 Plutus V4 script.\n\ + \\ENQ\EOT\ENQ\STX\ETX\ETX\DC2\ETX.\US \n\ + \>\n\ + \\EOT\EOT\ENQ\STX\EOT\DC2\ETX/\EOT\RS\"1 Slot number before which the script is invalid.\n\ \\n\ \\f\n\ - \\ENQ\EOT\ENQ\STX\EOT\ENQ\DC2\ETX0\EOT\t\n\ - \\f\n\ - \\ENQ\EOT\ENQ\STX\EOT\SOH\DC2\ETX0\n\ - \\DC3\n\ - \\f\n\ - \\ENQ\EOT\ENQ\STX\EOT\ETX\DC2\ETX0\SYN\ETB\n\ - \b\n\ - \\STX\EOT\ACK\DC2\EOT6\NUL9\SOH\SUBV Represents a rational number as a fraction.\n\ - \ TODO u5c increased precision to 64 bits\n\ - \\n\ + \\ENQ\EOT\ENQ\STX\EOT\ENQ\DC2\ETX/\EOT\n\ \\n\ - \\n\ - \\ETX\EOT\ACK\SOH\DC2\ETX6\b\SYN\n\ - \\v\n\ - \\EOT\EOT\ACK\STX\NUL\DC2\ETX7\STX+\n\ - \\f\n\ - \\ENQ\EOT\ACK\STX\NUL\ENQ\DC2\ETX7\STX\a\n\ - \\f\n\ - \\ENQ\EOT\ACK\STX\NUL\SOH\DC2\ETX7\b\DC1\n\ \\f\n\ - \\ENQ\EOT\ACK\STX\NUL\ETX\DC2\ETX7\DC4\NAK\n\ + \\ENQ\EOT\ENQ\STX\EOT\SOH\DC2\ETX/\v\EM\n\ \\f\n\ - \\ENQ\EOT\ACK\STX\NUL\b\DC2\ETX7\SYN*\n\ - \\r\n\ - \\ACK\EOT\ACK\STX\NUL\b\ACK\DC2\ETX7\ETB)\n\ - \\v\n\ - \\EOT\EOT\ACK\STX\SOH\DC2\ETX8\STX.\n\ - \\f\n\ - \\ENQ\EOT\ACK\STX\SOH\ENQ\DC2\ETX8\STX\b\n\ + \\ENQ\EOT\ENQ\STX\EOT\ETX\DC2\ETX/\FS\GS\n\ + \=\n\ + \\EOT\EOT\ENQ\STX\ENQ\DC2\ETX0\EOT!\"0 Slot number after which the script is invalid.\n\ + \\n\ \\f\n\ - \\ENQ\EOT\ACK\STX\SOH\SOH\DC2\ETX8\t\DC4\n\ + \\ENQ\EOT\ENQ\STX\ENQ\ENQ\DC2\ETX0\EOT\n\ + \\n\ \\f\n\ - \\ENQ\EOT\ACK\STX\SOH\ETX\DC2\ETX8\ETB\CAN\n\ + \\ENQ\EOT\ENQ\STX\ENQ\SOH\DC2\ETX0\v\FS\n\ \\f\n\ - \\ENQ\EOT\ACK\STX\SOH\b\DC2\ETX8\EM-\n\ - \\r\n\ - \\ACK\EOT\ACK\STX\SOH\b\ACK\DC2\ETX8\SUB,\n\ - \\FS\n\ - \\STX\EOT\a\DC2\EOT>\NULA\SOH2\DLE PARAMS\n\ - \ ======\n\ + \\ENQ\EOT\ENQ\STX\ENQ\ETX\DC2\ETX0\US \n\ + \2\n\ + \\STX\EOT\ACK\DC2\EOT5\NUL7\SOH\SUB& Represents a list of native scripts.\n\ \\n\ \\n\ \\n\ - \\ETX\EOT\a\SOH\DC2\ETX>\b\SI\n\ - \\v\n\ - \\EOT\EOT\a\STX\NUL\DC2\ETX?\STX\DC3\n\ - \\f\n\ - \\ENQ\EOT\a\STX\NUL\ENQ\DC2\ETX?\STX\b\n\ - \\f\n\ - \\ENQ\EOT\a\STX\NUL\SOH\DC2\ETX?\t\SO\n\ + \\ETX\EOT\ACK\SOH\DC2\ETX5\b\CAN\n\ + \&\n\ + \\EOT\EOT\ACK\STX\NUL\DC2\ETX6\STX\"\"\EM List of native scripts.\n\ + \\n\ \\f\n\ - \\ENQ\EOT\a\STX\NUL\ETX\DC2\ETX?\DC1\DC2\n\ - \\v\n\ - \\EOT\EOT\a\STX\SOH\DC2\ETX@\STX\DC4\n\ + \\ENQ\EOT\ACK\STX\NUL\EOT\DC2\ETX6\STX\n\ + \\n\ \\f\n\ - \\ENQ\EOT\a\STX\SOH\ENQ\DC2\ETX@\STX\b\n\ + \\ENQ\EOT\ACK\STX\NUL\ACK\DC2\ETX6\v\ETB\n\ \\f\n\ - \\ENQ\EOT\a\STX\SOH\SOH\DC2\ETX@\t\SI\n\ + \\ENQ\EOT\ACK\STX\NUL\SOH\DC2\ETX6\CAN\GS\n\ \\f\n\ - \\ENQ\EOT\a\STX\SOH\ETX\DC2\ETX@\DC2\DC3\n\ + \\ENQ\EOT\ACK\STX\NUL\ETX\DC2\ETX6 !\n\ + \6\n\ + \\STX\EOT\a\DC2\EOT:\NUL=\SOH\SUB* Represents a \"k out of n\" native script.\n\ \\n\ \\n\ - \\STX\EOT\b\DC2\EOTC\NULF\SOH\n\ \\n\ + \\ETX\EOT\a\SOH\DC2\ETX:\b\DC2\n\ + \8\n\ + \\EOT\EOT\a\STX\NUL\DC2\ETX;\STX\SI\"+ The number of required satisfied scripts.\n\ \\n\ - \\ETX\EOT\b\SOH\DC2\ETXC\b\DLE\n\ - \\v\n\ - \\EOT\EOT\b\STX\NUL\DC2\ETXD\STX\ESC\n\ \\f\n\ - \\ENQ\EOT\b\STX\NUL\ACK\DC2\ETXD\STX\DLE\n\ + \\ENQ\EOT\a\STX\NUL\ENQ\DC2\ETX;\STX\b\n\ \\f\n\ - \\ENQ\EOT\b\STX\NUL\SOH\DC2\ETXD\DC1\SYN\n\ + \\ENQ\EOT\a\STX\NUL\SOH\DC2\ETX;\t\n\ + \\n\ \\f\n\ - \\ENQ\EOT\b\STX\NUL\ETX\DC2\ETXD\EM\SUB\n\ - \\v\n\ - \\EOT\EOT\b\STX\SOH\DC2\ETXE\STX\FS\n\ + \\ENQ\EOT\a\STX\NUL\ETX\DC2\ETX;\r\SO\n\ + \&\n\ + \\EOT\EOT\a\STX\SOH\DC2\ETX<\STX$\"\EM List of native scripts.\n\ + \\n\ + \\f\n\ + \\ENQ\EOT\a\STX\SOH\EOT\DC2\ETX<\STX\n\ + \\n\ \\f\n\ - \\ENQ\EOT\b\STX\SOH\ACK\DC2\ETXE\STX\DLE\n\ + \\ENQ\EOT\a\STX\SOH\ACK\DC2\ETX<\v\ETB\n\ \\f\n\ - \\ENQ\EOT\b\STX\SOH\SOH\DC2\ETXE\DC1\ETB\n\ + \\ENQ\EOT\a\STX\SOH\SOH\DC2\ETX<\CAN\US\n\ \\f\n\ - \\ENQ\EOT\b\STX\SOH\ETX\DC2\ETXE\SUB\ESC\n\ - \\n\ + \\ENQ\EOT\a\STX\SOH\ETX\DC2\ETX<\"#\n\ + \B\n\ + \\STX\EOT\b\DC2\EOT@\NULD\SOH\SUB6 Represents a constructor for Plutus data in Cardano.\n\ \\n\ - \\STX\EOT\t\DC2\EOTH\NULK\SOH\n\ \\n\ \\n\ - \\ETX\EOT\t\SOH\DC2\ETXH\b\ETB\n\ + \\ETX\EOT\b\SOH\DC2\ETX@\b\SO\n\ \\v\n\ - \\EOT\EOT\t\STX\NUL\DC2\ETXI\STX\DC3\n\ + \\EOT\EOT\b\STX\NUL\DC2\ETXA\STX\DC1\n\ \\f\n\ - \\ENQ\EOT\t\STX\NUL\ENQ\DC2\ETXI\STX\b\n\ + \\ENQ\EOT\b\STX\NUL\ENQ\DC2\ETXA\STX\b\n\ \\f\n\ - \\ENQ\EOT\t\STX\NUL\SOH\DC2\ETXI\t\SO\n\ + \\ENQ\EOT\b\STX\NUL\SOH\DC2\ETXA\t\f\n\ \\f\n\ - \\ENQ\EOT\t\STX\NUL\ETX\DC2\ETXI\DC1\DC2\n\ + \\ENQ\EOT\b\STX\NUL\ETX\DC2\ETXA\SI\DLE\n\ \\v\n\ - \\EOT\EOT\t\STX\SOH\DC2\ETXJ\STX\DC3\n\ + \\EOT\EOT\b\STX\SOH\DC2\ETXB\STX\GS\n\ \\f\n\ - \\ENQ\EOT\t\STX\SOH\ENQ\DC2\ETXJ\STX\b\n\ + \\ENQ\EOT\b\STX\SOH\ENQ\DC2\ETXB\STX\b\n\ \\f\n\ - \\ENQ\EOT\t\STX\SOH\SOH\DC2\ETXJ\t\SO\n\ + \\ENQ\EOT\b\STX\SOH\SOH\DC2\ETXB\t\CAN\n\ \\f\n\ - \\ENQ\EOT\t\STX\SOH\ETX\DC2\ETXJ\DC1\DC2\n\ - \\n\ - \\n\ - \\STX\EOT\n\ - \\DC2\EOTM\NULO\SOH\n\ - \\n\ - \\n\ - \\ETX\EOT\n\ - \\SOH\DC2\ETXM\b\DC1\n\ + \\ENQ\EOT\b\STX\SOH\ETX\DC2\ETXB\ESC\FS\n\ \\v\n\ - \\EOT\EOT\n\ - \\STX\NUL\DC2\ETXN\STX\FS\n\ + \\EOT\EOT\b\STX\STX\DC2\ETXC\STX!\n\ \\f\n\ - \\ENQ\EOT\n\ - \\STX\NUL\EOT\DC2\ETXN\STX\n\ + \\ENQ\EOT\b\STX\STX\EOT\DC2\ETXC\STX\n\ \\n\ \\f\n\ - \\ENQ\EOT\n\ - \\STX\NUL\ENQ\DC2\ETXN\v\DLE\n\ + \\ENQ\EOT\b\STX\STX\ACK\DC2\ETXC\v\NAK\n\ \\f\n\ - \\ENQ\EOT\n\ - \\STX\NUL\SOH\DC2\ETXN\DC1\ETB\n\ + \\ENQ\EOT\b\STX\STX\SOH\DC2\ETXC\SYN\FS\n\ \\f\n\ - \\ENQ\EOT\n\ - \\STX\NUL\ETX\DC2\ETXN\SUB\ESC\n\ - \\n\ + \\ENQ\EOT\b\STX\STX\ETX\DC2\ETXC\US \n\ + \B\n\ + \\STX\EOT\t\DC2\EOTG\NULM\SOH\SUB6 Represents a big integer for Plutus data in Cardano.\n\ \\n\ - \\STX\EOT\v\DC2\EOTQ\NULV\SOH\n\ \\n\ \\n\ - \\ETX\EOT\v\SOH\DC2\ETXQ\b\DC2\n\ - \\v\n\ - \\EOT\EOT\v\STX\NUL\DC2\ETXR\STX\SUB\n\ - \\f\n\ - \\ENQ\EOT\v\STX\NUL\ACK\DC2\ETXR\STX\v\n\ + \\ETX\EOT\t\SOH\DC2\ETXG\b\SO\n\ \\f\n\ - \\ENQ\EOT\v\STX\NUL\SOH\DC2\ETXR\f\NAK\n\ + \\EOT\EOT\t\b\NUL\DC2\EOTH\STXL\ETX\n\ \\f\n\ - \\ENQ\EOT\v\STX\NUL\ETX\DC2\ETXR\CAN\EM\n\ + \\ENQ\EOT\t\b\NUL\SOH\DC2\ETXH\b\SI\n\ \\v\n\ - \\EOT\EOT\v\STX\SOH\DC2\ETXS\STX\SUB\n\ + \\EOT\EOT\t\STX\NUL\DC2\ETXI\EOT'\n\ \\f\n\ - \\ENQ\EOT\v\STX\SOH\ACK\DC2\ETXS\STX\v\n\ + \\ENQ\EOT\t\STX\NUL\ENQ\DC2\ETXI\EOT\t\n\ \\f\n\ - \\ENQ\EOT\v\STX\SOH\SOH\DC2\ETXS\f\NAK\n\ - \\f\n\ - \\ENQ\EOT\v\STX\SOH\ETX\DC2\ETXS\CAN\EM\n\ - \\v\n\ - \\EOT\EOT\v\STX\STX\DC2\ETXT\STX\SUB\n\ - \\f\n\ - \\ENQ\EOT\v\STX\STX\ACK\DC2\ETXT\STX\v\n\ + \\ENQ\EOT\t\STX\NUL\SOH\DC2\ETXI\n\ + \\r\n\ \\f\n\ - \\ENQ\EOT\v\STX\STX\SOH\DC2\ETXT\f\NAK\n\ + \\ENQ\EOT\t\STX\NUL\ETX\DC2\ETXI\DLE\DC1\n\ \\f\n\ - \\ENQ\EOT\v\STX\STX\ETX\DC2\ETXT\CAN\EM\n\ + \\ENQ\EOT\t\STX\NUL\b\DC2\ETXI\DC2&\n\ + \\r\n\ + \\ACK\EOT\t\STX\NUL\b\ACK\DC2\ETXI\DC3%\n\ \\v\n\ - \\EOT\EOT\v\STX\ETX\DC2\ETXU\STX\SUB\n\ + \\EOT\EOT\t\STX\SOH\DC2\ETXJ\EOT\CAN\n\ \\f\n\ - \\ENQ\EOT\v\STX\ETX\ACK\DC2\ETXU\STX\v\n\ + \\ENQ\EOT\t\STX\SOH\ENQ\DC2\ETXJ\EOT\t\n\ \\f\n\ - \\ENQ\EOT\v\STX\ETX\SOH\DC2\ETXU\f\NAK\n\ + \\ENQ\EOT\t\STX\SOH\SOH\DC2\ETXJ\n\ + \\DC3\n\ \\f\n\ - \\ENQ\EOT\v\STX\ETX\ETX\DC2\ETXU\CAN\EM\n\ - \\n\ - \\n\ - \\STX\EOT\f\DC2\EOTX\NULZ\SOH\n\ - \\n\ - \\n\ - \\ETX\EOT\f\SOH\DC2\ETXX\b\CAN\n\ + \\ENQ\EOT\t\STX\SOH\ETX\DC2\ETXJ\SYN\ETB\n\ \\v\n\ - \\EOT\EOT\f\STX\NUL\DC2\ETXY\STX)\n\ - \\f\n\ - \\ENQ\EOT\f\STX\NUL\EOT\DC2\ETXY\STX\n\ - \\n\ + \\EOT\EOT\t\STX\STX\DC2\ETXK\EOT\CAN\n\ \\f\n\ - \\ENQ\EOT\f\STX\NUL\ACK\DC2\ETXY\v\EM\n\ + \\ENQ\EOT\t\STX\STX\ENQ\DC2\ETXK\EOT\t\n\ \\f\n\ - \\ENQ\EOT\f\STX\NUL\SOH\DC2\ETXY\SUB$\n\ + \\ENQ\EOT\t\STX\STX\SOH\DC2\ETXK\n\ + \\DC3\n\ \\f\n\ - \\ENQ\EOT\f\STX\NUL\ETX\DC2\ETXY'(\n\ - \\n\ + \\ENQ\EOT\t\STX\STX\ETX\DC2\ETXK\SYN\ETB\n\ + \E\n\ + \\STX\EOT\n\ + \\DC2\EOTQ\NULT\SOH\SUB9 Represents a key-value pair for Plutus data in Cardano.\n\ \\n\ - \\STX\EOT\r\DC2\EOT\\\NUL|\SOH\n\ \\n\ \\n\ - \\ETX\EOT\r\SOH\DC2\ETX\\\b\SI\n\ - \1\n\ - \\EOT\EOT\r\STX\NUL\DC2\ETX]\STX6\"$ The number of coins per UTXO byte.\n\ + \\ETX\EOT\n\ + \\SOH\DC2\ETXQ\b\SYN\n\ + \\US\n\ + \\EOT\EOT\n\ + \\STX\NUL\DC2\ETXR\STX\NAK\"\DC2 Key of the pair.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\NUL\ENQ\DC2\ETX]\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\NUL\SOH\DC2\ETX]\t\FS\n\ + \\ENQ\EOT\n\ + \\STX\NUL\ACK\DC2\ETXR\STX\f\n\ \\f\n\ - \\ENQ\EOT\r\STX\NUL\ETX\DC2\ETX]\US \n\ + \\ENQ\EOT\n\ + \\STX\NUL\SOH\DC2\ETXR\r\DLE\n\ \\f\n\ - \\ENQ\EOT\r\STX\NUL\b\DC2\ETX]!5\n\ - \\r\n\ - \\ACK\EOT\r\STX\NUL\b\ACK\DC2\ETX]\"4\n\ - \,\n\ - \\EOT\EOT\r\STX\SOH\DC2\ETX^\STX.\"\US The maximum transaction size.\n\ + \\ENQ\EOT\n\ + \\STX\NUL\ETX\DC2\ETXR\DC3\DC4\n\ + \!\n\ + \\EOT\EOT\n\ + \\STX\SOH\DC2\ETXS\STX\ETB\"\DC4 Value of the pair.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\SOH\ENQ\DC2\ETX^\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\SOH\SOH\DC2\ETX^\t\DC4\n\ + \\ENQ\EOT\n\ + \\STX\SOH\ACK\DC2\ETXS\STX\f\n\ \\f\n\ - \\ENQ\EOT\r\STX\SOH\ETX\DC2\ETX^\ETB\CAN\n\ + \\ENQ\EOT\n\ + \\STX\SOH\SOH\DC2\ETXS\r\DC2\n\ \\f\n\ - \\ENQ\EOT\r\STX\SOH\b\DC2\ETX^\EM-\n\ - \\r\n\ - \\ACK\EOT\r\STX\SOH\b\ACK\DC2\ETX^\SUB,\n\ - \+\n\ - \\EOT\EOT\r\STX\STX\DC2\ETX_\STX6\"\RS The minimum fee coefficient.\n\ + \\ENQ\EOT\n\ + \\STX\SOH\ETX\DC2\ETXS\NAK\SYN\n\ + \7\n\ + \\STX\EOT\v\DC2\EOTW\NUL_\SOH\SUB+ Represents a Plutus data item in Cardano.\n\ \\n\ - \\f\n\ - \\ENQ\EOT\r\STX\STX\ENQ\DC2\ETX_\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\STX\SOH\DC2\ETX_\t\FS\n\ - \\f\n\ - \\ENQ\EOT\r\STX\STX\ETX\DC2\ETX_\US \n\ - \\f\n\ - \\ENQ\EOT\r\STX\STX\b\DC2\ETX_!5\n\ - \\r\n\ - \\ACK\EOT\r\STX\STX\b\ACK\DC2\ETX_\"4\n\ - \(\n\ - \\EOT\EOT\r\STX\ETX\DC2\ETX`\STX3\"\ESC The minimum fee constant.\n\ \\n\ - \\f\n\ - \\ENQ\EOT\r\STX\ETX\ENQ\DC2\ETX`\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\ETX\SOH\DC2\ETX`\t\EM\n\ - \\f\n\ - \\ENQ\EOT\r\STX\ETX\ETX\DC2\ETX`\FS\GS\n\ - \\f\n\ - \\ENQ\EOT\r\STX\ETX\b\DC2\ETX`\RS2\n\ - \\r\n\ - \\ACK\EOT\r\STX\ETX\b\ACK\DC2\ETX`\US1\n\ - \+\n\ - \\EOT\EOT\r\STX\EOT\DC2\ETXa\STX6\"\RS The maximum block body size.\n\ \\n\ + \\ETX\EOT\v\SOH\DC2\ETXW\b\DC2\n\ \\f\n\ - \\ENQ\EOT\r\STX\EOT\ENQ\DC2\ETXa\STX\b\n\ + \\EOT\EOT\v\b\NUL\DC2\EOTX\STX^\ETX\n\ \\f\n\ - \\ENQ\EOT\r\STX\EOT\SOH\DC2\ETXa\t\FS\n\ - \\f\n\ - \\ENQ\EOT\r\STX\EOT\ETX\DC2\ETXa\US \n\ - \\f\n\ - \\ENQ\EOT\r\STX\EOT\b\DC2\ETXa!5\n\ - \\r\n\ - \\ACK\EOT\r\STX\EOT\b\ACK\DC2\ETXa\"4\n\ - \-\n\ - \\EOT\EOT\r\STX\ENQ\DC2\ETXb\STX8\" The maximum block header size.\n\ + \\ENQ\EOT\v\b\NUL\SOH\DC2\ETXX\b\DC3\n\ + \\ESC\n\ + \\EOT\EOT\v\STX\NUL\DC2\ETXY\EOT\SYN\"\SO Constructor.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\ENQ\ENQ\DC2\ETXb\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\ENQ\SOH\DC2\ETXb\t\RS\n\ - \\f\n\ - \\ENQ\EOT\r\STX\ENQ\ETX\DC2\ETXb!\"\n\ - \\f\n\ - \\ENQ\EOT\r\STX\ENQ\b\DC2\ETXb#7\n\ - \\r\n\ - \\ACK\EOT\r\STX\ENQ\b\ACK\DC2\ETXb$6\n\ - \%\n\ - \\EOT\EOT\r\STX\ACK\DC2\ETXc\STX4\"\CAN The stake key deposit.\n\ + \\ENQ\EOT\v\STX\NUL\ACK\DC2\ETXY\EOT\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\ACK\ENQ\DC2\ETXc\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\ACK\SOH\DC2\ETXc\t\SUB\n\ + \\ENQ\EOT\v\STX\NUL\SOH\DC2\ETXY\v\DC1\n\ \\f\n\ - \\ENQ\EOT\r\STX\ACK\ETX\DC2\ETXc\GS\RS\n\ - \\f\n\ - \\ENQ\EOT\r\STX\ACK\b\DC2\ETXc\US3\n\ - \\r\n\ - \\ACK\EOT\r\STX\ACK\b\ACK\DC2\ETXc 2\n\ - \ \n\ - \\EOT\EOT\r\STX\a\DC2\ETXd\STX/\"\DC3 The pool deposit.\n\ + \\ENQ\EOT\v\STX\NUL\ETX\DC2\ETXY\DC4\NAK\n\ + \\"\n\ + \\EOT\EOT\v\STX\SOH\DC2\ETXZ\EOT\SUB\"\NAK Map of Plutus data.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\a\ENQ\DC2\ETXd\STX\b\n\ + \\ENQ\EOT\v\STX\SOH\ACK\DC2\ETXZ\EOT\DC1\n\ \\f\n\ - \\ENQ\EOT\r\STX\a\SOH\DC2\ETXd\t\NAK\n\ + \\ENQ\EOT\v\STX\SOH\SOH\DC2\ETXZ\DC2\NAK\n\ \\f\n\ - \\ENQ\EOT\r\STX\a\ETX\DC2\ETXd\CAN\EM\n\ - \\f\n\ - \\ENQ\EOT\r\STX\a\b\DC2\ETXd\SUB.\n\ - \\r\n\ - \\ACK\EOT\r\STX\a\b\ACK\DC2\ETXd\ESC-\n\ - \/\n\ - \\EOT\EOT\r\STX\b\DC2\ETXe\STX)\"\" The pool retirement epoch bound.\n\ + \\ENQ\EOT\v\STX\SOH\ETX\DC2\ETXZ\CAN\EM\n\ + \\ESC\n\ + \\EOT\EOT\v\STX\STX\DC2\ETX[\EOT\ETB\"\SO Big integer.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\b\ENQ\DC2\ETXe\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\b\SOH\DC2\ETXe\t$\n\ - \\f\n\ - \\ENQ\EOT\r\STX\b\ETX\DC2\ETXe'(\n\ - \+\n\ - \\EOT\EOT\r\STX\t\DC2\ETXf\STX&\"\RS The desired number of pools.\n\ + \\ENQ\EOT\v\STX\STX\ACK\DC2\ETX[\EOT\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\t\ENQ\DC2\ETXf\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\t\SOH\DC2\ETXf\t \n\ + \\ENQ\EOT\v\STX\STX\SOH\DC2\ETX[\v\DC2\n\ \\f\n\ - \\ENQ\EOT\r\STX\t\ETX\DC2\ETXf#%\n\ - \\"\n\ - \\EOT\EOT\r\STX\n\ - \\DC2\ETXg\STX%\"\NAK The pool influence.\n\ + \\ENQ\EOT\v\STX\STX\ETX\DC2\ETX[\NAK\SYN\n\ + \\GS\n\ + \\EOT\EOT\v\STX\ETX\DC2\ETX\\\EOT\FS\"\DLE Bounded bytes.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\n\ - \\ACK\DC2\ETXg\STX\DLE\n\ + \\ENQ\EOT\v\STX\ETX\ENQ\DC2\ETX\\\EOT\t\n\ \\f\n\ - \\ENQ\EOT\r\STX\n\ - \\SOH\DC2\ETXg\DC1\US\n\ + \\ENQ\EOT\v\STX\ETX\SOH\DC2\ETX\\\n\ + \\ETB\n\ \\f\n\ - \\ENQ\EOT\r\STX\n\ - \\ETX\DC2\ETXg\"$\n\ - \&\n\ - \\EOT\EOT\r\STX\v\DC2\ETXh\STX)\"\EM The monetary expansion.\n\ + \\ENQ\EOT\v\STX\ETX\ETX\DC2\ETX\\\SUB\ESC\n\ + \$\n\ + \\EOT\EOT\v\STX\EOT\DC2\ETX]\EOT\RS\"\ETB Array of Plutus data.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\v\ACK\DC2\ETXh\STX\DLE\n\ + \\ENQ\EOT\v\STX\EOT\ACK\DC2\ETX]\EOT\DC3\n\ \\f\n\ - \\ENQ\EOT\r\STX\v\SOH\DC2\ETXh\DC1#\n\ + \\ENQ\EOT\v\STX\EOT\SOH\DC2\ETX]\DC4\EM\n\ \\f\n\ - \\ENQ\EOT\r\STX\v\ETX\DC2\ETXh&(\n\ - \&\n\ - \\EOT\EOT\r\STX\f\DC2\ETXi\STX)\"\EM The treasury expansion.\n\ + \\ENQ\EOT\v\STX\EOT\ETX\DC2\ETX]\FS\GS\n\ + \9\n\ + \\STX\EOT\f\DC2\EOTb\NULd\SOH\SUB- Represents a map of Plutus data in Cardano.\n\ \\n\ - \\f\n\ - \\ENQ\EOT\r\STX\f\ACK\DC2\ETXi\STX\DLE\n\ - \\f\n\ - \\ENQ\EOT\r\STX\f\SOH\DC2\ETXi\DC1#\n\ - \\f\n\ - \\ENQ\EOT\r\STX\f\ETX\DC2\ETXi&(\n\ - \%\n\ - \\EOT\EOT\r\STX\r\DC2\ETXj\STX1\"\CAN The minimum pool cost.\n\ \\n\ - \\f\n\ - \\ENQ\EOT\r\STX\r\ENQ\DC2\ETXj\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\r\SOH\DC2\ETXj\t\SYN\n\ - \\f\n\ - \\ENQ\EOT\r\STX\r\ETX\DC2\ETXj\EM\ESC\n\ - \\f\n\ - \\ENQ\EOT\r\STX\r\b\DC2\ETXj\FS0\n\ - \\r\n\ - \\ACK\EOT\r\STX\r\b\ACK\DC2\ETXj\GS/\n\ - \$\n\ - \\EOT\EOT\r\STX\SO\DC2\ETXk\STX(\"\ETB The protocol version.\n\ \\n\ - \\f\n\ - \\ENQ\EOT\r\STX\SO\ACK\DC2\ETXk\STX\DC1\n\ - \\f\n\ - \\ENQ\EOT\r\STX\SO\SOH\DC2\ETXk\DC2\"\n\ - \\f\n\ - \\ENQ\EOT\r\STX\SO\ETX\DC2\ETXk%'\n\ - \&\n\ - \\EOT\EOT\r\STX\SI\DC2\ETXl\STX2\"\EM The maximum value size.\n\ + \\ETX\EOT\f\SOH\DC2\ETXb\b\NAK\n\ + \'\n\ + \\EOT\EOT\f\STX\NUL\DC2\ETXc\STX$\"\SUB List of key-value pairs.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\SI\ENQ\DC2\ETXl\STX\b\n\ - \\f\n\ - \\ENQ\EOT\r\STX\SI\SOH\DC2\ETXl\t\ETB\n\ - \\f\n\ - \\ENQ\EOT\r\STX\SI\ETX\DC2\ETXl\SUB\FS\n\ - \\f\n\ - \\ENQ\EOT\r\STX\SI\b\DC2\ETXl\GS1\n\ - \\r\n\ - \\ACK\EOT\r\STX\SI\b\ACK\DC2\ETXl\RS0\n\ - \)\n\ - \\EOT\EOT\r\STX\DLE\DC2\ETXm\STX9\"\FS The collateral percentage.\n\ + \\ENQ\EOT\f\STX\NUL\EOT\DC2\ETXc\STX\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\DLE\ENQ\DC2\ETXm\STX\b\n\ + \\ENQ\EOT\f\STX\NUL\ACK\DC2\ETXc\v\EM\n\ \\f\n\ - \\ENQ\EOT\r\STX\DLE\SOH\DC2\ETXm\t\RS\n\ + \\ENQ\EOT\f\STX\NUL\SOH\DC2\ETXc\SUB\US\n\ \\f\n\ - \\ENQ\EOT\r\STX\DLE\ETX\DC2\ETXm!#\n\ - \\f\n\ - \\ENQ\EOT\r\STX\DLE\b\DC2\ETXm$8\n\ - \\r\n\ - \\ACK\EOT\r\STX\DLE\b\ACK\DC2\ETXm%7\n\ - \-\n\ - \\EOT\EOT\r\STX\DC1\DC2\ETXn\STX9\" The maximum collateral inputs.\n\ + \\ENQ\EOT\f\STX\NUL\ETX\DC2\ETXc\"#\n\ + \<\n\ + \\STX\EOT\r\DC2\EOTg\NULi\SOH\SUB0 Represents an array of Plutus data in Cardano.\n\ + \\n\ + \\n\ + \\n\ + \\ETX\EOT\r\SOH\DC2\ETXg\b\ETB\n\ + \)\n\ + \\EOT\EOT\r\STX\NUL\DC2\ETXh\STX \"\FS List of Plutus data items.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC1\ENQ\DC2\ETXn\STX\b\n\ + \\ENQ\EOT\r\STX\NUL\EOT\DC2\ETXh\STX\n\ + \\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC1\SOH\DC2\ETXn\t\RS\n\ + \\ENQ\EOT\r\STX\NUL\ACK\DC2\ETXh\v\NAK\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC1\ETX\DC2\ETXn!#\n\ + \\ENQ\EOT\r\STX\NUL\SOH\DC2\ETXh\SYN\ESC\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC1\b\DC2\ETXn$8\n\ - \\r\n\ - \\ACK\EOT\r\STX\DC1\b\ACK\DC2\ETXn%7\n\ - \\US\n\ - \\EOT\EOT\r\STX\DC2\DC2\ETXo\STX\RS\"\DC2 The cost models.\n\ + \\ENQ\EOT\r\STX\NUL\ETX\DC2\ETXh\RS\US\n\ + \n\n\ + \\STX\EOT\SO\DC2\EOTn\NULv\SOH\SUBb Represents a script in Cardano.\n\ + \ TODO u5c: removed native script representation, added plutus_v4\n\ \\n\ + \\n\ + \\n\ + \\ETX\EOT\SO\SOH\DC2\ETXn\b\SO\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC2\ACK\DC2\ETXo\STX\f\n\ - \\f\n\ - \\ENQ\EOT\r\STX\DC2\SOH\DC2\ETXo\r\CAN\n\ + \\EOT\EOT\SO\b\NUL\DC2\EOTo\STXu\ETX\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC2\ETX\DC2\ETXo\ESC\GS\n\ - \\SUB\n\ - \\EOT\EOT\r\STX\DC3\DC2\ETXp\STX\ETB\"\r The prices.\n\ + \\ENQ\EOT\SO\b\NUL\SOH\DC2\ETXo\b\SO\n\ + \\GS\n\ + \\EOT\EOT\SO\STX\NUL\DC2\ETXp\EOT\FS\"\DLE Native script.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC3\ACK\DC2\ETXp\STX\n\ - \\n\ + \\ENQ\EOT\SO\STX\NUL\ACK\DC2\ETXp\EOT\DLE\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC3\SOH\DC2\ETXp\v\DC1\n\ + \\ENQ\EOT\SO\STX\NUL\SOH\DC2\ETXp\DC1\ETB\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC3\ETX\DC2\ETXp\DC4\SYN\n\ - \;\n\ - \\EOT\EOT\r\STX\DC4\DC2\ETXq\STX3\". The maximum execution units per transaction.\n\ + \\ENQ\EOT\SO\STX\NUL\ETX\DC2\ETXp\SUB\ESC\n\ + \ \n\ + \\EOT\EOT\SO\STX\SOH\DC2\ETXq\EOT\CAN\"\DC3 Plutus V1 script.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC4\ACK\DC2\ETXq\STX\t\n\ + \\ENQ\EOT\SO\STX\SOH\ENQ\DC2\ETXq\EOT\t\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC4\SOH\DC2\ETXq\n\ - \-\n\ + \\ENQ\EOT\SO\STX\SOH\SOH\DC2\ETXq\n\ + \\DC3\n\ \\f\n\ - \\ENQ\EOT\r\STX\DC4\ETX\DC2\ETXq02\n\ - \5\n\ - \\EOT\EOT\r\STX\NAK\DC2\ETXr\STX-\"( The maximum execution units per block.\n\ + \\ENQ\EOT\SO\STX\SOH\ETX\DC2\ETXq\SYN\ETB\n\ + \ \n\ + \\EOT\EOT\SO\STX\STX\DC2\ETXr\EOT\CAN\"\DC3 Plutus V2 script.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\NAK\ACK\DC2\ETXr\STX\t\n\ + \\ENQ\EOT\SO\STX\STX\ENQ\DC2\ETXr\EOT\t\n\ \\f\n\ - \\ENQ\EOT\r\STX\NAK\SOH\DC2\ETXr\n\ - \'\n\ + \\ENQ\EOT\SO\STX\STX\SOH\DC2\ETXr\n\ + \\DC3\n\ \\f\n\ - \\ENQ\EOT\r\STX\NAK\ETX\DC2\ETXr*,\n\ - \9\n\ - \\EOT\EOT\r\STX\SYN\DC2\ETXs\STX7\", The minimum fee per script reference byte.\n\ + \\ENQ\EOT\SO\STX\STX\ETX\DC2\ETXr\SYN\ETB\n\ + \ \n\ + \\EOT\EOT\SO\STX\ETX\DC2\ETXs\EOT\CAN\"\DC3 Plutus V3 script.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\SYN\ACK\DC2\ETXs\STX\DLE\n\ + \\ENQ\EOT\SO\STX\ETX\ENQ\DC2\ETXs\EOT\t\n\ \\f\n\ - \\ENQ\EOT\r\STX\SYN\SOH\DC2\ETXs\DC11\n\ + \\ENQ\EOT\SO\STX\ETX\SOH\DC2\ETXs\n\ + \\DC3\n\ \\f\n\ - \\ENQ\EOT\r\STX\SYN\ETX\DC2\ETXs46\n\ - \*\n\ - \\EOT\EOT\r\STX\ETB\DC2\ETXt\STX/\"\GS The pool voting thresholds.\n\ + \\ENQ\EOT\SO\STX\ETX\ETX\DC2\ETXs\SYN\ETB\n\ + \ \n\ + \\EOT\EOT\SO\STX\EOT\DC2\ETXt\EOT\CAN\"\DC3 Plutus V4 script.\n\ \\n\ \\f\n\ - \\ENQ\EOT\r\STX\ETB\ACK\DC2\ETXt\STX\DC2\n\ + \\ENQ\EOT\SO\STX\EOT\ENQ\DC2\ETXt\EOT\t\n\ \\f\n\ - \\ENQ\EOT\r\STX\ETB\SOH\DC2\ETXt\DC3)\n\ + \\ENQ\EOT\SO\STX\EOT\SOH\DC2\ETXt\n\ + \\DC3\n\ \\f\n\ - \\ENQ\EOT\r\STX\ETB\ETX\DC2\ETXt,.\n\ - \*\n\ - \\EOT\EOT\r\STX\CAN\DC2\ETXu\STX/\"\GS The drep voting thresholds.\n\ + \\ENQ\EOT\SO\STX\EOT\ETX\DC2\ETXt\SYN\ETB\n\ + \b\n\ + \\STX\EOT\SI\DC2\EOTz\NUL}\SOH\SUBV Represents a rational number as a fraction.\n\ + \ TODO u5c increased precision to 64 bits\n\ \\n\ + \\n\ + \\n\ + \\ETX\EOT\SI\SOH\DC2\ETXz\b\SYN\n\ + \\v\n\ + \\EOT\EOT\SI\STX\NUL\DC2\ETX{\STX+\n\ \\f\n\ - \\ENQ\EOT\r\STX\CAN\ACK\DC2\ETXu\STX\DC2\n\ + \\ENQ\EOT\SI\STX\NUL\ENQ\DC2\ETX{\STX\a\n\ \\f\n\ - \\ENQ\EOT\r\STX\CAN\SOH\DC2\ETXu\DC3)\n\ + \\ENQ\EOT\SI\STX\NUL\SOH\DC2\ETX{\b\DC1\n\ \\f\n\ - \\ENQ\EOT\r\STX\CAN\ETX\DC2\ETXu,.\n\ - \*\n\ - \\EOT\EOT\r\STX\EM\DC2\ETXv\STX!\"\GS The minimum committee size.\n\ - \\n\ + \\ENQ\EOT\SI\STX\NUL\ETX\DC2\ETX{\DC4\NAK\n\ \\f\n\ - \\ENQ\EOT\r\STX\EM\ENQ\DC2\ETXv\STX\b\n\ + \\ENQ\EOT\SI\STX\NUL\b\DC2\ETX{\SYN*\n\ + \\r\n\ + \\ACK\EOT\SI\STX\NUL\b\ACK\DC2\ETX{\ETB)\n\ + \\v\n\ + \\EOT\EOT\SI\STX\SOH\DC2\ETX|\STX.\n\ \\f\n\ - \\ENQ\EOT\r\STX\EM\SOH\DC2\ETXv\t\ESC\n\ + \\ENQ\EOT\SI\STX\SOH\ENQ\DC2\ETX|\STX\b\n\ \\f\n\ - \\ENQ\EOT\r\STX\EM\ETX\DC2\ETXv\RS \n\ - \(\n\ - \\EOT\EOT\r\STX\SUB\DC2\ETXw\STX#\"\ESC The committee term limit.\n\ + \\ENQ\EOT\SI\STX\SOH\SOH\DC2\ETX|\t\DC4\n\ + \\f\n\ + \\ENQ\EOT\SI\STX\SOH\ETX\DC2\ETX|\ETB\CAN\n\ + \\f\n\ + \\ENQ\EOT\SI\STX\SOH\b\DC2\ETX|\EM-\n\ + \\r\n\ + \\ACK\EOT\SI\STX\SOH\b\ACK\DC2\ETX|\SUB,\n\ + \\RS\n\ + \\STX\EOT\DLE\DC2\ACK\130\SOH\NUL\133\SOH\SOH2\DLE PARAMS\n\ + \ ======\n\ \\n\ + \\v\n\ + \\ETX\EOT\DLE\SOH\DC2\EOT\130\SOH\b\SI\n\ \\f\n\ - \\ENQ\EOT\r\STX\SUB\ENQ\DC2\ETXw\STX\b\n\ + \\EOT\EOT\DLE\STX\NUL\DC2\EOT\131\SOH\STX\DC3\n\ + \\r\n\ + \\ENQ\EOT\DLE\STX\NUL\ENQ\DC2\EOT\131\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\DLE\STX\NUL\SOH\DC2\EOT\131\SOH\t\SO\n\ + \\r\n\ + \\ENQ\EOT\DLE\STX\NUL\ETX\DC2\EOT\131\SOH\DC1\DC2\n\ \\f\n\ - \\ENQ\EOT\r\STX\SUB\SOH\DC2\ETXw\t\GS\n\ + \\EOT\EOT\DLE\STX\SOH\DC2\EOT\132\SOH\STX\DC4\n\ + \\r\n\ + \\ENQ\EOT\DLE\STX\SOH\ENQ\DC2\EOT\132\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\DLE\STX\SOH\SOH\DC2\EOT\132\SOH\t\SI\n\ + \\r\n\ + \\ENQ\EOT\DLE\STX\SOH\ETX\DC2\EOT\132\SOH\DC2\DC3\n\ \\f\n\ - \\ENQ\EOT\r\STX\SUB\ETX\DC2\ETXw \"\n\ - \5\n\ - \\EOT\EOT\r\STX\ESC\DC2\ETXx\STX0\"( The governance action validity period.\n\ - \\n\ + \\STX\EOT\DC1\DC2\ACK\135\SOH\NUL\138\SOH\SOH\n\ + \\v\n\ + \\ETX\EOT\DC1\SOH\DC2\EOT\135\SOH\b\DLE\n\ \\f\n\ - \\ENQ\EOT\r\STX\ESC\ENQ\DC2\ETXx\STX\b\n\ + \\EOT\EOT\DC1\STX\NUL\DC2\EOT\136\SOH\STX\ESC\n\ + \\r\n\ + \\ENQ\EOT\DC1\STX\NUL\ACK\DC2\EOT\136\SOH\STX\DLE\n\ + \\r\n\ + \\ENQ\EOT\DC1\STX\NUL\SOH\DC2\EOT\136\SOH\DC1\SYN\n\ + \\r\n\ + \\ENQ\EOT\DC1\STX\NUL\ETX\DC2\EOT\136\SOH\EM\SUB\n\ \\f\n\ - \\ENQ\EOT\r\STX\ESC\SOH\DC2\ETXx\t*\n\ + \\EOT\EOT\DC1\STX\SOH\DC2\EOT\137\SOH\STX\FS\n\ + \\r\n\ + \\ENQ\EOT\DC1\STX\SOH\ACK\DC2\EOT\137\SOH\STX\DLE\n\ + \\r\n\ + \\ENQ\EOT\DC1\STX\SOH\SOH\DC2\EOT\137\SOH\DC1\ETB\n\ + \\r\n\ + \\ENQ\EOT\DC1\STX\SOH\ETX\DC2\EOT\137\SOH\SUB\ESC\n\ \\f\n\ - \\ENQ\EOT\r\STX\ESC\ETX\DC2\ETXx-/\n\ - \-\n\ - \\EOT\EOT\r\STX\FS\DC2\ETXy\STX=\" The governance action deposit.\n\ - \\n\ + \\STX\EOT\DC2\DC2\ACK\140\SOH\NUL\143\SOH\SOH\n\ + \\v\n\ + \\ETX\EOT\DC2\SOH\DC2\EOT\140\SOH\b\ETB\n\ \\f\n\ - \\ENQ\EOT\r\STX\FS\ENQ\DC2\ETXy\STX\b\n\ + \\EOT\EOT\DC2\STX\NUL\DC2\EOT\141\SOH\STX\DC3\n\ + \\r\n\ + \\ENQ\EOT\DC2\STX\NUL\ENQ\DC2\EOT\141\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\DC2\STX\NUL\SOH\DC2\EOT\141\SOH\t\SO\n\ + \\r\n\ + \\ENQ\EOT\DC2\STX\NUL\ETX\DC2\EOT\141\SOH\DC1\DC2\n\ \\f\n\ - \\ENQ\EOT\r\STX\FS\SOH\DC2\ETXy\t\"\n\ + \\EOT\EOT\DC2\STX\SOH\DC2\EOT\142\SOH\STX\DC3\n\ + \\r\n\ + \\ENQ\EOT\DC2\STX\SOH\ENQ\DC2\EOT\142\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\DC2\STX\SOH\SOH\DC2\EOT\142\SOH\t\SO\n\ + \\r\n\ + \\ENQ\EOT\DC2\STX\SOH\ETX\DC2\EOT\142\SOH\DC1\DC2\n\ \\f\n\ - \\ENQ\EOT\r\STX\FS\ETX\DC2\ETXy%'\n\ + \\STX\EOT\DC3\DC2\ACK\145\SOH\NUL\147\SOH\SOH\n\ + \\v\n\ + \\ETX\EOT\DC3\SOH\DC2\EOT\145\SOH\b\DC1\n\ \\f\n\ - \\ENQ\EOT\r\STX\FS\b\DC2\ETXy(<\n\ + \\EOT\EOT\DC3\STX\NUL\DC2\EOT\146\SOH\STX\FS\n\ \\r\n\ - \\ACK\EOT\r\STX\FS\b\ACK\DC2\ETXy);\n\ - \ \n\ - \\EOT\EOT\r\STX\GS\DC2\ETXz\STX0\"\DC3 The drep deposit.\n\ + \\ENQ\EOT\DC3\STX\NUL\EOT\DC2\EOT\146\SOH\STX\n\ \\n\ + \\r\n\ + \\ENQ\EOT\DC3\STX\NUL\ENQ\DC2\EOT\146\SOH\v\DLE\n\ + \\r\n\ + \\ENQ\EOT\DC3\STX\NUL\SOH\DC2\EOT\146\SOH\DC1\ETB\n\ + \\r\n\ + \\ENQ\EOT\DC3\STX\NUL\ETX\DC2\EOT\146\SOH\SUB\ESC\n\ \\f\n\ - \\ENQ\EOT\r\STX\GS\ENQ\DC2\ETXz\STX\b\n\ + \\STX\EOT\DC4\DC2\ACK\149\SOH\NUL\154\SOH\SOH\n\ + \\v\n\ + \\ETX\EOT\DC4\SOH\DC2\EOT\149\SOH\b\DC2\n\ \\f\n\ - \\ENQ\EOT\r\STX\GS\SOH\DC2\ETXz\t\NAK\n\ + \\EOT\EOT\DC4\STX\NUL\DC2\EOT\150\SOH\STX\SUB\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\NUL\ACK\DC2\EOT\150\SOH\STX\v\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\NUL\SOH\DC2\EOT\150\SOH\f\NAK\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\NUL\ETX\DC2\EOT\150\SOH\CAN\EM\n\ \\f\n\ - \\ENQ\EOT\r\STX\GS\ETX\DC2\ETXz\CAN\SUB\n\ + \\EOT\EOT\DC4\STX\SOH\DC2\EOT\151\SOH\STX\SUB\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\SOH\ACK\DC2\EOT\151\SOH\STX\v\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\SOH\SOH\DC2\EOT\151\SOH\f\NAK\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\SOH\ETX\DC2\EOT\151\SOH\CAN\EM\n\ \\f\n\ - \\ENQ\EOT\r\STX\GS\b\DC2\ETXz\ESC/\n\ + \\EOT\EOT\DC4\STX\STX\DC2\EOT\152\SOH\STX\SUB\n\ \\r\n\ - \\ACK\EOT\r\STX\GS\b\ACK\DC2\ETXz\FS.\n\ - \*\n\ - \\EOT\EOT\r\STX\RS\DC2\ETX{\STX%\"\GS The drep inactivity period.\n\ - \\n\ + \\ENQ\EOT\DC4\STX\STX\ACK\DC2\EOT\152\SOH\STX\v\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\STX\SOH\DC2\EOT\152\SOH\f\NAK\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\STX\ETX\DC2\EOT\152\SOH\CAN\EM\n\ + \\f\n\ + \\EOT\EOT\DC4\STX\ETX\DC2\EOT\153\SOH\STX\SUB\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\ETX\ACK\DC2\EOT\153\SOH\STX\v\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\ETX\SOH\DC2\EOT\153\SOH\f\NAK\n\ + \\r\n\ + \\ENQ\EOT\DC4\STX\ETX\ETX\DC2\EOT\153\SOH\CAN\EM\n\ \\f\n\ - \\ENQ\EOT\r\STX\RS\ENQ\DC2\ETX{\STX\b\n\ + \\STX\EOT\NAK\DC2\ACK\156\SOH\NUL\158\SOH\SOH\n\ + \\v\n\ + \\ETX\EOT\NAK\SOH\DC2\EOT\156\SOH\b\CAN\n\ \\f\n\ - \\ENQ\EOT\r\STX\RS\SOH\DC2\ETX{\t\US\n\ + \\EOT\EOT\NAK\STX\NUL\DC2\EOT\157\SOH\STX)\n\ + \\r\n\ + \\ENQ\EOT\NAK\STX\NUL\EOT\DC2\EOT\157\SOH\STX\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\NAK\STX\NUL\ACK\DC2\EOT\157\SOH\v\EM\n\ + \\r\n\ + \\ENQ\EOT\NAK\STX\NUL\SOH\DC2\EOT\157\SOH\SUB$\n\ + \\r\n\ + \\ENQ\EOT\NAK\STX\NUL\ETX\DC2\EOT\157\SOH'(\n\ \\f\n\ - \\ENQ\EOT\r\STX\RS\ETX\DC2\ETX{\"$b\ACKproto3" \ No newline at end of file + \\STX\EOT\SYN\DC2\ACK\160\SOH\NUL\192\SOH\SOH\n\ + \\v\n\ + \\ETX\EOT\SYN\SOH\DC2\EOT\160\SOH\b\SI\n\ + \2\n\ + \\EOT\EOT\SYN\STX\NUL\DC2\EOT\161\SOH\STX6\"$ The number of coins per UTXO byte.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\NUL\ENQ\DC2\EOT\161\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\NUL\SOH\DC2\EOT\161\SOH\t\FS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\NUL\ETX\DC2\EOT\161\SOH\US \n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\NUL\b\DC2\EOT\161\SOH!5\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\NUL\b\ACK\DC2\EOT\161\SOH\"4\n\ + \-\n\ + \\EOT\EOT\SYN\STX\SOH\DC2\EOT\162\SOH\STX.\"\US The maximum transaction size.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SOH\ENQ\DC2\EOT\162\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SOH\SOH\DC2\EOT\162\SOH\t\DC4\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SOH\ETX\DC2\EOT\162\SOH\ETB\CAN\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SOH\b\DC2\EOT\162\SOH\EM-\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\SOH\b\ACK\DC2\EOT\162\SOH\SUB,\n\ + \,\n\ + \\EOT\EOT\SYN\STX\STX\DC2\EOT\163\SOH\STX6\"\RS The minimum fee coefficient.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\STX\ENQ\DC2\EOT\163\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\STX\SOH\DC2\EOT\163\SOH\t\FS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\STX\ETX\DC2\EOT\163\SOH\US \n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\STX\b\DC2\EOT\163\SOH!5\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\STX\b\ACK\DC2\EOT\163\SOH\"4\n\ + \)\n\ + \\EOT\EOT\SYN\STX\ETX\DC2\EOT\164\SOH\STX3\"\ESC The minimum fee constant.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ETX\ENQ\DC2\EOT\164\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ETX\SOH\DC2\EOT\164\SOH\t\EM\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ETX\ETX\DC2\EOT\164\SOH\FS\GS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ETX\b\DC2\EOT\164\SOH\RS2\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\ETX\b\ACK\DC2\EOT\164\SOH\US1\n\ + \,\n\ + \\EOT\EOT\SYN\STX\EOT\DC2\EOT\165\SOH\STX6\"\RS The maximum block body size.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\EOT\ENQ\DC2\EOT\165\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\EOT\SOH\DC2\EOT\165\SOH\t\FS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\EOT\ETX\DC2\EOT\165\SOH\US \n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\EOT\b\DC2\EOT\165\SOH!5\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\EOT\b\ACK\DC2\EOT\165\SOH\"4\n\ + \.\n\ + \\EOT\EOT\SYN\STX\ENQ\DC2\EOT\166\SOH\STX8\" The maximum block header size.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ENQ\ENQ\DC2\EOT\166\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ENQ\SOH\DC2\EOT\166\SOH\t\RS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ENQ\ETX\DC2\EOT\166\SOH!\"\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ENQ\b\DC2\EOT\166\SOH#7\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\ENQ\b\ACK\DC2\EOT\166\SOH$6\n\ + \&\n\ + \\EOT\EOT\SYN\STX\ACK\DC2\EOT\167\SOH\STX4\"\CAN The stake key deposit.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ACK\ENQ\DC2\EOT\167\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ACK\SOH\DC2\EOT\167\SOH\t\SUB\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ACK\ETX\DC2\EOT\167\SOH\GS\RS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ACK\b\DC2\EOT\167\SOH\US3\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\ACK\b\ACK\DC2\EOT\167\SOH 2\n\ + \!\n\ + \\EOT\EOT\SYN\STX\a\DC2\EOT\168\SOH\STX/\"\DC3 The pool deposit.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\a\ENQ\DC2\EOT\168\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\a\SOH\DC2\EOT\168\SOH\t\NAK\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\a\ETX\DC2\EOT\168\SOH\CAN\EM\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\a\b\DC2\EOT\168\SOH\SUB.\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\a\b\ACK\DC2\EOT\168\SOH\ESC-\n\ + \0\n\ + \\EOT\EOT\SYN\STX\b\DC2\EOT\169\SOH\STX)\"\" The pool retirement epoch bound.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\b\ENQ\DC2\EOT\169\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\b\SOH\DC2\EOT\169\SOH\t$\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\b\ETX\DC2\EOT\169\SOH'(\n\ + \,\n\ + \\EOT\EOT\SYN\STX\t\DC2\EOT\170\SOH\STX&\"\RS The desired number of pools.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\t\ENQ\DC2\EOT\170\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\t\SOH\DC2\EOT\170\SOH\t \n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\t\ETX\DC2\EOT\170\SOH#%\n\ + \#\n\ + \\EOT\EOT\SYN\STX\n\ + \\DC2\EOT\171\SOH\STX%\"\NAK The pool influence.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\n\ + \\ACK\DC2\EOT\171\SOH\STX\DLE\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\n\ + \\SOH\DC2\EOT\171\SOH\DC1\US\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\n\ + \\ETX\DC2\EOT\171\SOH\"$\n\ + \'\n\ + \\EOT\EOT\SYN\STX\v\DC2\EOT\172\SOH\STX)\"\EM The monetary expansion.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\v\ACK\DC2\EOT\172\SOH\STX\DLE\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\v\SOH\DC2\EOT\172\SOH\DC1#\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\v\ETX\DC2\EOT\172\SOH&(\n\ + \'\n\ + \\EOT\EOT\SYN\STX\f\DC2\EOT\173\SOH\STX)\"\EM The treasury expansion.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\f\ACK\DC2\EOT\173\SOH\STX\DLE\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\f\SOH\DC2\EOT\173\SOH\DC1#\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\f\ETX\DC2\EOT\173\SOH&(\n\ + \&\n\ + \\EOT\EOT\SYN\STX\r\DC2\EOT\174\SOH\STX1\"\CAN The minimum pool cost.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\r\ENQ\DC2\EOT\174\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\r\SOH\DC2\EOT\174\SOH\t\SYN\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\r\ETX\DC2\EOT\174\SOH\EM\ESC\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\r\b\DC2\EOT\174\SOH\FS0\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\r\b\ACK\DC2\EOT\174\SOH\GS/\n\ + \%\n\ + \\EOT\EOT\SYN\STX\SO\DC2\EOT\175\SOH\STX(\"\ETB The protocol version.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SO\ACK\DC2\EOT\175\SOH\STX\DC1\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SO\SOH\DC2\EOT\175\SOH\DC2\"\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SO\ETX\DC2\EOT\175\SOH%'\n\ + \'\n\ + \\EOT\EOT\SYN\STX\SI\DC2\EOT\176\SOH\STX2\"\EM The maximum value size.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SI\ENQ\DC2\EOT\176\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SI\SOH\DC2\EOT\176\SOH\t\ETB\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SI\ETX\DC2\EOT\176\SOH\SUB\FS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SI\b\DC2\EOT\176\SOH\GS1\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\SI\b\ACK\DC2\EOT\176\SOH\RS0\n\ + \*\n\ + \\EOT\EOT\SYN\STX\DLE\DC2\EOT\177\SOH\STX9\"\FS The collateral percentage.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DLE\ENQ\DC2\EOT\177\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DLE\SOH\DC2\EOT\177\SOH\t\RS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DLE\ETX\DC2\EOT\177\SOH!#\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DLE\b\DC2\EOT\177\SOH$8\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\DLE\b\ACK\DC2\EOT\177\SOH%7\n\ + \.\n\ + \\EOT\EOT\SYN\STX\DC1\DC2\EOT\178\SOH\STX9\" The maximum collateral inputs.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC1\ENQ\DC2\EOT\178\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC1\SOH\DC2\EOT\178\SOH\t\RS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC1\ETX\DC2\EOT\178\SOH!#\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC1\b\DC2\EOT\178\SOH$8\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\DC1\b\ACK\DC2\EOT\178\SOH%7\n\ + \ \n\ + \\EOT\EOT\SYN\STX\DC2\DC2\EOT\179\SOH\STX\RS\"\DC2 The cost models.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC2\ACK\DC2\EOT\179\SOH\STX\f\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC2\SOH\DC2\EOT\179\SOH\r\CAN\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC2\ETX\DC2\EOT\179\SOH\ESC\GS\n\ + \\ESC\n\ + \\EOT\EOT\SYN\STX\DC3\DC2\EOT\180\SOH\STX\ETB\"\r The prices.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC3\ACK\DC2\EOT\180\SOH\STX\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC3\SOH\DC2\EOT\180\SOH\v\DC1\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC3\ETX\DC2\EOT\180\SOH\DC4\SYN\n\ + \<\n\ + \\EOT\EOT\SYN\STX\DC4\DC2\EOT\181\SOH\STX3\". The maximum execution units per transaction.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC4\ACK\DC2\EOT\181\SOH\STX\t\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC4\SOH\DC2\EOT\181\SOH\n\ + \-\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\DC4\ETX\DC2\EOT\181\SOH02\n\ + \6\n\ + \\EOT\EOT\SYN\STX\NAK\DC2\EOT\182\SOH\STX-\"( The maximum execution units per block.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\NAK\ACK\DC2\EOT\182\SOH\STX\t\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\NAK\SOH\DC2\EOT\182\SOH\n\ + \'\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\NAK\ETX\DC2\EOT\182\SOH*,\n\ + \:\n\ + \\EOT\EOT\SYN\STX\SYN\DC2\EOT\183\SOH\STX7\", The minimum fee per script reference byte.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SYN\ACK\DC2\EOT\183\SOH\STX\DLE\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SYN\SOH\DC2\EOT\183\SOH\DC11\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SYN\ETX\DC2\EOT\183\SOH46\n\ + \+\n\ + \\EOT\EOT\SYN\STX\ETB\DC2\EOT\184\SOH\STX/\"\GS The pool voting thresholds.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ETB\ACK\DC2\EOT\184\SOH\STX\DC2\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ETB\SOH\DC2\EOT\184\SOH\DC3)\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ETB\ETX\DC2\EOT\184\SOH,.\n\ + \+\n\ + \\EOT\EOT\SYN\STX\CAN\DC2\EOT\185\SOH\STX/\"\GS The drep voting thresholds.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\CAN\ACK\DC2\EOT\185\SOH\STX\DC2\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\CAN\SOH\DC2\EOT\185\SOH\DC3)\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\CAN\ETX\DC2\EOT\185\SOH,.\n\ + \+\n\ + \\EOT\EOT\SYN\STX\EM\DC2\EOT\186\SOH\STX!\"\GS The minimum committee size.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\EM\ENQ\DC2\EOT\186\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\EM\SOH\DC2\EOT\186\SOH\t\ESC\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\EM\ETX\DC2\EOT\186\SOH\RS \n\ + \)\n\ + \\EOT\EOT\SYN\STX\SUB\DC2\EOT\187\SOH\STX#\"\ESC The committee term limit.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SUB\ENQ\DC2\EOT\187\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SUB\SOH\DC2\EOT\187\SOH\t\GS\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\SUB\ETX\DC2\EOT\187\SOH \"\n\ + \6\n\ + \\EOT\EOT\SYN\STX\ESC\DC2\EOT\188\SOH\STX0\"( The governance action validity period.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ESC\ENQ\DC2\EOT\188\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ESC\SOH\DC2\EOT\188\SOH\t*\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\ESC\ETX\DC2\EOT\188\SOH-/\n\ + \.\n\ + \\EOT\EOT\SYN\STX\FS\DC2\EOT\189\SOH\STX=\" The governance action deposit.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\FS\ENQ\DC2\EOT\189\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\FS\SOH\DC2\EOT\189\SOH\t\"\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\FS\ETX\DC2\EOT\189\SOH%'\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\FS\b\DC2\EOT\189\SOH(<\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\FS\b\ACK\DC2\EOT\189\SOH);\n\ + \!\n\ + \\EOT\EOT\SYN\STX\GS\DC2\EOT\190\SOH\STX0\"\DC3 The drep deposit.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\GS\ENQ\DC2\EOT\190\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\GS\SOH\DC2\EOT\190\SOH\t\NAK\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\GS\ETX\DC2\EOT\190\SOH\CAN\SUB\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\GS\b\DC2\EOT\190\SOH\ESC/\n\ + \\SO\n\ + \\ACK\EOT\SYN\STX\GS\b\ACK\DC2\EOT\190\SOH\FS.\n\ + \+\n\ + \\EOT\EOT\SYN\STX\RS\DC2\EOT\191\SOH\STX%\"\GS The drep inactivity period.\n\ + \\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\RS\ENQ\DC2\EOT\191\SOH\STX\b\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\RS\SOH\DC2\EOT\191\SOH\t\US\n\ + \\r\n\ + \\ENQ\EOT\SYN\STX\RS\ETX\DC2\EOT\191\SOH\"$b\ACKproto3" \ No newline at end of file diff --git a/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano_Fields.hs b/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano_Fields.hs index bbb2846495..efadac025d 100644 --- a/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano_Fields.hs +++ b/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano_Fields.hs @@ -32,11 +32,43 @@ address :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "address" a) => Lens.Family2.LensLike' f s a address = Data.ProtoLens.Field.field @"address" +anyConstructor :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "anyConstructor" a) => + Lens.Family2.LensLike' f s a +anyConstructor = Data.ProtoLens.Field.field @"anyConstructor" +array :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "array" a) => + Lens.Family2.LensLike' f s a +array = Data.ProtoLens.Field.field @"array" assets :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "assets" a) => Lens.Family2.LensLike' f s a assets = Data.ProtoLens.Field.field @"assets" +bigInt :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "bigInt" a) => + Lens.Family2.LensLike' f s a +bigInt = Data.ProtoLens.Field.field @"bigInt" +bigNInt :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "bigNInt" a) => + Lens.Family2.LensLike' f s a +bigNInt = Data.ProtoLens.Field.field @"bigNInt" +bigUInt :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "bigUInt" a) => + Lens.Family2.LensLike' f s a +bigUInt = Data.ProtoLens.Field.field @"bigUInt" +boundedBytes :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "boundedBytes" a) => + Lens.Family2.LensLike' f s a +boundedBytes = Data.ProtoLens.Field.field @"boundedBytes" coin :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "coin" a) => @@ -62,6 +94,11 @@ committeeTermLimit :: Lens.Family2.LensLike' f s a committeeTermLimit = Data.ProtoLens.Field.field @"committeeTermLimit" +constr :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "constr" a) => + Lens.Family2.LensLike' f s a +constr = Data.ProtoLens.Field.field @"constr" costModels :: forall f s a. (Prelude.Functor f, @@ -106,6 +143,11 @@ drepVotingThresholds :: Lens.Family2.LensLike' f s a drepVotingThresholds = Data.ProtoLens.Field.field @"drepVotingThresholds" +fields :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "fields" a) => + Lens.Family2.LensLike' f s a +fields = Data.ProtoLens.Field.field @"fields" governanceActionDeposit :: forall f s a. (Prelude.Functor f, @@ -125,16 +167,48 @@ hash :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "hash" a) => Lens.Family2.LensLike' f s a hash = Data.ProtoLens.Field.field @"hash" +int :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "int" a) => + Lens.Family2.LensLike' f s a +int = Data.ProtoLens.Field.field @"int" +invalidBefore :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "invalidBefore" a) => + Lens.Family2.LensLike' f s a +invalidBefore = Data.ProtoLens.Field.field @"invalidBefore" +invalidHereafter :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "invalidHereafter" a) => + Lens.Family2.LensLike' f s a +invalidHereafter = Data.ProtoLens.Field.field @"invalidHereafter" items :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "items" a) => Lens.Family2.LensLike' f s a items = Data.ProtoLens.Field.field @"items" +k :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "k" a) => + Lens.Family2.LensLike' f s a +k = Data.ProtoLens.Field.field @"k" +key :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "key" a) => + Lens.Family2.LensLike' f s a +key = Data.ProtoLens.Field.field @"key" major :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "major" a) => Lens.Family2.LensLike' f s a major = Data.ProtoLens.Field.field @"major" +map :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "map" a) => + Lens.Family2.LensLike' f s a +map = Data.ProtoLens.Field.field @"map" maxBlockBodySize :: forall f s a. (Prelude.Functor f, @@ -181,6 +255,43 @@ maxValueSize :: Data.ProtoLens.Field.HasField s "maxValueSize" a) => Lens.Family2.LensLike' f s a maxValueSize = Data.ProtoLens.Field.field @"maxValueSize" +maybe'array :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'array" a) => + Lens.Family2.LensLike' f s a +maybe'array = Data.ProtoLens.Field.field @"maybe'array" +maybe'bigInt :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'bigInt" a) => + Lens.Family2.LensLike' f s a +maybe'bigInt = Data.ProtoLens.Field.field @"maybe'bigInt" +maybe'bigNInt :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'bigNInt" a) => + Lens.Family2.LensLike' f s a +maybe'bigNInt = Data.ProtoLens.Field.field @"maybe'bigNInt" +maybe'bigUInt :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'bigUInt" a) => + Lens.Family2.LensLike' f s a +maybe'bigUInt = Data.ProtoLens.Field.field @"maybe'bigUInt" +maybe'boundedBytes :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'boundedBytes" a) => + Lens.Family2.LensLike' f s a +maybe'boundedBytes + = Data.ProtoLens.Field.field @"maybe'boundedBytes" +maybe'constr :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'constr" a) => + Lens.Family2.LensLike' f s a +maybe'constr = Data.ProtoLens.Field.field @"maybe'constr" maybe'costModels :: forall f s a. (Prelude.Functor f, @@ -200,6 +311,38 @@ maybe'drepVotingThresholds :: Lens.Family2.LensLike' f s a maybe'drepVotingThresholds = Data.ProtoLens.Field.field @"maybe'drepVotingThresholds" +maybe'int :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'int" a) => + Lens.Family2.LensLike' f s a +maybe'int = Data.ProtoLens.Field.field @"maybe'int" +maybe'invalidBefore :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'invalidBefore" a) => + Lens.Family2.LensLike' f s a +maybe'invalidBefore + = Data.ProtoLens.Field.field @"maybe'invalidBefore" +maybe'invalidHereafter :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'invalidHereafter" a) => + Lens.Family2.LensLike' f s a +maybe'invalidHereafter + = Data.ProtoLens.Field.field @"maybe'invalidHereafter" +maybe'key :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'key" a) => + Lens.Family2.LensLike' f s a +maybe'key = Data.ProtoLens.Field.field @"maybe'key" +maybe'map :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'map" a) => + Lens.Family2.LensLike' f s a +maybe'map = Data.ProtoLens.Field.field @"maybe'map" maybe'maxExecutionUnitsPerBlock :: forall f s a. (Prelude.Functor f, @@ -247,12 +390,31 @@ maybe'native :: Data.ProtoLens.Field.HasField s "maybe'native" a) => Lens.Family2.LensLike' f s a maybe'native = Data.ProtoLens.Field.field @"maybe'native" +maybe'nativeScript :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'nativeScript" a) => + Lens.Family2.LensLike' f s a +maybe'nativeScript + = Data.ProtoLens.Field.field @"maybe'nativeScript" maybe'outputCoin :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "maybe'outputCoin" a) => Lens.Family2.LensLike' f s a maybe'outputCoin = Data.ProtoLens.Field.field @"maybe'outputCoin" +maybe'payload :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'payload" a) => + Lens.Family2.LensLike' f s a +maybe'payload = Data.ProtoLens.Field.field @"maybe'payload" +maybe'plutusData :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'plutusData" a) => + Lens.Family2.LensLike' f s a +maybe'plutusData = Data.ProtoLens.Field.field @"maybe'plutusData" maybe'plutusV1 :: forall f s a. (Prelude.Functor f, @@ -316,6 +478,31 @@ maybe'script :: Data.ProtoLens.Field.HasField s "maybe'script" a) => Lens.Family2.LensLike' f s a maybe'script = Data.ProtoLens.Field.field @"maybe'script" +maybe'scriptAll :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'scriptAll" a) => + Lens.Family2.LensLike' f s a +maybe'scriptAll = Data.ProtoLens.Field.field @"maybe'scriptAll" +maybe'scriptAny :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'scriptAny" a) => + Lens.Family2.LensLike' f s a +maybe'scriptAny = Data.ProtoLens.Field.field @"maybe'scriptAny" +maybe'scriptNOfK :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'scriptNOfK" a) => + Lens.Family2.LensLike' f s a +maybe'scriptNOfK = Data.ProtoLens.Field.field @"maybe'scriptNOfK" +maybe'scriptPubkey :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'scriptPubkey" a) => + Lens.Family2.LensLike' f s a +maybe'scriptPubkey + = Data.ProtoLens.Field.field @"maybe'scriptPubkey" maybe'steps :: forall f s a. (Prelude.Functor f, @@ -329,6 +516,12 @@ maybe'treasuryExpansion :: Lens.Family2.LensLike' f s a maybe'treasuryExpansion = Data.ProtoLens.Field.field @"maybe'treasuryExpansion" +maybe'value :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'value" a) => + Lens.Family2.LensLike' f s a +maybe'value = Data.ProtoLens.Field.field @"maybe'value" memory :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "memory" a) => @@ -410,6 +603,16 @@ outputCoin :: Data.ProtoLens.Field.HasField s "outputCoin" a) => Lens.Family2.LensLike' f s a outputCoin = Data.ProtoLens.Field.field @"outputCoin" +pairs :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "pairs" a) => + Lens.Family2.LensLike' f s a +pairs = Data.ProtoLens.Field.field @"pairs" +payload :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "payload" a) => + Lens.Family2.LensLike' f s a +payload = Data.ProtoLens.Field.field @"payload" plutusV1 :: forall f s a. (Prelude.Functor f, @@ -482,6 +685,35 @@ script :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "script" a) => Lens.Family2.LensLike' f s a script = Data.ProtoLens.Field.field @"script" +scriptAll :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "scriptAll" a) => + Lens.Family2.LensLike' f s a +scriptAll = Data.ProtoLens.Field.field @"scriptAll" +scriptAny :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "scriptAny" a) => + Lens.Family2.LensLike' f s a +scriptAny = Data.ProtoLens.Field.field @"scriptAny" +scriptNOfK :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "scriptNOfK" a) => + Lens.Family2.LensLike' f s a +scriptNOfK = Data.ProtoLens.Field.field @"scriptNOfK" +scriptPubkey :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "scriptPubkey" a) => + Lens.Family2.LensLike' f s a +scriptPubkey = Data.ProtoLens.Field.field @"scriptPubkey" +scripts :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "scripts" a) => + Lens.Family2.LensLike' f s a +scripts = Data.ProtoLens.Field.field @"scripts" stakeKeyDeposit :: forall f s a. (Prelude.Functor f, @@ -493,6 +725,11 @@ steps :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "steps" a) => Lens.Family2.LensLike' f s a steps = Data.ProtoLens.Field.field @"steps" +tag :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "tag" a) => + Lens.Family2.LensLike' f s a +tag = Data.ProtoLens.Field.field @"tag" thresholds :: forall f s a. (Prelude.Functor f, @@ -505,6 +742,11 @@ treasuryExpansion :: Data.ProtoLens.Field.HasField s "treasuryExpansion" a) => Lens.Family2.LensLike' f s a treasuryExpansion = Data.ProtoLens.Field.field @"treasuryExpansion" +value :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "value" a) => + Lens.Family2.LensLike' f s a +value = Data.ProtoLens.Field.field @"value" values :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "values" a) => @@ -516,12 +758,30 @@ vec'assets :: Data.ProtoLens.Field.HasField s "vec'assets" a) => Lens.Family2.LensLike' f s a vec'assets = Data.ProtoLens.Field.field @"vec'assets" +vec'fields :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "vec'fields" a) => + Lens.Family2.LensLike' f s a +vec'fields = Data.ProtoLens.Field.field @"vec'fields" vec'items :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "vec'items" a) => Lens.Family2.LensLike' f s a vec'items = Data.ProtoLens.Field.field @"vec'items" +vec'pairs :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "vec'pairs" a) => + Lens.Family2.LensLike' f s a +vec'pairs = Data.ProtoLens.Field.field @"vec'pairs" +vec'scripts :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "vec'scripts" a) => + Lens.Family2.LensLike' f s a +vec'scripts = Data.ProtoLens.Field.field @"vec'scripts" vec'thresholds :: forall f s a. (Prelude.Functor f, From 317787dd8d44efcb526f24bbda97657e0d2c5356 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 14 Nov 2025 11:29:03 +0100 Subject: [PATCH 5/9] cardano-rpc | Make Datum.payload and Datum.original_cbor proto definitions optional --- cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto index 7d421ac009..3602a36d84 100644 --- a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto +++ b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto @@ -18,8 +18,8 @@ message AddressArray { message Datum { bytes hash = 1; // Hash of this datum as seen on-chain - PlutusData payload = 2; // Parsed Plutus data payload - bytes original_cbor = 3; // Original cbor-encoded data as seen on-chain + optional PlutusData payload = 2; // Parsed Plutus data payload + optional bytes original_cbor = 3; // Original cbor-encoded data as seen on-chain } // Represents a custom asset in the Cardano blockchain. From 61b8bf649928672ab9c5236cd29d9c62a9079fb2 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 14 Nov 2025 11:29:46 +0100 Subject: [PATCH 6/9] cardano-rpc | Regenerate code from proto files --- .../Proto/Utxorpc/V1alpha/Cardano/Cardano.hs | 92 +++++++++++-------- .../Utxorpc/V1alpha/Cardano/Cardano_Fields.hs | 7 ++ 2 files changed, 61 insertions(+), 38 deletions(-) diff --git a/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano.hs b/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano.hs index 80389b87d4..56e5073f81 100644 --- a/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano.hs +++ b/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano.hs @@ -1342,11 +1342,12 @@ instance Control.DeepSeq.NFData CostModels where * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.hash' @:: Lens' Datum Data.ByteString.ByteString@ * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.payload' @:: Lens' Datum PlutusData@ * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'payload' @:: Lens' Datum (Prelude.Maybe PlutusData)@ - * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.originalCbor' @:: Lens' Datum Data.ByteString.ByteString@ -} + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.originalCbor' @:: Lens' Datum Data.ByteString.ByteString@ + * 'Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields.maybe'originalCbor' @:: Lens' Datum (Prelude.Maybe Data.ByteString.ByteString)@ -} data Datum = Datum'_constructor {_Datum'hash :: !Data.ByteString.ByteString, _Datum'payload :: !(Prelude.Maybe PlutusData), - _Datum'originalCbor :: !Data.ByteString.ByteString, + _Datum'originalCbor :: !(Prelude.Maybe Data.ByteString.ByteString), _Datum'_unknownFields :: !Data.ProtoLens.FieldSet} deriving stock (Prelude.Eq, Prelude.Ord) instance Prelude.Show Datum where @@ -1374,6 +1375,12 @@ instance Data.ProtoLens.Field.HasField Datum "maybe'payload" (Prelude.Maybe Plut _Datum'payload (\ x__ y__ -> x__ {_Datum'payload = y__})) Prelude.id instance Data.ProtoLens.Field.HasField Datum "originalCbor" Data.ByteString.ByteString where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _Datum'originalCbor (\ x__ y__ -> x__ {_Datum'originalCbor = y__})) + (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault) +instance Data.ProtoLens.Field.HasField Datum "maybe'originalCbor" (Prelude.Maybe Data.ByteString.ByteString) where fieldOf _ = (Prelude..) (Lens.Family2.Unchecked.lens @@ -1384,9 +1391,12 @@ instance Data.ProtoLens.Message Datum where packedMessageDescriptor _ = "\n\ \\ENQDatum\DC2\DC2\n\ - \\EOThash\CAN\SOH \SOH(\fR\EOThash\DC2=\n\ - \\apayload\CAN\STX \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\apayload\DC2#\n\ - \\roriginal_cbor\CAN\ETX \SOH(\fR\foriginalCbor" + \\EOThash\CAN\SOH \SOH(\fR\EOThash\DC2B\n\ + \\apayload\CAN\STX \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataH\NULR\apayload\136\SOH\SOH\DC2(\n\ + \\roriginal_cbor\CAN\ETX \SOH(\fH\SOHR\foriginalCbor\136\SOH\SOHB\n\ + \\n\ + \\b_payloadB\DLE\n\ + \\SO_original_cbor" packedFileDescriptor _ = packedFileDescriptor fieldsByTag = let @@ -1411,9 +1421,8 @@ instance Data.ProtoLens.Message Datum where "original_cbor" (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"originalCbor")) :: + (Data.ProtoLens.OptionalField + (Data.ProtoLens.Field.field @"maybe'originalCbor")) :: Data.ProtoLens.FieldDescriptor Datum in Data.Map.fromList @@ -1428,8 +1437,7 @@ instance Data.ProtoLens.Message Datum where = Datum'_constructor {_Datum'hash = Data.ProtoLens.fieldDefault, _Datum'payload = Prelude.Nothing, - _Datum'originalCbor = Data.ProtoLens.fieldDefault, - _Datum'_unknownFields = []} + _Datum'originalCbor = Prelude.Nothing, _Datum'_unknownFields = []} parseMessage = let loop :: Datum -> Data.ProtoLens.Encoding.Bytes.Parser Datum @@ -1515,21 +1523,20 @@ instance Data.ProtoLens.Message Datum where (Data.ProtoLens.Encoding.Bytes.putBytes bs)) Data.ProtoLens.encodeMessage _v)) ((Data.Monoid.<>) - (let - _v - = Lens.Family2.view (Data.ProtoLens.Field.field @"originalCbor") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 26) - ((\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - _v)) + (case + Lens.Family2.view + (Data.ProtoLens.Field.field @"maybe'originalCbor") _x + of + Prelude.Nothing -> Data.Monoid.mempty + (Prelude.Just _v) + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 26) + ((\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + _v)) (Data.ProtoLens.Encoding.Wire.buildFieldSet (Lens.Family2.view Data.ProtoLens.unknownFields _x)))) instance Control.DeepSeq.NFData Datum where @@ -6499,11 +6506,14 @@ packedFileDescriptor \\ENQdatum\CAN\EOT \SOH(\v2\RS.utxorpc.v1alpha.cardano.DatumR\ENQdatum\DC27\n\ \\ACKscript\CAN\ENQ \SOH(\v2\US.utxorpc.v1alpha.cardano.ScriptR\ACKscript\"$\n\ \\fAddressArray\DC2\DC4\n\ - \\ENQitems\CAN\SOH \ETX(\fR\ENQitems\"\DEL\n\ + \\ENQitems\CAN\SOH \ETX(\fR\ENQitems\"\167\SOH\n\ \\ENQDatum\DC2\DC2\n\ - \\EOThash\CAN\SOH \SOH(\fR\EOThash\DC2=\n\ - \\apayload\CAN\STX \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataR\apayload\DC2#\n\ - \\roriginal_cbor\CAN\ETX \SOH(\fR\foriginalCbor\"q\n\ + \\EOThash\CAN\SOH \SOH(\fR\EOThash\DC2B\n\ + \\apayload\CAN\STX \SOH(\v2#.utxorpc.v1alpha.cardano.PlutusDataH\NULR\apayload\136\SOH\SOH\DC2(\n\ + \\roriginal_cbor\CAN\ETX \SOH(\fH\SOHR\foriginalCbor\136\SOH\SOHB\n\ + \\n\ + \\b_payloadB\DLE\n\ + \\SO_original_cbor\"q\n\ \\ENQAsset\DC2\DC2\n\ \\EOTname\CAN\SOH \SOH(\fR\EOTname\DC2%\n\ \\voutput_coin\CAN\STX \SOH(\EOTH\NULR\n\ @@ -6621,7 +6631,7 @@ packedFileDescriptor \\EMgovernance_action_deposit\CAN\GS \SOH(\EOTR\ETBgovernanceActionDepositB\STX0\SOH\DC2%\n\ \\fdrep_deposit\CAN\RS \SOH(\EOTR\vdrepDepositB\STX0\SOH\DC24\n\ \\SYNdrep_inactivity_period\CAN\US \SOH(\EOTR\DC4drepInactivityPeriodB\169\SOH\n\ - \\ESCcom.utxorpc.v1alpha.cardanoB\fCardanoProtoP\SOH\162\STX\ETXUVC\170\STX\ETBUtxorpc.V1alpha.Cardano\202\STX\ETBUtxorpc\\V1alpha\\Cardano\226\STX#Utxorpc\\V1alpha\\Cardano\\GPBMetadata\234\STX\EMUtxorpc::V1alpha::CardanoJ\157K\n\ + \\ESCcom.utxorpc.v1alpha.cardanoB\fCardanoProtoP\SOH\162\STX\ETXUVC\170\STX\ETBUtxorpc.V1alpha.Cardano\202\STX\ETBUtxorpc\\V1alpha\\Cardano\226\STX#Utxorpc\\V1alpha\\Cardano\\GPBMetadata\234\STX\EMUtxorpc::V1alpha::CardanoJ\185K\n\ \\a\DC2\ENQ\NUL\NUL\192\SOH\SOH\n\ \\b\n\ \\SOH\f\DC2\ETX\NUL\NUL\DC2\n\ @@ -6722,23 +6732,29 @@ packedFileDescriptor \\f\n\ \\ENQ\EOT\STX\STX\NUL\ETX\DC2\ETX\DC3\SI\DLE\n\ \)\n\ - \\EOT\EOT\STX\STX\SOH\DC2\ETX\DC4\STX\EM\"\FS Parsed Plutus data payload\n\ + \\EOT\EOT\STX\STX\SOH\DC2\ETX\DC4\STX\"\"\FS Parsed Plutus data payload\n\ \\n\ \\f\n\ - \\ENQ\EOT\STX\STX\SOH\ACK\DC2\ETX\DC4\STX\f\n\ + \\ENQ\EOT\STX\STX\SOH\EOT\DC2\ETX\DC4\STX\n\ + \\n\ + \\f\n\ + \\ENQ\EOT\STX\STX\SOH\ACK\DC2\ETX\DC4\v\NAK\n\ \\f\n\ - \\ENQ\EOT\STX\STX\SOH\SOH\DC2\ETX\DC4\r\DC4\n\ + \\ENQ\EOT\STX\STX\SOH\SOH\DC2\ETX\DC4\SYN\GS\n\ \\f\n\ - \\ENQ\EOT\STX\STX\SOH\ETX\DC2\ETX\DC4\ETB\CAN\n\ + \\ENQ\EOT\STX\STX\SOH\ETX\DC2\ETX\DC4 !\n\ \:\n\ - \\EOT\EOT\STX\STX\STX\DC2\ETX\NAK\STX\SUB\"- Original cbor-encoded data as seen on-chain\n\ + \\EOT\EOT\STX\STX\STX\DC2\ETX\NAK\STX#\"- Original cbor-encoded data as seen on-chain\n\ + \\n\ + \\f\n\ + \\ENQ\EOT\STX\STX\STX\EOT\DC2\ETX\NAK\STX\n\ \\n\ \\f\n\ - \\ENQ\EOT\STX\STX\STX\ENQ\DC2\ETX\NAK\STX\a\n\ + \\ENQ\EOT\STX\STX\STX\ENQ\DC2\ETX\NAK\v\DLE\n\ \\f\n\ - \\ENQ\EOT\STX\STX\STX\SOH\DC2\ETX\NAK\b\NAK\n\ + \\ENQ\EOT\STX\STX\STX\SOH\DC2\ETX\NAK\DC1\RS\n\ \\f\n\ - \\ENQ\EOT\STX\STX\STX\ETX\DC2\ETX\NAK\CAN\EM\n\ + \\ENQ\EOT\STX\STX\STX\ETX\DC2\ETX\NAK!\"\n\ \B\n\ \\STX\EOT\ETX\DC2\EOT\EM\NUL\US\SOH\SUB6 Represents a custom asset in the Cardano blockchain.\n\ \\n\ diff --git a/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano_Fields.hs b/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano_Fields.hs index efadac025d..1cfc9f0f9e 100644 --- a/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano_Fields.hs +++ b/cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano_Fields.hs @@ -397,6 +397,13 @@ maybe'nativeScript :: Lens.Family2.LensLike' f s a maybe'nativeScript = Data.ProtoLens.Field.field @"maybe'nativeScript" +maybe'originalCbor :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "maybe'originalCbor" a) => + Lens.Family2.LensLike' f s a +maybe'originalCbor + = Data.ProtoLens.Field.field @"maybe'originalCbor" maybe'outputCoin :: forall f s a. (Prelude.Functor f, From 34d4abf2e31f754f3e905538354feefbebab1d52 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 14 Nov 2025 11:32:15 +0100 Subject: [PATCH 7/9] Add call stack support in ErrorAsException --- cardano-api/src/Cardano/Api/Error.hs | 47 +++++++++++++++++++++------- 1 file changed, 36 insertions(+), 11 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Error.hs b/cardano-api/src/Cardano/Api/Error.hs index d5741a1db4..e7ac642b8f 100644 --- a/cardano-api/src/Cardano/Api/Error.hs +++ b/cardano-api/src/Cardano/Api/Error.hs @@ -8,6 +8,7 @@ module Cardano.Api.Error ( Error (..) , throwErrorAsException + , liftEitherError , failEitherError , ErrorAsException (..) , FileError (..) @@ -20,7 +21,8 @@ where import Cardano.Api.Monad.Error import Cardano.Api.Pretty -import Control.Exception (Exception (..), IOException, throwIO) +import Control.Exception.Safe +import GHC.Stack import System.Directory (doesFileExist) import System.IO (Handle) @@ -32,26 +34,49 @@ instance Error () where -- | The preferred approach is to use 'Except' or 'ExceptT', but you can if -- necessary use IO exceptions. -throwErrorAsException :: Error e => e -> IO a -throwErrorAsException e = throwIO (ErrorAsException e) - -failEitherError :: MonadFail m => Error e => Either e a -> m a +throwErrorAsException + :: HasCallStack + => MonadThrow m + => Typeable e + => Error e + => e + -> m a +throwErrorAsException e = withFrozenCallStack $ throwM $ ErrorAsException e + +-- | Pretty print 'Error e' and 'fail' if 'Left'. +failEitherError + :: MonadFail m + => Error e + => Either e a + -> m a failEitherError = failEitherWith displayError +-- | Pretty print 'Error e' and 'throwM' it wrapped in 'ErrorAsException' when 'Left'. +liftEitherError + :: HasCallStack + => MonadThrow m + => Typeable e + => Error e + => Either e a + -> m a +liftEitherError = withFrozenCallStack $ either throwErrorAsException pure + +-- | An exception wrapping any 'Error e', attaching a call stack from the construction place to it. data ErrorAsException where - ErrorAsException :: Error e => e -> ErrorAsException + ErrorAsException :: (HasCallStack, Typeable e, Error e) => e -> ErrorAsException + +instance Exception ErrorAsException +-- | Pretty print the error inside the exception instance Error ErrorAsException where prettyError (ErrorAsException e) = prettyError e +-- | Pretty print the error inside the exception followed by the call stack pointing to the place where 'Error e' was +-- wrapped in 'ErrorAsException' instance Show ErrorAsException where show (ErrorAsException e) = - docToString $ prettyError e - -instance Exception ErrorAsException where - displayException (ErrorAsException e) = - docToString $ prettyError e + docToString (prettyError e) <> "\n" <> prettyCallStack callStack displayError :: Error a => a -> String displayError = docToString . prettyError From 8be0f7556b528a2150a0fa7d9a033fe22439bc45 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 14 Nov 2025 11:51:57 +0100 Subject: [PATCH 8/9] cardano-rpc | Add TxOutput roundtrip test --- .../src/Cardano/Api/Experimental/Era.hs | 4 +- .../Cardano/Api/Ledger/Internal/Reexport.hs | 3 +- cardano-api/src/Cardano/Api/Serialise/Raw.hs | 1 + .../src/Cardano/Api/Tx/Internal/Fee.hs | 1 - cardano-rpc/cardano-rpc.cabal | 2 +- .../Cardano/Rpc/Server/Internal/Orphans.hs | 200 +---------- .../Rpc/Server/Internal/UtxoRpc/Query.hs | 12 +- .../Rpc/Server/Internal/UtxoRpc/Type.hs | 311 +++++++++++++++++- .../Test/Cardano/Rpc/TxOutput.hs | 29 ++ 9 files changed, 350 insertions(+), 213 deletions(-) create mode 100644 cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/TxOutput.hs diff --git a/cardano-api/src/Cardano/Api/Experimental/Era.hs b/cardano-api/src/Cardano/Api/Experimental/Era.hs index 71eb35e377..8e7453e9f3 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Era.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Era.hs @@ -309,9 +309,9 @@ type EraCommonConstraints era = , L.EraTxCert (LedgerEra era) , L.EraTxOut (LedgerEra era) , L.EraUTxO (LedgerEra era) + , L.Value (LedgerEra era) ~ L.MaryValue , FromCBOR (ChainDepState (ConsensusProtocol era)) - , -- , FromCBOR (L.TxCert (LedgerEra era)) - L.NativeScript (LedgerEra era) ~ L.Timelock (LedgerEra era) + , L.NativeScript (LedgerEra era) ~ L.Timelock (LedgerEra era) , PraosProtocolSupportsNode (ConsensusProtocol era) , ShelleyLedgerEra era ~ LedgerEra era , ToJSON (ChainDepState (ConsensusProtocol era)) diff --git a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs index bdfd821210..da9c72a30b 100644 --- a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs +++ b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs @@ -59,6 +59,7 @@ module Cardano.Api.Ledger.Internal.Reexport , TxId (..) , TxIn (..) , Value + , MaryValue (..) , MultiAsset (..) , addDeltaCoin , castSafeHash @@ -343,7 +344,7 @@ import Cardano.Ledger.Keys , hashWithSerialiser , toVRFVerKeyHash ) -import Cardano.Ledger.Mary.Value (MultiAsset (..)) +import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..)) import Cardano.Ledger.Plutus.Data (Data (..), unData) import Cardano.Ledger.Plutus.Language (Language, Plutus, languageToText, plutusBinary) import Cardano.Ledger.Shelley.API diff --git a/cardano-api/src/Cardano/Api/Serialise/Raw.hs b/cardano-api/src/Cardano/Api/Serialise/Raw.hs index 4f1a3205ff..ccb063a0d5 100644 --- a/cardano-api/src/Cardano/Api/Serialise/Raw.hs +++ b/cardano-api/src/Cardano/Api/Serialise/Raw.hs @@ -64,6 +64,7 @@ instance SerialiseAsRawBytes Word16 where throwError . SerialiseAsRawBytesError $ "Cannot decode Word16 from (hex): " <> BSC.unpack (Base16.encode bs) +-- | Convert the number into binary value instance SerialiseAsRawBytes Natural where serialiseToRawBytes 0 = BS.singleton 0x00 serialiseToRawBytes n = BS.toStrict . BSB.toLazyByteString $ go n mempty diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs index d1d6e2370a..47a1fe2854 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs @@ -84,7 +84,6 @@ import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Conway.Governance qualified as L import Cardano.Ledger.Credential as Ledger (Credential) -import Cardano.Ledger.Mary.Value qualified as L import Cardano.Ledger.Plutus.Language qualified as Plutus import Cardano.Ledger.Val qualified as L import Ouroboros.Consensus.HardFork.History qualified as Consensus diff --git a/cardano-rpc/cardano-rpc.cabal b/cardano-rpc/cardano-rpc.cabal index ab9f924b8a..0ddb67e74e 100644 --- a/cardano-rpc/cardano-rpc.cabal +++ b/cardano-rpc/cardano-rpc.cabal @@ -69,7 +69,6 @@ library bytestring, cardano-api >=10.17, cardano-ledger-api, - cardano-ledger-binary, cardano-ledger-conway, cardano-ledger-core, cardano-rpc:gen, @@ -132,3 +131,4 @@ test-suite cardano-rpc-test build-tool-depends: tasty-discover:tasty-discover other-modules: Test.Cardano.Rpc.ProtocolParameters + Test.Cardano.Rpc.TxOutput diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs index 908285c01e..2be607ee81 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs @@ -1,45 +1,27 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Rpc.Server.Internal.Orphans where -import Cardano.Api (SerialiseAsCBOR (serialiseToCBOR), ToCBOR (..)) -import Cardano.Api.Address -import Cardano.Api.Block (SlotNo (..)) import Cardano.Api.Era import Cardano.Api.Error import Cardano.Api.Ledger qualified as L -import Cardano.Api.Plutus import Cardano.Api.Pretty import Cardano.Api.Serialise.Raw -import Cardano.Api.Serialise.SerialiseUsing import Cardano.Api.Tx -import Cardano.Api.Value import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc -import Cardano.Ledger.Api qualified as L -import Cardano.Ledger.BaseTypes qualified as L -import Cardano.Ledger.Conway.PParams qualified as L -import Cardano.Ledger.Plutus qualified as L - import RIO hiding (toList) -import Data.ByteString qualified as B import Data.Default -import Data.Map.Strict qualified as M import Data.ProtoLens (defMessage) import Data.ProtoLens.Message (Message) import Data.Ratio (denominator, numerator, (%)) -import Data.Text.Encoding qualified as T -import GHC.IsList import Network.GRPC.Spec --------------- @@ -78,186 +60,6 @@ instance Inject TxIn (Proto UtxoRpc.TxoRef) where & #hash .~ serialiseToRawBytes txId' & #index .~ fromIntegral txIx -instance Inject (ReferenceScript era) (Proto UtxoRpc.Script) where - inject ReferenceScriptNone = defMessage - inject (ReferenceScript _ (ScriptInAnyLang _ script)) = - case script of - SimpleScript ss -> - defMessage & #native .~ inject ss - PlutusScript PlutusScriptV1 ps -> - defMessage & #plutusV1 .~ serialiseToRawBytes ps - PlutusScript PlutusScriptV2 ps -> - defMessage & #plutusV2 .~ serialiseToRawBytes ps - PlutusScript PlutusScriptV3 ps -> - defMessage & #plutusV3 .~ serialiseToRawBytes ps - PlutusScript PlutusScriptV4 ps -> - defMessage & #plutusV4 .~ serialiseToRawBytes ps - -instance Inject SimpleScript (Proto UtxoRpc.NativeScript) where - inject = \case - RequireSignature paymentKeyHash -> - defMessage & #scriptPubkey .~ serialiseToRawBytes paymentKeyHash - RequireTimeBefore (SlotNo slotNo) -> - defMessage & #invalidHereafter .~ slotNo - RequireTimeAfter (SlotNo slotNo) -> - defMessage & #invalidBefore .~ slotNo - RequireAllOf scripts -> - defMessage & #scriptAll . #items .~ map inject scripts - RequireAnyOf scripts -> - defMessage & #scriptAny . #items .~ map inject scripts - RequireMOf k scripts -> do - let nScriptsOf = - defMessage - & #k .~ fromIntegral k - & #scripts .~ map inject scripts - defMessage & #scriptNOfK .~ nScriptsOf - -instance Inject ScriptData (Proto UtxoRpc.PlutusData) where - inject = \case - ScriptDataBytes bs -> - defMessage & #boundedBytes .~ bs - ScriptDataNumber int - | int <= fromIntegral (maxBound @Int64) - && int >= fromIntegral (minBound @Int64) -> - defMessage & #bigInt . #int .~ fromIntegral int - | int < 0 -> - -- https://www.rfc-editor.org/rfc/rfc8949.html#name-bignums see 3.4.3 for negative integers - defMessage & #bigInt . #bigNInt .~ serialiseToRawBytes (fromIntegral @_ @Natural (-1 - int)) - | otherwise -> - defMessage & #bigInt . #bigUInt .~ serialiseToRawBytes (fromIntegral @_ @Natural int) - ScriptDataList sds -> - defMessage & #array . #items .~ map inject sds - ScriptDataMap elements -> do - let pairs = - elements <&> \(k, v) -> - defMessage - & #key .~ inject k - & #value .~ inject v - defMessage & #map . #pairs .~ pairs - ScriptDataConstructor tag args -> do - let constr = - defMessage - & #tag .~ fromIntegral tag - & #fields .~ map inject args - defMessage & #constr .~ constr - -instance IsCardanoEra era => Inject (UTxO era) [Proto UtxoRpc.AnyUtxoData] where - inject utxo = - toList utxo <&> \(txIn, TxOut addressInEra txOutValue datum script) -> do - let multiAsset = - fromList $ - toList (valueToPolicyAssets $ txOutValueToValue txOutValue) <&> \(pId, policyAssets) -> do - let assets = - toList policyAssets <&> \(assetName, Quantity qty) -> do - defMessage - & #name .~ serialiseToRawBytes assetName - -- we don't have access to info if the coin was minted in the transaction, - -- maybe we should add it later - & #maybe'mintCoin .~ Nothing - & #outputCoin .~ fromIntegral qty - defMessage - & #policyId .~ serialiseToRawBytes pId - & #assets .~ assets - datumRpc = case datum of - TxOutDatumNone -> - defMessage - TxOutDatumHash _ scriptDataHash -> - defMessage - & #hash .~ serialiseToRawBytes scriptDataHash - & #maybe'payload .~ Nothing -- we don't have it - & #originalCbor .~ mempty -- we don't have it - TxOutDatumInline _ hashableScriptData -> - defMessage - & #hash .~ serialiseToRawBytes (hashScriptDataBytes hashableScriptData) - & #payload .~ inject (getScriptData hashableScriptData) - & #originalCbor .~ getOriginalScriptDataBytes hashableScriptData - - protoTxOut = - defMessage - -- TODO we don't have serialiseToRawBytes for AddressInEra, so perhaps this is wrong, because 'address' - -- has type bytes, but we're putting text there - & #address .~ T.encodeUtf8 (cardanoEraConstraints (cardanoEra @era) $ serialiseAddress addressInEra) - & #coin .~ fromIntegral (L.unCoin (txOutValueToLovelace txOutValue)) - & #assets .~ multiAsset - & #datum .~ datumRpc - & #script .~ inject script - defMessage - & #nativeBytes .~ "" -- TODO where to get that from? run cbor serialisation of utxos list? - & #txoRef .~ inject txIn - & #cardano .~ protoTxOut - -instance L.ConwayEraPParams lera => Inject (L.PParams lera) (Proto UtxoRpc.PParams) where - inject pparams = do - let pparamsCostModels :: Map L.Language [Int64] = - L.getCostModelParams <$> pparams ^. L.ppCostModelsL . to L.costModelsValid - poolVotingThresholds :: L.PoolVotingThresholds = - pparams ^. L.ppPoolVotingThresholdsL - drepVotingThresholds :: L.DRepVotingThresholds = - pparams ^. L.ppDRepVotingThresholdsL - def - & #coinsPerUtxoByte .~ pparams ^. L.ppCoinsPerUTxOByteL . to L.unCoinPerByte . to fromIntegral - & #maxTxSize .~ pparams ^. L.ppMaxTxSizeL . to fromIntegral - & #minFeeCoefficient .~ pparams ^. L.ppMinFeeBL . to fromIntegral - & #minFeeConstant .~ pparams ^. L.ppMinFeeAL . to fromIntegral - & #maxBlockBodySize .~ pparams ^. L.ppMaxBBSizeL . to fromIntegral - & #maxBlockHeaderSize .~ pparams ^. L.ppMaxBHSizeL . to fromIntegral - & #stakeKeyDeposit .~ pparams ^. L.ppKeyDepositL . to fromIntegral - & #poolDeposit .~ pparams ^. L.ppPoolDepositL . to fromIntegral - & #poolRetirementEpochBound .~ pparams ^. L.ppEMaxL . to L.unEpochInterval . to fromIntegral - & #desiredNumberOfPools .~ pparams ^. L.ppNOptL . to fromIntegral - & #poolInfluence .~ pparams ^. L.ppA0L . to L.unboundRational . to inject - & #monetaryExpansion .~ pparams ^. L.ppRhoL . to L.unboundRational . to inject - & #treasuryExpansion .~ pparams ^. L.ppTauL . to L.unboundRational . to inject - & #minPoolCost .~ pparams ^. L.ppMinPoolCostL . to fromIntegral - & #protocolVersion . #major .~ pparams ^. L.ppProtocolVersionL . to L.pvMajor . to L.getVersion - & #protocolVersion . #minor .~ pparams ^. L.ppProtocolVersionL . to L.pvMinor . to fromIntegral - & #maxValueSize .~ pparams ^. L.ppMaxValSizeL . to fromIntegral - & #collateralPercentage .~ pparams ^. L.ppCollateralPercentageL . to fromIntegral - & #maxCollateralInputs .~ pparams ^. L.ppMaxCollateralInputsL . to fromIntegral - & #costModels . #plutusV1 . #values .~ (join . maybeToList) (M.lookup L.PlutusV1 pparamsCostModels) - & #costModels . #plutusV2 . #values .~ (join . maybeToList) (M.lookup L.PlutusV2 pparamsCostModels) - & #costModels . #plutusV3 . #values .~ (join . maybeToList) (M.lookup L.PlutusV3 pparamsCostModels) - & #costModels . #plutusV4 . #values .~ (join . maybeToList) (M.lookup L.PlutusV4 pparamsCostModels) - & #prices . #steps .~ pparams ^. L.ppPricesL . to L.prSteps . to L.unboundRational . to inject - & #prices . #memory .~ pparams ^. L.ppPricesL . to L.prMem . to L.unboundRational . to inject - & #maxExecutionUnitsPerTransaction .~ pparams ^. L.ppMaxTxExUnitsL . to inject - & #maxExecutionUnitsPerBlock .~ pparams ^. L.ppMaxBlockExUnitsL . to inject - & #minFeeScriptRefCostPerByte - .~ pparams ^. L.ppMinFeeRefScriptCostPerByteL . to L.unboundRational . to inject - & #poolVotingThresholds . #thresholds - .~ ( inject . L.unboundRational - -- order taken from https://github.com/cardano-foundation/CIPs/blob/acb4b2348c968003dfc370cd3769615bfca1f159/CIP-1694/README.md#requirements - <$> [ poolVotingThresholds ^. L.pvtMotionNoConfidenceL - , poolVotingThresholds ^. L.pvtCommitteeNormalL - , poolVotingThresholds ^. L.pvtCommitteeNoConfidenceL - , poolVotingThresholds ^. L.pvtHardForkInitiationL - , poolVotingThresholds ^. L.pvtPPSecurityGroupL - ] - ) - & #drepVotingThresholds . #thresholds - .~ ( inject . L.unboundRational - -- order taken from https://github.com/cardano-foundation/CIPs/blob/acb4b2348c968003dfc370cd3769615bfca1f159/CIP-1694/README.md#requirements - <$> [ drepVotingThresholds ^. L.dvtMotionNoConfidenceL - , drepVotingThresholds ^. L.dvtCommitteeNormalL - , drepVotingThresholds ^. L.dvtCommitteeNoConfidenceL - , drepVotingThresholds ^. L.dvtUpdateToConstitutionL - , drepVotingThresholds ^. L.dvtHardForkInitiationL - , drepVotingThresholds ^. L.dvtPPNetworkGroupL - , drepVotingThresholds ^. L.dvtPPEconomicGroupL - , drepVotingThresholds ^. L.dvtPPTechnicalGroupL - , drepVotingThresholds ^. L.dvtPPGovGroupL - , drepVotingThresholds ^. L.dvtTreasuryWithdrawalL - ] - ) - & #minCommitteeSize .~ pparams ^. L.ppCommitteeMinSizeL . to fromIntegral - & #committeeTermLimit - .~ pparams ^. L.ppCommitteeMaxTermLengthL . to L.unEpochInterval . to fromIntegral - & #governanceActionValidityPeriod - .~ pparams ^. L.ppGovActionLifetimeL . to L.unEpochInterval . to fromIntegral - & #governanceActionDeposit .~ pparams ^. L.ppGovActionDepositL . to fromIntegral - & #drepDeposit .~ pparams ^. L.ppDRepDepositL . to fromIntegral - & #drepInactivityPeriod .~ pparams ^. L.ppDRepActivityL . to L.unEpochInterval . to fromIntegral - instance Message a => Default (Proto a) where def = defMessage @@ -268,7 +70,7 @@ instance Message a => Default (Proto a) where -- TODO add RIO to cardano-api and move this instance there instance Error StringException where - prettyError = pshow + prettyError = prettyException instance IsString e => MonadFail (Either e) where fail = Left . fromString diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Query.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Query.hs index c046fa40ab..d7b39418c4 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Query.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Query.hs @@ -8,6 +8,7 @@ {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.Rpc.Server.Internal.UtxoRpc.Query ( readParamsMethod @@ -16,6 +17,7 @@ module Cardano.Rpc.Server.Internal.UtxoRpc.Query where import Cardano.Api +import Cardano.Api.Experimental.Era import Cardano.Api.Parser.Text qualified as P import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc import Cardano.Rpc.Server.Internal.Error @@ -41,7 +43,7 @@ readParamsMethod _req = do -- let fieldMask :: [Text] = req ^. #fieldMask . #paths nodeConnInfo <- grab AnyCardanoEra era <- liftIO . throwExceptT $ determineEra nodeConnInfo - eon <- forEraInEon era (error "Minimum Conway era required") pure + eon <- forEraInEon @Era era (error "Minimum Conway era required") pure let sbe = convert eon let target = VolatileTip @@ -54,7 +56,7 @@ readParamsMethod _req = do pure $ def & #ledgerTip .~ mkChainPointMsg chainPoint blockNo - & #values . #cardano .~ conwayEraOnwardsConstraints eon (inject pparams) + & #values . #cardano .~ obtainCommonConstraints eon (protocolParamsToUtxoRpcPParams eon pparams) readUtxosMethod :: MonadRpc e m @@ -71,11 +73,11 @@ readUtxosMethod req = do nodeConnInfo <- grab AnyCardanoEra era <- liftIO . throwExceptT $ determineEra nodeConnInfo - eon <- forEraInEon era (error "Minimum Shelley era required") pure + eon <- forEraInEon @Era era (error "Minimum Conway era required") pure let target = VolatileTip (utxo, chainPoint, blockNo) <- liftIO . (throwEither =<<) $ executeLocalStateQueryExpr nodeConnInfo target $ do - utxo <- throwEither =<< throwEither =<< queryUtxo eon utxoFilter + utxo <- throwEither =<< throwEither =<< queryUtxo (convert eon) utxoFilter chainPoint <- throwEither =<< queryChainPoint blockNo <- throwEither =<< queryChainBlockNo pure (utxo, chainPoint, blockNo) @@ -83,7 +85,7 @@ readUtxosMethod req = do pure $ defMessage & #ledgerTip .~ mkChainPointMsg chainPoint blockNo - & #items .~ cardanoEraConstraints era (inject utxo) + & #items .~ obtainCommonConstraints eon (utxoToUtxoRpcAnyUtxoData utxo) where txoRefToTxIn :: MonadRpc e m => Proto UtxoRpc.TxoRef -> m TxIn txoRefToTxIn r = do diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs index 9a4e8f9f82..707728e4d3 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs @@ -1,29 +1,45 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.Rpc.Server.Internal.UtxoRpc.Type ( utxoRpcPParamsToProtocolParams + , utxoToUtxoRpcAnyUtxoData + , txOutToUtxoRpcTxOutput + , utxoRpcTxOutputToTxOut , protocolParamsToUtxoRpcPParams + , simpleScriptToUtxoRpcNativeScript , mkChainPointMsg ) where +import Cardano.Api.Address import Cardano.Api.Block import Cardano.Api.Era +import Cardano.Api.Error import Cardano.Api.Experimental.Era +import Cardano.Api.HasTypeProxy import Cardano.Api.Ledger qualified as L import Cardano.Api.Monad.Error +import Cardano.Api.Plutus +import Cardano.Api.Serialise.Cbor +import Cardano.Api.Serialise.Raw +import Cardano.Api.Tx +import Cardano.Api.Value import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc import Cardano.Rpc.Server.Internal.Orphans () import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes (WithOrigin (..)) -import Cardano.Ledger.Binary.Version qualified as L +import Cardano.Ledger.BaseTypes qualified as L import Cardano.Ledger.Conway.Core qualified as L import Cardano.Ledger.Conway.PParams qualified as L import Cardano.Ledger.Plutus qualified as L @@ -32,15 +48,88 @@ import RIO hiding (toList) import Data.ByteString.Short qualified as SBS import Data.Default +import Data.Map.Strict qualified as M import Data.ProtoLens (defMessage) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T import GHC.IsList import Network.GRPC.Spec protocolParamsToUtxoRpcPParams - :: Era era - -> L.PParams (ShelleyLedgerEra era) + :: forall era + . Era era + -> L.PParams (LedgerEra era) -> Proto UtxoRpc.PParams -protocolParamsToUtxoRpcPParams era = conwayEraOnwardsConstraints (convert era) inject +protocolParamsToUtxoRpcPParams era pparams = obtainCommonConstraints era $ do + let pparamsCostModels :: Map L.Language [Int64] = + L.getCostModelParams <$> pparams ^. L.ppCostModelsL . to L.costModelsValid + poolVotingThresholds :: L.PoolVotingThresholds = + pparams ^. L.ppPoolVotingThresholdsL + drepVotingThresholds :: L.DRepVotingThresholds = + pparams ^. L.ppDRepVotingThresholdsL + def + & #coinsPerUtxoByte .~ pparams ^. L.ppCoinsPerUTxOByteL . to L.unCoinPerByte . to fromIntegral + & #maxTxSize .~ pparams ^. L.ppMaxTxSizeL . to fromIntegral + & #minFeeCoefficient .~ pparams ^. L.ppMinFeeBL . to fromIntegral + & #minFeeConstant .~ pparams ^. L.ppMinFeeAL . to fromIntegral + & #maxBlockBodySize .~ pparams ^. L.ppMaxBBSizeL . to fromIntegral + & #maxBlockHeaderSize .~ pparams ^. L.ppMaxBHSizeL . to fromIntegral + & #stakeKeyDeposit .~ pparams ^. L.ppKeyDepositL . to fromIntegral + & #poolDeposit .~ pparams ^. L.ppPoolDepositL . to fromIntegral + & #poolRetirementEpochBound .~ pparams ^. L.ppEMaxL . to L.unEpochInterval . to fromIntegral + & #desiredNumberOfPools .~ pparams ^. L.ppNOptL . to fromIntegral + & #poolInfluence .~ pparams ^. L.ppA0L . to L.unboundRational . to inject + & #monetaryExpansion .~ pparams ^. L.ppRhoL . to L.unboundRational . to inject + & #treasuryExpansion .~ pparams ^. L.ppTauL . to L.unboundRational . to inject + & #minPoolCost .~ pparams ^. L.ppMinPoolCostL . to fromIntegral + & #protocolVersion . #major .~ pparams ^. L.ppProtocolVersionL . to L.pvMajor . to L.getVersion + & #protocolVersion . #minor .~ pparams ^. L.ppProtocolVersionL . to L.pvMinor . to fromIntegral + & #maxValueSize .~ pparams ^. L.ppMaxValSizeL . to fromIntegral + & #collateralPercentage .~ pparams ^. L.ppCollateralPercentageL . to fromIntegral + & #maxCollateralInputs .~ pparams ^. L.ppMaxCollateralInputsL . to fromIntegral + & #costModels . #plutusV1 . #values .~ (join . maybeToList) (M.lookup L.PlutusV1 pparamsCostModels) + & #costModels . #plutusV2 . #values .~ (join . maybeToList) (M.lookup L.PlutusV2 pparamsCostModels) + & #costModels . #plutusV3 . #values .~ (join . maybeToList) (M.lookup L.PlutusV3 pparamsCostModels) + & #costModels . #plutusV4 . #values .~ (join . maybeToList) (M.lookup L.PlutusV4 pparamsCostModels) + & #prices . #steps .~ pparams ^. L.ppPricesL . to L.prSteps . to L.unboundRational . to inject + & #prices . #memory .~ pparams ^. L.ppPricesL . to L.prMem . to L.unboundRational . to inject + & #maxExecutionUnitsPerTransaction .~ pparams ^. L.ppMaxTxExUnitsL . to inject + & #maxExecutionUnitsPerBlock .~ pparams ^. L.ppMaxBlockExUnitsL . to inject + & #minFeeScriptRefCostPerByte + .~ pparams ^. L.ppMinFeeRefScriptCostPerByteL . to L.unboundRational . to inject + & #poolVotingThresholds . #thresholds + .~ ( inject . L.unboundRational + -- order taken from https://github.com/cardano-foundation/CIPs/blob/acb4b2348c968003dfc370cd3769615bfca1f159/CIP-1694/README.md#requirements + <$> [ poolVotingThresholds ^. L.pvtMotionNoConfidenceL + , poolVotingThresholds ^. L.pvtCommitteeNormalL + , poolVotingThresholds ^. L.pvtCommitteeNoConfidenceL + , poolVotingThresholds ^. L.pvtHardForkInitiationL + , poolVotingThresholds ^. L.pvtPPSecurityGroupL + ] + ) + & #drepVotingThresholds . #thresholds + .~ ( inject . L.unboundRational + -- order taken from https://github.com/cardano-foundation/CIPs/blob/acb4b2348c968003dfc370cd3769615bfca1f159/CIP-1694/README.md#requirements + <$> [ drepVotingThresholds ^. L.dvtMotionNoConfidenceL + , drepVotingThresholds ^. L.dvtCommitteeNormalL + , drepVotingThresholds ^. L.dvtCommitteeNoConfidenceL + , drepVotingThresholds ^. L.dvtUpdateToConstitutionL + , drepVotingThresholds ^. L.dvtHardForkInitiationL + , drepVotingThresholds ^. L.dvtPPNetworkGroupL + , drepVotingThresholds ^. L.dvtPPEconomicGroupL + , drepVotingThresholds ^. L.dvtPPTechnicalGroupL + , drepVotingThresholds ^. L.dvtPPGovGroupL + , drepVotingThresholds ^. L.dvtTreasuryWithdrawalL + ] + ) + & #minCommitteeSize .~ pparams ^. L.ppCommitteeMinSizeL . to fromIntegral + & #committeeTermLimit + .~ pparams ^. L.ppCommitteeMaxTermLengthL . to L.unEpochInterval . to fromIntegral + & #governanceActionValidityPeriod + .~ pparams ^. L.ppGovActionLifetimeL . to L.unEpochInterval . to fromIntegral + & #governanceActionDeposit .~ pparams ^. L.ppGovActionDepositL . to fromIntegral + & #drepDeposit .~ pparams ^. L.ppDRepDepositL . to fromIntegral + & #drepInactivityPeriod .~ pparams ^. L.ppDRepActivityL . to L.unEpochInterval . to fromIntegral utxoRpcPParamsToProtocolParams :: Era era @@ -218,3 +307,217 @@ mkChainPointMsg chainPoint blockNo = do & #slot .~ slotNo & #hash .~ blockHash & #height .~ blockHeight + +simpleScriptToUtxoRpcNativeScript :: SimpleScript -> Proto UtxoRpc.NativeScript +simpleScriptToUtxoRpcNativeScript = \case + RequireSignature paymentKeyHash -> + defMessage & #scriptPubkey .~ serialiseToRawBytes paymentKeyHash + RequireTimeBefore (SlotNo slotNo) -> + defMessage & #invalidHereafter .~ slotNo + RequireTimeAfter (SlotNo slotNo) -> + defMessage & #invalidBefore .~ slotNo + RequireAllOf scripts -> + defMessage & #scriptAll . #items .~ map simpleScriptToUtxoRpcNativeScript scripts + RequireAnyOf scripts -> + defMessage & #scriptAny . #items .~ map simpleScriptToUtxoRpcNativeScript scripts + RequireMOf k scripts -> do + let nScriptsOf = + defMessage + & #k .~ fromIntegral k + & #scripts .~ map simpleScriptToUtxoRpcNativeScript scripts + defMessage & #scriptNOfK .~ nScriptsOf + +utxoRpcNativeScriptToSimpleScript + :: HasCallStack + => MonadThrow m + => Proto UtxoRpc.NativeScript + -> m SimpleScript +utxoRpcNativeScriptToSimpleScript scriptRpc + | Just paymentKeyHash <- scriptRpc ^. #maybe'scriptPubkey = + RequireSignature <$> liftEitherError (deserialiseFromRawBytes asType paymentKeyHash) + | Just slotNo <- scriptRpc ^. #maybe'invalidHereafter = + pure . RequireTimeBefore $ SlotNo slotNo + | Just slotNo <- scriptRpc ^. #maybe'invalidBefore = + pure . RequireTimeAfter $ SlotNo slotNo + | Just scriptsRpc <- scriptRpc ^. #maybe'scriptAll = do + fmap RequireAllOf $ + mapM utxoRpcNativeScriptToSimpleScript $ + scriptsRpc ^. #items + | Just scriptsRpc <- scriptRpc ^. #maybe'scriptAny = do + fmap RequireAnyOf $ + mapM utxoRpcNativeScriptToSimpleScript $ + scriptsRpc ^. #items + | Just scriptsRpc <- scriptRpc ^. #maybe'scriptNOfK = do + fmap (RequireMOf . fromIntegral $ scriptsRpc ^. #k) $ + mapM utxoRpcNativeScriptToSimpleScript $ + scriptsRpc ^. #scripts + | otherwise = throwM . stringException $ "Cannot decode UTxORPC NativeScript" + +referenceScriptToUtxoRpcScript :: ReferenceScript era -> Proto UtxoRpc.Script +referenceScriptToUtxoRpcScript ReferenceScriptNone = defMessage +referenceScriptToUtxoRpcScript (ReferenceScript _ (ScriptInAnyLang _ script)) = + case script of + SimpleScript ss -> + defMessage & #native .~ simpleScriptToUtxoRpcNativeScript ss + PlutusScript PlutusScriptV1 ps -> + defMessage & #plutusV1 .~ serialiseToRawBytes ps + PlutusScript PlutusScriptV2 ps -> + defMessage & #plutusV2 .~ serialiseToRawBytes ps + PlutusScript PlutusScriptV3 ps -> + defMessage & #plutusV3 .~ serialiseToRawBytes ps + PlutusScript PlutusScriptV4 ps -> + defMessage & #plutusV4 .~ serialiseToRawBytes ps + +utxoRpcScriptToReferenceScript + :: forall era m + . HasCallStack + => MonadThrow m + => IsEra era + => Proto UtxoRpc.Script + -> m (ReferenceScript era) +utxoRpcScriptToReferenceScript protoScript + | Just script <- protoScript ^. #maybe'native = + ReferenceScript (convert $ useEra @era) . ScriptInAnyLang SimpleScriptLanguage . SimpleScript + <$> utxoRpcNativeScriptToSimpleScript script + | Just script <- protoScript ^. #maybe'plutusV1 = + ReferenceScript (convert $ useEra @era) . ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV1) + <$> liftEitherError (deserialiseFromCBOR asType script) + | Just script <- protoScript ^. #maybe'plutusV2 = + ReferenceScript (convert $ useEra @era) . ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV2) + <$> liftEitherError (deserialiseFromCBOR asType script) + | Just script <- protoScript ^. #maybe'plutusV3 = + ReferenceScript (convert $ useEra @era) . ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV3) + <$> liftEitherError (deserialiseFromCBOR asType script) + | Just script <- protoScript ^. #maybe'plutusV4 = + ReferenceScript (convert $ useEra @era) . ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV4) + <$> liftEitherError (deserialiseFromCBOR asType script) + | otherwise = pure ReferenceScriptNone + +scriptDataToUtxoRpcPlutusData :: ScriptData -> Proto UtxoRpc.PlutusData +scriptDataToUtxoRpcPlutusData = \case + ScriptDataBytes bs -> + defMessage & #boundedBytes .~ bs + ScriptDataNumber int + | int <= fromIntegral (maxBound @Int64) + && int >= fromIntegral (minBound @Int64) -> + defMessage & #bigInt . #int .~ fromIntegral int + | int < 0 -> + -- https://www.rfc-editor.org/rfc/rfc8949.html#name-bignums see 3.4.3 for negative integers + defMessage & #bigInt . #bigNInt .~ serialiseToRawBytes (fromIntegral @_ @Natural (-1 - int)) + | otherwise -> + defMessage & #bigInt . #bigUInt .~ serialiseToRawBytes (fromIntegral @_ @Natural int) + ScriptDataList sds -> + defMessage & #array . #items .~ map scriptDataToUtxoRpcPlutusData sds + ScriptDataMap elements -> do + let pairs = + elements <&> \(k, v) -> + defMessage + & #key .~ scriptDataToUtxoRpcPlutusData k + & #value .~ scriptDataToUtxoRpcPlutusData v + defMessage & #map . #pairs .~ pairs + ScriptDataConstructor tag args -> do + -- Details of plutus tag serialisation: + -- https://github.com/IntersectMBO/plutus/blob/fc78c36b545ee287ae8796a0c1a7d04cf31f4cee/plutus-core/plutus-core/src/PlutusCore/Data.hs#L72 + let constr = + defMessage + & ( if tag <= fromIntegral (maxBound @Word32) + then #tag .~ fromIntegral tag + else (#tag .~ 102) . (#anyConstructor .~ fromIntegral @_ @Word64 tag) + ) + & #fields .~ map scriptDataToUtxoRpcPlutusData args + defMessage & #constr .~ constr + +utxoToUtxoRpcAnyUtxoData :: forall era. IsEra era => UTxO era -> [Proto UtxoRpc.AnyUtxoData] +utxoToUtxoRpcAnyUtxoData utxo = + toList utxo <&> \(txIn, txOut) -> do + defMessage + & #nativeBytes .~ "" -- TODO where to get that from? run cbor serialisation of utxos list? + & #txoRef .~ inject txIn + & #cardano .~ txOutToUtxoRpcTxOutput txOut + +txOutToUtxoRpcTxOutput + :: forall era. IsEra era => TxOut CtxUTxO era -> Proto UtxoRpc.TxOutput +txOutToUtxoRpcTxOutput (TxOut addressInEra txOutValue datum script) = do + let multiAsset = + fromList $ + toList (valueToPolicyAssets $ txOutValueToValue txOutValue) <&> \(pId, policyAssets) -> do + let assets = + toList policyAssets <&> \(assetName, Quantity qty) -> do + defMessage + & #name .~ serialiseToRawBytes assetName + -- we don't have access to info if the coin was minted in the transaction, + -- maybe we should add it later + -- & #maybe'mintCoin .~ Nothing + & #outputCoin .~ fromIntegral qty + defMessage + & #policyId .~ serialiseToRawBytes pId + & #assets .~ assets + datumRpc = case datum of + TxOutDatumNone -> + Nothing + TxOutDatumHash _ scriptDataHash -> + Just $ + defMessage + & #hash .~ serialiseToRawBytes scriptDataHash + & #maybe'payload .~ Nothing -- we don't have it + & #maybe'originalCbor .~ Nothing + TxOutDatumInline _ hashableScriptData -> + Just $ + defMessage + & #hash .~ serialiseToCBOR hashableScriptData + & #payload .~ scriptDataToUtxoRpcPlutusData (getScriptData hashableScriptData) + & #originalCbor .~ getOriginalScriptDataBytes hashableScriptData + + defMessage + & #address .~ T.encodeUtf8 (obtainCommonConstraints (useEra @era) $ serialiseAddress addressInEra) + & #coin .~ fromIntegral (L.unCoin (txOutValueToLovelace txOutValue)) + & #assets .~ multiAsset + & #maybe'datum .~ datumRpc + & #script .~ referenceScriptToUtxoRpcScript script + +utxoRpcTxOutputToTxOut + :: forall era m + . HasCallStack + => MonadThrow m + => IsEra era + => Proto UtxoRpc.TxOutput + -> m (TxOut CtxUTxO era) +utxoRpcTxOutputToTxOut txOutput = do + let era = useEra @era + addrUtf8 <- liftEitherError $ T.decodeUtf8' (txOutput ^. #address) + address <- + maybe (throwM . stringException $ "Cannot decode address: " <> T.unpack addrUtf8) pure $ + deserialiseAddress (AsAddress AsShelleyAddr) addrUtf8 + datum <- + case txOutput ^. #maybe'datum of + Just datumRpc -> + case datumRpc ^. #maybe'originalCbor of + Just cbor -> + liftEitherError $ + TxOutDatumInline (convert era) + <$> deserialiseFromCBOR asType cbor + Nothing -> + liftEitherError $ + TxOutDatumHash (convert era) + <$> deserialiseFromRawBytes asType (datumRpc ^. #hash) + Nothing -> pure TxOutDatumNone + referenceScript <- utxoRpcScriptToReferenceScript (txOutput ^. #script) + let coinValue = txOutput ^. #coin . to fromIntegral . to L.Coin . to lovelaceToValue + multiAssetValue <- fmap (fromList @Value . join) . forM (txOutput ^. #assets) $ \policyAssets -> do + pId <- + liftEitherError $ deserialiseFromRawBytes AsPolicyId (policyAssets ^. #policyId) + forM (policyAssets ^. #assets) $ \asset -> do + assetName <- + liftEitherError $ + deserialiseFromRawBytes AsAssetName (asset ^. #name) + let outCoin = Quantity . fromIntegral $ asset ^. #outputCoin + mintCoin = Quantity . fromIntegral $ asset ^. #mintCoin + pure (AssetId pId assetName, outCoin <> mintCoin) + pure $ + TxOut + (AddressInEra (ShelleyAddressInEra (convert era)) address) + ( obtainCommonConstraints era $ + TxOutValueShelleyBased (convert era) (toMaryValue $ coinValue <> multiAssetValue) + ) + datum + referenceScript diff --git a/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/TxOutput.hs b/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/TxOutput.hs new file mode 100644 index 0000000000..4709804074 --- /dev/null +++ b/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/TxOutput.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Cardano.Rpc.TxOutput where + +import Cardano.Api.Experimental.Era +import Cardano.Rpc.Server.Internal.UtxoRpc.Type + +import RIO + +import Test.Gen.Cardano.Api.Typed + ( genTxOutUTxOContext + ) + +import Hedgehog +import Hedgehog qualified as H + +-- | Test if TxOut in UTXO context does roundtrip +hprop_roundtrip_tx_output :: Property +hprop_roundtrip_tx_output = H.property $ do + let era = ConwayEra + + txOut <- forAll $ genTxOutUTxOContext (convert era) + + H.tripping + txOut + txOutToUtxoRpcTxOutput + (first @Either displayException . utxoRpcTxOutputToTxOut) From adcef0da8689e6ca130983a6a12f798f7d535ff1 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 14 Nov 2025 15:03:28 +0100 Subject: [PATCH 9/9] Fix hlint rules to ignore cardano-rpc/gen --- .hlint.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.hlint.yaml b/.hlint.yaml index 115a0d794a..dc2aab862c 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -61,7 +61,7 @@ - ignore: {name: Use camelCase, within: [Test.Cardano.Api.**, Test.Golden.Cardano.Api.**]} # Ignore all files in cardano-rpc/gen (generated code) -- ignore: {within: [Proto.Cardano, Proto.Utxorpc]} +- ignore: {within: [Proto.Cardano.**, Proto.Utxorpc.**]} - ignore: {name: Eta reduce} - ignore: {name: Use + directly}