From 3c51f0dc7133d3e892b890102e728380fa4cbcbf Mon Sep 17 00:00:00 2001 From: Nadia Yvette Chambers Date: Fri, 4 Oct 2024 17:46:03 +0000 Subject: [PATCH] Generator Propose case interim commit --- .../src/Cardano/Benchmarking/Script/Core.hs | 41 ++++++++++++------- .../src/Cardano/Benchmarking/Script/Types.hs | 18 ++++++-- .../src/Cardano/TxGenerator/Tx.hs | 7 ++-- bench/tx-generator/tx-generator.cabal | 1 + 4 files changed, 46 insertions(+), 21 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index caa72b26954..172084167b0 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -19,9 +19,10 @@ module Cardano.Benchmarking.Script.Core where import Cardano.Api -import Cardano.Api.Shelley (PlutusScriptOrReferenceInput (..), ProtocolParameters, - ShelleyLedgerEra, convertToLedgerProtocolParameters, protocolParamMaxTxExUnits, - protocolParamPrices) +import Cardano.Api.Shelley (GovernanceAction (..), PlutusScriptOrReferenceInput (..), + Proposal (..), ProtocolParameters, ShelleyLedgerEra, + convertToLedgerProtocolParameters, createProposalProcedure, + protocolParamMaxTxExUnits, protocolParamPrices) import Cardano.Benchmarking.GeneratorTx as GeneratorTx (AsyncBenchmarkControl) import qualified Cardano.Benchmarking.GeneratorTx as GeneratorTx (waitBenchmark, walletBenchmark) @@ -40,7 +41,9 @@ import Cardano.Benchmarking.Types as Core (SubmissionErrorPolicy (..)) import Cardano.Benchmarking.Version as Version import Cardano.Benchmarking.Wallet as Wallet import qualified Cardano.Ledger.Coin as L +-- import qualified Cardano.Ledger.BaseTypes as Ledger import qualified Cardano.Ledger.Core as Ledger +-- import qualified Cardano.Ledger.Api.Governance as Ledger import Cardano.Logging hiding (LocalSocket) import Cardano.TxGenerator.Fund as Fund import qualified Cardano.TxGenerator.FundQueue as FundQueue @@ -64,9 +67,12 @@ import Control.Monad.Trans.RWS.Strict (ask) import "contra-tracer" Control.Tracer (Tracer (..)) import Data.Bitraversable (bimapM) import Data.ByteString.Lazy.Char8 as BSL (writeFile) +import Data.Either.Extra (eitherToMaybe) +import Data.Functor ((<&>)) import Data.IntervalMap.Interval as IM (Interval (..), upperBound) import Data.IntervalMap.Lazy as IM (adjust, containing, delete, insert, null, toList) -import qualified Data.Map.Strict as Map (fromList) +-- import qualified Data.Map.Strict as Map (fromList) +import Data.Maybe.Strict as SMaybe (StrictMaybe (..)) import Data.Ratio ((%)) import Data.Sequence as Seq (ViewL (..), fromList, viewl, (|>)) import qualified Data.Text as Text (unpack) @@ -389,24 +395,31 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do return $ Streaming.effect (Streaming.yield <$> sourceToStore) - Propose walletName coin stakeAddr -> do + Propose walletName payMode coin network stakeCredential anchor -> do wallet <- getEnvWallets walletName - let txGenerator = genTxProposal shelleyBasedEra ledgerParameters (collateral, collFunds) fee proposal metadata inputs outputs + (toUTxO, _addressOut) <- interpretPayMode payMode + let -- txGenerator :: TxGenerator era + txGenerator = genTxProposal shelleyBasedEra ledgerParameters (TxInsCollateralNone, []) feeInEra (unProposal proposal, Nothing) TxMetadataNone + -- fundSource :: FundSource IO fundSource = walletSource wallet 1 - inToOut = Utils.inputsToOutputsWithFee fee count + inToOut = Utils.inputsToOutputsWithFee fee 1 sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut (mangle $ repeat toUTxO) - govAction = TreasuryWithdrawals (Map.fromList [(rewardAcct, coin)]) Nothing - rewardAcct = toShelleyStakeAddress stakeAddr - fundPreview <- liftIO $ walletPreview wallet inputs + -- govAction :: GovernanceAction era + govAction = TreasuryWithdrawal [(network, stakeCredential', coin)] SNothing + -- proposal :: Proposal era + proposal = createProposalProcedure shelleyBasedEra network coin stakeCredential' govAction anchor + -- stakeCredential' :: StakeCredential + stakeCredential' = undefined stakeCredential + fundPreview <- liftIO $ walletPreview wallet 0 case sourceTransactionPreview txGenerator fundPreview inToOut (mangle $ repeat toUTxO) of Left err -> traceDebug $ "Error creating Tx preview: " ++ show err Right tx -> do let txSize = txSizeInBytes tx - txFeeEstimate = case toLedgerPParams shelleyBasedEra protocolParameters of - Left{} -> Nothing - Right ledgerPParams -> Just $ - evaluateTransactionFee shelleyBasedEra ledgerPParams (getTxBody tx) (fromIntegral $ inputs + 1) 0 0 -- 1 key witness per tx input + 1 collateral + txFeeEstimate = eitherToMaybe (toLedgerPParams shelleyBasedEra protocolParameters) <&> + \ledgerPParams -> + -- 1 key witness per tx input + 1 collateral + evaluateTransactionFee shelleyBasedEra ledgerPParams (getTxBody tx) 1 0 0 traceDebug $ "Projected Tx size in bytes: " ++ show txSize traceDebug $ "Projected Tx fee in Coin: " ++ show txFeeEstimate -- TODO: possibly emit a warning when (Just txFeeEstimate) is lower than specified by config in TxGenTxParams.txFee diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 8eb5a1bb218..2221f89ac3d 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -25,8 +25,8 @@ things one might do with the connexion. -} module Cardano.Benchmarking.Script.Types ( Action(..) - , Generator(Cycle, NtoM, OneOf, RoundRobin, SecureGenesis, - Sequence, Split, SplitN, Take) + , Generator(Cycle, NtoM, OneOf, Propose, RoundRobin, + SecureGenesis, Sequence, Split, SplitN, Take) , PayMode(PayToAddr, PayToScript) , ProtocolParameterMode(..) , ProtocolParametersSource(QueryLocalNode, UseLocalProtocolFile) @@ -42,6 +42,9 @@ import Cardano.Api import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley +import qualified Cardano.Ledger.BaseTypes as Ledger +import qualified Cardano.Ledger.Credential as Ledger + import Cardano.Benchmarking.OuroborosImports (SigningKeyFile) import Cardano.Node.Configuration.NodeAddress (NodeIPv4Address) import Cardano.TxGenerator.Setup.NixService (NodeDescription) @@ -178,10 +181,17 @@ data Generator where -- Wait, does Anchor actually have the instances? -- *** Ping Aniket or Carlos. *** Propose :: !String + -> !PayMode -> !L.Coin -- -> !(RewardAccount (L.EraCrypto era)) -- The RewardAccount is represented by a StakeAddress - -> !StakeAddress + -- StakeAddress might not be right either; TreasuryWithdrawal + -- takes [(Network, StakeCredential, Coin)] + -- (StrictMaybe (ScriptHash StandardCrypto)) + -- -> !StakeAddress + -- For the moment, hope SNothing can fly and pass a singleton. + -> !L.Network + -> !(Ledger.StakeCredential L.StandardCrypto) -- -> !(GovAction era) -- The GovAction can be recovered from the RewardAccount and -- Coin at least if the hash can be computed or omitted as @@ -192,7 +202,7 @@ data Generator where -- from just yet. -- *** Check in with Carlos and/or Aniket. *** -- Wait, genTxProposal didn't seem to need to use an anchor at all. - -- -> !(Url, ByteString) + -> !(Ledger.Anchor L.StandardCrypto) -> Generator -- | 'Sequence' represents sequentially issuing a series in the form -- of a list of transaction series represented by 'Generator' itself, diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs index 9904dd2968a..91ff6a13bd5 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs @@ -203,9 +203,10 @@ genTxProposal :: forall era. () -> TxFee era -> (L.ProposalProcedure (ShelleyLedgerEra era), Maybe (ScriptWitness WitCtxStake era)) -> TxMetadataInEra era - -> [Fund] - -> [TxOut CtxTx era] - -> Either TxGenError (Tx era, TxId) + -> TxGenerator era + -- -> [Fund] + -- -> [TxOut CtxTx era] + -- -> Either TxGenError (Tx era, TxId) genTxProposal sbe ledgerParameters diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 713c9cf3111..64553363ee3 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -119,6 +119,7 @@ library , cardano-ledger-core , cardano-node , cardano-prelude + , cardano-strict-containers , contra-tracer , cborg >= 0.2.2 && < 0.3 , containers