Generator Propose case interim commit

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

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,

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

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