From 38ad4467bdc9a005a93fd76b0ca5f2d10f79b2be Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Wed, 25 Sep 2024 09:59:49 +0200 Subject: [PATCH 1/9] workbench: create development-voting profile --- .../src/Cardano/TxGenerator/Setup/NixService.hs | 1 + nix/nixos/tx-generator-service.nix | 3 +++ nix/workbench/genesis/genesis.sh | 10 ++++++++-- nix/workbench/profile/prof1-variants.jq | 13 +++++++++++++ wb_profiles.mk | 2 ++ 5 files changed, 27 insertions(+), 2 deletions(-) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs index 1badcc32d48..a0e51ddc278 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs @@ -53,6 +53,7 @@ data NixServiceOptions = NixServiceOptions { , _nix_era :: AnyCardanoEra , _nix_plutus :: Maybe TxGenPlutusParams , _nix_keepalive :: Maybe Integer + , _nix_drep_voting :: Maybe Bool , _nix_nodeConfigFile :: Maybe FilePath , _nix_cardanoTracerSocket :: Maybe FilePath , _nix_sigKey :: SigningKeyFile In diff --git a/nix/nixos/tx-generator-service.nix b/nix/nixos/tx-generator-service.nix index 1d76c50cb95..9f159ee65cb 100644 --- a/nix/nixos/tx-generator-service.nix +++ b/nix/nixos/tx-generator-service.nix @@ -42,6 +42,7 @@ let inherit add_tx_size debugMode + drep_voting init_cooldown inputs_per_tx localNodeSocketPath @@ -99,6 +100,8 @@ in pkgs.commonLib.defServiceModule redeemer = mayOpt attrs "Plutus script redeemer."; }; + drep_voting = mayOpt bool "Activate DRep voting workload (mutually excl. with plutus)"; + # Overrides the usage of Nix Store paths by default. plutusRedeemerFile = mayOpt str "Plutus redeemer file path."; plutusDatumFile = mayOpt str "Plutus datum file path."; diff --git a/nix/workbench/genesis/genesis.sh b/nix/workbench/genesis/genesis.sh index 7c42cf9f860..6f26d7598ea 100644 --- a/nix/workbench/genesis/genesis.sh +++ b/nix/workbench/genesis/genesis.sh @@ -737,8 +737,14 @@ genesis-create-testnet-data() { info genesis "removing delegator keys." rm "$dir/stake-delegators" -rf - info genesis "removing dreps keys." - rm "$dir"/drep-keys -rf + local is_voting + is_voting=$(jq --raw-output '.generator.drep_voting' "$profile_json") + if [[ "$is_voting" == "true" ]]; + then info genesis "voting workload specified - skipping deletion of DRep keys" + else + info genesis "removing dreps keys." + rm "$dir"/drep-keys -rf + fi info genesis "moving keys" Massage_the_key_file_layout_to_match_AWS "$profile_json" "$node_specs" "$dir" diff --git a/nix/workbench/profile/prof1-variants.jq b/nix/workbench/profile/prof1-variants.jq index a46a29f9124..11ac8cfb543 100644 --- a/nix/workbench/profile/prof1-variants.jq +++ b/nix/workbench/profile/prof1-variants.jq @@ -426,6 +426,14 @@ def all_profile_variants: { filters: ["size-small"] } }) as $plutus_base + | + ({ extra_desc: "with DRep voting workload" + , generator: + { inputs_per_tx: 1 + , outputs_per_tx: 1 + , drep_voting: true + } + }) as $voting_base | ({ generator: { plutus: @@ -1530,6 +1538,11 @@ def all_profile_variants: { name: "chainsync-early-alonzo-p2p" } + ## development profile for voting workload: PV9, Conway costmodel, 1000 DReps injected + , $cibench_base * $voting_base * $double_plus_tps_saturation_plutus * $genesis_voltaire * $dreps_small * + { name: "development-voting" + } + ## Last, but not least, the profile used by "nix-shell -A devops": , { name: "devops" , scenario: "idle" diff --git a/wb_profiles.mk b/wb_profiles.mk index b4c52a9f432..fd47aff71c4 100644 --- a/wb_profiles.mk +++ b/wb_profiles.mk @@ -9,6 +9,7 @@ PROFILES_LEGACY := ci-test-dense10 dish dish-10M dish-plutus dish-10M-plutus PROFILES_SCALING := faststartup-24M PROFILES_NOMAD_PERF := value-nomadperf value-nomadperf-nop2p value-drep1k-nomadperf value-drep2k-nomadperf value-drep10k-nomadperf value-drep100k-nomadperf value-oldtracing-nomadperf value-oldtracing-nomadperf-nop2p value-volt-nomadperf plutus-nomadperf plutus-nomadperf-nop2p plutus-drep1k-nomadperf plutus-drep2k-nomadperf plutus-drep10k-nomadperf plutus-drep100k-nomadperf plutus24-nomadperf plutus-secp-ecdsa-nomadperf plutus-secp-schnorr-nomadperf plutusv3-blst-nomadperf plutusv3-blst-double-nomadperf plutusv3-blst-half-nomadperf plutus-volt-nomadperf fast-nomadperf fast-nomadperf-nop2p ci-test-nomadperf ci-test-nomadperf-nop2p ci-test-oldtracing-nomadperf default-nomadperf-nop2p default-nomadperf oldtracing-nomadperf oldtracing-nomadperf-nop2p ci-bench-nomadperf ci-bench-nomadperf-nop2p ci-bench-oldtracing-nomadperf PROFILES_NOMAD_PERFSSD := utxoscale-solo-12M16G-nomadperfssd utxoscale-solo-12M64G-nomadperfssd utxoscale-solo-24M64G-nomadperfssd fast-nomadperfssd value-nomadperfssd +PROFILES_DEV := development-voting LOCAL_PROFILES += $(PROFILES_EMPTY) LOCAL_PROFILES += $(PROFILES_MINIATURE) @@ -21,3 +22,4 @@ LOCAL_PROFILES += $(PROFILES_LEGACY) LOCAL_PROFILES += $(PROFILES_SCALING) CLOUD_PROFILES += $(PROFILES_NOMAD_PERF) CLOUD_PROFILES += $(PROFILES_NOMAD_PERFSSD) +LOCAL_PROFILES += $(PROFILES_DEV) From 0fc6d1821b028f701f9ad3203a3e5c48d9ed7590 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Wed, 25 Sep 2024 18:46:11 +0200 Subject: [PATCH 2/9] tx-generator: load DRep SigningKeys from genesis into environment --- .../src/Cardano/Benchmarking/Compiler.hs | 6 +++++ .../src/Cardano/Benchmarking/Script/Action.hs | 1 + .../src/Cardano/Benchmarking/Script/Core.hs | 15 +++++++++++ .../src/Cardano/Benchmarking/Script/Env.hs | 12 ++++++++- .../src/Cardano/Benchmarking/Script/Types.hs | 5 ++++ .../src/Cardano/TxGenerator/Genesis.hs | 27 +++++++++++++++++++ .../Cardano/TxGenerator/Setup/NodeConfig.hs | 6 ++++- .../Cardano/TxGenerator/Setup/SigningKey.hs | 14 ++++++---- .../src/Cardano/TxGenerator/Types.hs | 5 +++- bench/tx-generator/test/ApiTest.hs | 21 ++++++++++----- bench/tx-generator/tx-generator.cabal | 5 +++- 11 files changed, 102 insertions(+), 15 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index 6881f9ab428..536fdb733bc 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs @@ -62,6 +62,12 @@ compileToScript = do pure tc <- askNixOption _nix_cardanoTracerSocket emit $ StartProtocol nc tc + + isDrepVoting <- fromMaybe False <$> askNixOption _nix_drep_voting + when isDrepVoting $ do + emit $ ReadDRepKeys nc + logMsg "Importing DRep SigningKeys. Done." + genesisWallet <- importGenesisFunds collateralWallet <- addCollaterals genesisWallet splitWallet <- splittingPhase genesisWallet diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs index 3435fbddeb9..389572784ca 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs @@ -42,6 +42,7 @@ action a = case a of SetProtocolParameters p -> setProtocolParameters p StartProtocol configFile cardanoTracerSocket -> startProtocol configFile cardanoTracerSocket ReadSigningKey name filePath -> readSigningKey name filePath + ReadDRepKeys filepath -> readDRepKeys filepath DefineSigningKey name descr -> defineSigningKey name descr AddFund era wallet txIn lovelace keyName -> addFund era wallet txIn lovelace keyName Delay t -> delay t diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 36810206321..a8edfc5198f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -46,6 +46,7 @@ import Cardano.TxGenerator.Fund as Fund import qualified Cardano.TxGenerator.FundQueue as FundQueue import qualified Cardano.TxGenerator.Genesis as Genesis import Cardano.TxGenerator.PlutusContext +import Cardano.TxGenerator.Setup.NodeConfig import Cardano.TxGenerator.Setup.Plutus as Plutus import Cardano.TxGenerator.Setup.SigningKey import Cardano.TxGenerator.Tx @@ -63,6 +64,7 @@ import "contra-tracer" Control.Tracer (Tracer (..)) import Data.ByteString.Lazy.Char8 as BSL (writeFile) import Data.Ratio ((%)) import qualified Data.Text as Text (unpack) +import System.FilePath (()) import Streaming import qualified Streaming.Prelude as Streaming @@ -98,6 +100,19 @@ readSigningKey name filePath = defineSigningKey :: String -> SigningKey PaymentKey -> ActionM () defineSigningKey = setEnvKeys +readDRepKeys :: FilePath -> ActionM () +readDRepKeys ncFile = do + genesis <- liftIO (mkNodeConfig ncFile) >>= either liftTxGenError (pure . getGenesisDirectory) + case genesis of + Nothing -> liftTxGenError $ TxGenError "readDRepKeys: no genesisDirectory could be retrieved from the node config" + -- "cache-entry" is a link or copy of the actual genesis folder created by "create-testnet-data" + -- in the workbench's run directory structure, this link or copy is created for each run - by workbench + Just d -> liftIO (Genesis.genesisLoadDRepKeys (d "cache-entry")) >>= \case + Left err -> liftTxGenError err + Right ks -> do + setEnvDRepKeys ks + traceDebug $ "DRep SigningKeys loaded: " ++ show (length ks) ++ " from: " ++ d + addFund :: AnyCardanoEra -> String -> TxIn -> L.Coin -> String -> ActionM () addFund era wallet txIn lovelace keyName = do fundKey <- getEnvKeys keyName diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs index e17a94b7c8b..2263c97cdc2 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs @@ -43,6 +43,8 @@ module Cardano.Benchmarking.Script.Env ( , traceBenchTxSubmit , getBenchTracers , setBenchTracers + , getEnvDRepKeys + , setEnvDRepKeys , getEnvGenesis , setEnvGenesis , getEnvKeys @@ -63,7 +65,7 @@ module Cardano.Benchmarking.Script.Env ( , setEnvSummary ) where -import Cardano.Api (File (..), SocketPath) +import Cardano.Api (File (..), DRepKey, SocketPath) import Cardano.Benchmarking.GeneratorTx import qualified Cardano.Benchmarking.LogTypes as Tracer @@ -108,6 +110,7 @@ data Env = Env { -- | 'Cardano.Api.ProtocolParameters' is ultimately , envKeys :: Map String (SigningKey PaymentKey) , envWallets :: Map String WalletRef , envSummary :: Maybe PlutusBudgetSummary + , envDRepKeys :: [SigningKey DRepKey] } -- | `Env` uses `Maybe` to represent values that might be uninitialized. -- This being empty means `Nothing` is used across the board, along with @@ -121,6 +124,7 @@ emptyEnv = Env { protoParams = Nothing , envSocketPath = Nothing , envWallets = Map.empty , envSummary = Nothing + , envDRepKeys = [] } newEnvConsts :: IOManager -> Maybe Nix.NixServiceOptions -> STM Tracer.EnvConsts @@ -197,6 +201,9 @@ setEnvGenesis val = modifyEnv (\e -> e { envGenesis = Just val }) setEnvKeys :: String -> SigningKey PaymentKey -> ActionM () setEnvKeys key val = modifyEnv (\e -> e { envKeys = Map.insert key val (envKeys e) }) +setEnvDRepKeys :: [SigningKey DRepKey] -> ActionM () +setEnvDRepKeys val = modifyEnv (\e -> e { envDRepKeys = val }) + -- | Write accessor for `envProtocol`. setEnvProtocol :: SomeConsensusProtocol -> ActionM () setEnvProtocol val = modifyEnv (\e -> e { envProtocol = Just val }) @@ -273,6 +280,9 @@ getEnvGenesis = getEnvVal envGenesis "Genesis" getEnvKeys :: String -> ActionM (SigningKey PaymentKey) getEnvKeys = getEnvMap envKeys +getEnvDRepKeys :: ActionM [SigningKey DRepKey] +getEnvDRepKeys = lift $ RWS.gets envDRepKeys + -- | Read accessor for `envNetworkId`. getEnvNetworkId :: ActionM NetworkId getEnvNetworkId = getEnvVal envNetworkId "Genesis" diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 06ca89cd594..acd2ae519c6 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -90,6 +90,11 @@ data Action where -- drops it into a state variable via -- 'Cardano.Benchmarking.Script.Env.setEnvKeys'. ReadSigningKey :: !String -> !(SigningKeyFile In) -> Action + -- | 'ReadDRepKeys' expects the path to a node config file. This + -- configuration is supposed to refer to a genesis which has + -- been created with cardano-cli create-testnet-data, and from + -- where DRep signing keys can be loaded. + ReadDRepKeys :: !FilePath -> Action -- | 'DefineSigningKey' is just a 'Map.insert' on the state variable. DefineSigningKey :: !String -> !(SigningKey PaymentKey) -> Action -- | 'AddFund' is mostly a wrapper around diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs index af2194e2d31..55c016ebac6 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} @@ -11,6 +12,7 @@ module Cardano.TxGenerator.Genesis ( genesisInitialFunds , genesisInitialFundForKey + , genesisLoadDRepKeys , genesisTxInput , genesisExpenditure , genesisSecureInitialFund @@ -22,17 +24,22 @@ import Cardano.Api import Cardano.Api.Shelley (ReferenceScript (..), fromShelleyPaymentCredential, fromShelleyStakeReference) +import Cardano.CLI.Types.Common (SigningKeyFile) import qualified Cardano.Ledger.Coin as L import Cardano.Ledger.Shelley.API (Addr (..), sgInitialFunds) import Cardano.TxGenerator.Fund +import Cardano.TxGenerator.Setup.SigningKey (readDRepKeyFile) import Cardano.TxGenerator.Types import Cardano.TxGenerator.Utils import Ouroboros.Consensus.Shelley.Node (validateGenesis) import Data.Bifunctor (bimap, second) +import Data.Char (isDigit) import Data.Function ((&)) import Data.List (find) import qualified Data.ListMap as ListMap (toList) +import System.Directory (listDirectory) +import System.FilePath (()) genesisValidate :: ShelleyGenesis -> Either String () @@ -136,3 +143,23 @@ mkGenesisTransaction key ttl fee txins txouts castKey :: SigningKey PaymentKey -> SigningKey GenesisUTxOKey castKey (PaymentSigningKey skey) = GenesisUTxOSigningKey skey + +-- | This function assumes a directory structure as created by +-- cardano-cli's create-testnet-data command. +genesisLoadDRepKeys :: FilePath -> IO (Either TxGenError [SigningKey DRepKey]) +genesisLoadDRepKeys genesisDir = runExceptT $ do + dirContents <- handleIOExceptT IOError (listDirectory drepDir) + let subDirs = filter dirWellFormed dirContents + mapM loadFromDir ((drepDir ) <$> subDirs) + where + asSigningKeyFile :: FilePath -> SigningKeyFile In + asSigningKeyFile = File + + loadFromDir d = hoistEither =<< handleIOExceptT IOError + (readDRepKeyFile $ asSigningKeyFile (d "drep.skey")) + + dirWellFormed = \case + 'd':'r':'e':'p' : nr@(_:_) -> all isDigit nr + _ -> False + + drepDir = genesisDir "drep-keys" diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs index 6e6e97c37e3..efa90af2737 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs @@ -15,7 +15,7 @@ import Cardano.Node.Configuration.POM import Cardano.Node.Handlers.Shutdown (ShutdownConfig (..)) import Cardano.Node.Protocol.Cardano import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..)) -import Cardano.Node.Types (ConfigYamlFilePath (..), GenesisFile, +import Cardano.Node.Types (ConfigYamlFilePath (..), GenesisFile (..), NodeProtocolConfiguration (..), NodeShelleyProtocolConfiguration (..), ProtocolFilepaths (..)) import Cardano.TxGenerator.Types @@ -25,6 +25,7 @@ import Control.Applicative (Const (Const), getConst) import Control.Monad.Trans.Except (runExceptT) import Data.Bifunctor (first) import Data.Monoid +import System.FilePath (takeDirectory) -- | extract genesis from a Cardano protocol @@ -45,6 +46,9 @@ getGenesisPath nodeConfig = NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ -> Just $ npcShelleyGenesisFile shelleyConfig +getGenesisDirectory :: NodeConfiguration -> Maybe FilePath +getGenesisDirectory nodeConfig = takeDirectory . unGenesisFile <$> getGenesisPath nodeConfig + mkConsensusProtocol :: NodeConfiguration -> IO (Either TxGenError SomeConsensusProtocol) mkConsensusProtocol nodeConfig = case ncProtocolConfig nodeConfig of diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs index 381fae1e43f..7c2529c0509 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs @@ -5,21 +5,22 @@ module Cardano.TxGenerator.Setup.SigningKey ( parseSigningKeyTE , parseSigningKeyBase16 + , readDRepKeyFile , readSigningKeyFile , PaymentKey , SigningKey ) where -import Data.Bifunctor (first) -import qualified Data.ByteString as BS (ByteString) -import Data.ByteString.Base16 as Base16 (decode) - import Cardano.Api -import Cardano.CLI.Types.Common (SigningKeyFile) +import Cardano.CLI.Types.Common (SigningKeyFile) import Cardano.TxGenerator.Types (TxGenError (..)) +import Data.Bifunctor (first) +import qualified Data.ByteString as BS (ByteString) +import Data.ByteString.Base16 as Base16 (decode) + parseSigningKeyTE :: TextEnvelope -> Either TxGenError (SigningKey PaymentKey) parseSigningKeyTE @@ -41,6 +42,9 @@ parseSigningKeyBase16 k readSigningKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey PaymentKey)) readSigningKeyFile f = first ApiError <$> readFileTextEnvelopeAnyOf acceptedTypes f +readDRepKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey DRepKey)) +readDRepKeyFile f = first ApiError <$> readKeyFileTextEnvelope (AsSigningKey AsDRepKey) f + acceptedTypes :: [FromSomeType HasTextEnvelope (SigningKey PaymentKey)] acceptedTypes = [ FromSomeType (AsSigningKey AsGenesisUTxOKey) castSigningKey diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs index 741fbe2794d..8852704849f 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs @@ -21,6 +21,7 @@ import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Shelley.API as Ledger (ShelleyGenesis) import Cardano.TxGenerator.Fund (Fund) +import Control.Exception (IOException) import GHC.Generics (Generic) import GHC.Natural import Prettyprinter @@ -129,12 +130,14 @@ data TxGenError where ProtocolError :: Cardano.Api.Error e => !e -> TxGenError PlutusError :: Show e => !e -> TxGenError TxGenError :: !String -> TxGenError + IOError :: !IOException -> TxGenError instance Show TxGenError where show (ApiError e) = docToString $ "ApiError " <> parens (prettyError e) show (ProtocolError e) = docToString $ "ProtocolError " <> parens (prettyError e) - show (PlutusError e) = docToString $ "ProtocolError " <> parens (pshow e) + show (PlutusError e) = docToString $ "PlutusError " <> parens (pshow e) show (TxGenError e) = docToString $ "ApiError " <> parens (pshow e) + show (IOError e) = docToString $ "IOError " <> parens (pshow e) instance Semigroup TxGenError where TxGenError a <> TxGenError b = TxGenError (a <> b) diff --git a/bench/tx-generator/test/ApiTest.hs b/bench/tx-generator/test/ApiTest.hs index deb14b767b4..cc22e36d71f 100644 --- a/bench/tx-generator/test/ApiTest.hs +++ b/bench/tx-generator/test/ApiTest.hs @@ -85,7 +85,7 @@ main ncFile <- hoistMaybe (TxGenError "nodeConfigFile not specified") $ getNodeConfigFile nixService nc :: NodeConfiguration <- - hoistEither =<< handleIOExceptT (TxGenError . show) (mkNodeConfig ncFile) + hoistEither =<< handleIOExceptT IOError (mkNodeConfig ncFile) GenesisFile sgFile <- hoistMaybe (TxGenError "npcShelleyGenesisFile not specified") $ getGenesisPath nc @@ -95,20 +95,22 @@ main genesisValidate genesis sigKey :: SigningKey PaymentKey <- - hoistEither =<< handleIOExceptT (TxGenError . show) (readSigningKeyFile $ _nix_sigKey nixService) + hoistEither =<< handleIOExceptT IOError (readSigningKeyFile $ _nix_sigKey nixService) pure (nixService, nc, genesis, sigKey) case setup of Left err -> die (show err) - Right (nixService, _nc, genesis, sigKey) -> do + Right (nixService, nc, genesis, sigKey) -> do putStrLn $ "* Did I manage to extract a genesis fund?\n--> " ++ checkFund nixService genesis sigKey - putStrLn "* Can I pre-execute a plutus script?" let plutus = _nix_plutus nixService case plutusType <$> plutus of Just BenchCustomCall -> checkPlutusBuiltin protoParamPath - Just{} -> checkPlutusLoop protoParamPath plutus - Nothing -> putStrLn "--> no Plutus configuration found - skipping" + Just{} -> putStrLn "* Can I pre-execute the plutus script?" >> checkPlutusLoop protoParamPath plutus + Nothing + | _nix_drep_voting nixService == Just True + -> checkLoadDReps nc + | otherwise -> putStrLn "--> no runnable test configuration found - skipping" exitSuccess -- The type annotations within patterns or expressions that would be @@ -268,6 +270,13 @@ checkPlutusLoop _ _ = putStrLn "--> No plutus script defined." +checkLoadDReps :: NodeConfiguration -> IO () +checkLoadDReps nc = case getGenesisDirectory nc of + Nothing -> putStrLn "--> getGenesisDirectory: no directory could be retrieved from NodeConfiguration" + Just d -> genesisLoadDRepKeys (d "cache-entry") >>= \case + Right keys -> putStrLn $ "--> successfully loaded " ++ show (length keys) ++ " DRep SigningKeys" + Left err -> error $ "--> error loading DRep keys: " ++ show err + -- -- helpers -- diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index b8275a8da51..24520a80d61 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -123,8 +123,10 @@ library , cborg >= 0.2.2 && < 0.3 , containers , constraints-extras + , directory , dlist , extra + , filepath , formatting , generic-monoid , ghc-prim @@ -160,7 +162,8 @@ library , yaml default-language: Haskell2010 - default-extensions: OverloadedStrings + default-extensions: LambdaCase + OverloadedStrings executable tx-generator import: project-config From cd037ce3c4b671d4623252d847f7cdfa1ddb4d2e Mon Sep 17 00:00:00 2001 From: Nadia Yvette Chambers Date: Mon, 30 Sep 2024 04:25:44 +0000 Subject: [PATCH 3/9] tx-generator: drop deprecated API function; various improvements This also sweeps LANGUAGE pragmas for explicit enabling of extensions now enabled via default-extensions. --- .../src/Cardano/Benchmarking/Command.hs | 2 -- .../src/Cardano/Benchmarking/Compiler.hs | 5 ++-- .../Benchmarking/GeneratorTx/SizedMetadata.hs | 2 +- .../Benchmarking/GeneratorTx/Submission.hs | 1 - .../GeneratorTx/SubmissionClient.hs | 2 -- .../src/Cardano/Benchmarking/Script.hs | 2 -- .../src/Cardano/Benchmarking/Script/Core.hs | 25 ++++++++----------- .../src/Cardano/Benchmarking/Script/Env.hs | 2 -- .../src/Cardano/Benchmarking/TpsThrottle.hs | 1 - .../src/Cardano/Benchmarking/Tracer.hs | 1 - .../Cardano/TxGenerator/Internal/Orphans.hs | 2 -- .../src/Cardano/TxGenerator/PlutusContext.hs | 1 - .../src/Cardano/TxGenerator/Script/Types.hs | 1 - .../Cardano/TxGenerator/Setup/SigningKey.hs | 1 - .../src/Cardano/TxGenerator/Tx.hs | 4 +-- .../src/Cardano/TxGenerator/Types.hs | 1 - bench/tx-generator/tx-generator.cabal | 3 ++- 17 files changed, 18 insertions(+), 38 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs index 0f5c865d5b8..8478ef2d5bb 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index 536fdb733bc..866fd9dec7e 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs @@ -1,5 +1,4 @@ {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} @@ -18,6 +17,7 @@ import Cardano.TxGenerator.Types import Prelude import Control.Monad +import Control.Monad.Extra import Control.Monad.Trans.RWS.CPS import Data.ByteString as BS (ByteString) import Data.DList (DList) @@ -63,8 +63,7 @@ compileToScript = do tc <- askNixOption _nix_cardanoTracerSocket emit $ StartProtocol nc tc - isDrepVoting <- fromMaybe False <$> askNixOption _nix_drep_voting - when isDrepVoting $ do + whenM (fromMaybe False <$> askNixOption _nix_drep_voting) do emit $ ReadDRepKeys nc logMsg "Importing DRep SigningKeys. Done." diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs index e5a983f9ecd..1a7eba71574 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs @@ -109,7 +109,7 @@ metadataSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMeta metadataSize p m = dummyTxSize p m - dummyTxSize p Nothing dummyTxSizeInEra :: IsShelleyBasedEra era => TxMetadataInEra era -> Int -dummyTxSizeInEra metadata = case createAndValidateTransactionBody shelleyBasedEra dummyTx of +dummyTxSizeInEra metadata = case createTransactionBody shelleyBasedEra dummyTx of Right b -> BS.length $ serialiseToCBOR b Left err -> error $ "metaDataSize " ++ show err where diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs index e2d98eddf78..90444bba778 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs @@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoMonomorphismRestriction #-} diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs index 577c47df682..1d6cc734d2f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs @@ -5,10 +5,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script.hs index 9b7537bc250..c25525c1bcd 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE RecordWildCards #-} diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index a8edfc5198f..68a6201d4b3 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -5,7 +5,6 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE PackageImports #-} @@ -93,25 +92,23 @@ setProtocolParameters s = case s of readSigningKey :: String -> SigningKeyFile In -> ActionM () readSigningKey name filePath = - liftIO (readSigningKeyFile filePath) >>= \case - Left err -> liftTxGenError err - Right key -> setEnvKeys name key + setEnvKeys name =<< liftIOSafe (readSigningKeyFile filePath) defineSigningKey :: String -> SigningKey PaymentKey -> ActionM () defineSigningKey = setEnvKeys readDRepKeys :: FilePath -> ActionM () readDRepKeys ncFile = do - genesis <- liftIO (mkNodeConfig ncFile) >>= either liftTxGenError (pure . getGenesisDirectory) - case genesis of - Nothing -> liftTxGenError $ TxGenError "readDRepKeys: no genesisDirectory could be retrieved from the node config" - -- "cache-entry" is a link or copy of the actual genesis folder created by "create-testnet-data" - -- in the workbench's run directory structure, this link or copy is created for each run - by workbench - Just d -> liftIO (Genesis.genesisLoadDRepKeys (d "cache-entry")) >>= \case - Left err -> liftTxGenError err - Right ks -> do - setEnvDRepKeys ks - traceDebug $ "DRep SigningKeys loaded: " ++ show (length ks) ++ " from: " ++ d + genesis <- onNothing throwKeyErr $ getGenesisDirectory <$> liftIOSafe (mkNodeConfig ncFile) + -- "cache-entry" is a link or copy of the actual genesis folder created by "create-testnet-data" + -- in the workbench's run directory structure, this link or copy is created for each run - by workbench + ks <- liftIOSafe . Genesis.genesisLoadDRepKeys $ genesis "cache-entry" + setEnvDRepKeys ks + traceDebug $ "DRep SigningKeys loaded: " ++ show (length ks) ++ " from: " ++ genesis + where + throwKeyErr = liftTxGenError . TxGenError $ + "readDRepKeys: no genesisDirectory could " + <> "be retrieved from the node config" addFund :: AnyCardanoEra -> String -> TxIn -> L.Coin -> String -> ActionM () addFund era wallet txIn lovelace keyName = do diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs index 2263c97cdc2..96320f82d39 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} diff --git a/bench/tx-generator/src/Cardano/Benchmarking/TpsThrottle.hs b/bench/tx-generator/src/Cardano/Benchmarking/TpsThrottle.hs index b1e8c554d20..3262bfe8d23 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/TpsThrottle.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/TpsThrottle.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} module Cardano.Benchmarking.TpsThrottle where diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs index f52fe4db709..da76456c9cb 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs @@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Internal/Orphans.hs b/bench/tx-generator/src/Cardano/TxGenerator/Internal/Orphans.hs index b2f69a879ed..737621549e7 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Internal/Orphans.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Internal/Orphans.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - {-# OPTIONS_GHC -fno-warn-orphans #-} {-| diff --git a/bench/tx-generator/src/Cardano/TxGenerator/PlutusContext.hs b/bench/tx-generator/src/Cardano/TxGenerator/PlutusContext.hs index f748286a96c..cbfbf4d5ade 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/PlutusContext.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/PlutusContext.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Script/Types.hs b/bench/tx-generator/src/Cardano/TxGenerator/Script/Types.hs index d327588ef5f..714a694ee3d 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Script/Types.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-partial-fields -fno-warn-orphans #-} diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs index 7c2529c0509..f120384c571 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -- | This module provides convenience functions when dealing with signing keys. module Cardano.TxGenerator.Setup.SigningKey diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs index 0effcfdf4fa..3f2fcd6c47d 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs @@ -148,7 +148,7 @@ sourceTransactionPreview txGenerator inputFunds valueSplitter toStore = (outputs, _) = toStore split -- | 'genTx' seems to mostly be a wrapper for --- 'Cardano.Api.TxBody.createAndValidateTransactionBody', which uses +-- 'Cardano.Api.TxBody.createTransactionBody', which uses -- the 'Either' convention in lieu of e.g. -- 'Control.Monad.Trans.Except.ExceptT'. Then the pure function -- 'Cardano.Api.Tx.makeSignedTransaction' is composed with it and @@ -170,7 +170,7 @@ genTx sbe ledgerParameters (collateral, collFunds) fee metadata inFunds outputs = bimap ApiError (\b -> (signShelleyTransaction (shelleyBasedEra @era) b $ map WitnessPaymentKey allKeys, getTxId b)) - (createAndValidateTransactionBody (shelleyBasedEra @era) txBodyContent) + (createTransactionBody (shelleyBasedEra @era) txBodyContent) where allKeys = mapMaybe getFundKey $ inFunds ++ collFunds txBodyContent = defaultTxBodyContent sbe diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs index 8852704849f..3a915a8c035 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-} {-# OPTIONS_GHC -fno-warn-partial-fields #-} diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 24520a80d61..31d2dd94226 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -162,7 +162,8 @@ library , yaml default-language: Haskell2010 - default-extensions: LambdaCase + default-extensions: BlockArguments + LambdaCase OverloadedStrings executable tx-generator From d6263a71143e6322f1362933cf0b861c10316a97 Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Fri, 4 Oct 2024 12:44:59 +0000 Subject: [PATCH 4/9] wb | switch local voting profile to protocol version 10 --- .../protocol-parameters-conway-voting.json | 648 ++++++++++++++++++ nix/workbench/profile/prof1-variants.jq | 2 +- nix/workbench/profile/prof2-pparams.jq | 1 + 3 files changed, 650 insertions(+), 1 deletion(-) create mode 100644 bench/tx-generator/data/protocol-parameters-conway-voting.json diff --git a/bench/tx-generator/data/protocol-parameters-conway-voting.json b/bench/tx-generator/data/protocol-parameters-conway-voting.json new file mode 100644 index 00000000000..7317c548607 --- /dev/null +++ b/bench/tx-generator/data/protocol-parameters-conway-voting.json @@ -0,0 +1,648 @@ +{ + "collateralPercentage": 150, + "costModels": { + "PlutusV1": [ + 100788, + 420, + 1, + 1, + 1000, + 173, + 0, + 1, + 1000, + 59957, + 4, + 1, + 11183, + 32, + 2477736, + 29175, + 4, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 100, + 100, + 16000, + 100, + 94375, + 32, + 132994, + 32, + 61462, + 4, + 72010, + 178, + 0, + 1, + 22151, + 32, + 91189, + 769, + 4, + 2, + 85848, + 228465, + 122, + 0, + 1, + 1, + 1000, + 42921, + 4, + 2, + 24548, + 29498, + 38, + 1, + 898148, + 27279, + 1, + 51775, + 558, + 1, + 39184, + 1000, + 60594, + 1, + 141895, + 32, + 83150, + 32, + 15299, + 32, + 76049, + 1, + 13169, + 4, + 22100, + 10, + 28999, + 74, + 1, + 28999, + 74, + 1, + 43285, + 552, + 1, + 44749, + 541, + 1, + 33852, + 32, + 68246, + 32, + 72362, + 32, + 7243, + 32, + 7391, + 32, + 11546, + 32, + 85848, + 228465, + 122, + 0, + 1, + 1, + 90434, + 519, + 0, + 1, + 74433, + 32, + 85848, + 228465, + 122, + 0, + 1, + 1, + 85848, + 228465, + 122, + 0, + 1, + 1, + 270652, + 22588, + 4, + 1457325, + 64566, + 4, + 20467, + 1, + 4, + 0, + 141992, + 32, + 100788, + 420, + 1, + 1, + 81663, + 32, + 59498, + 32, + 20142, + 32, + 24588, + 32, + 20744, + 32, + 25933, + 32, + 24623, + 32, + 3345831, + 1, + 1 + ], + "PlutusV2": [ + 100788, + 420, + 1, + 1, + 1000, + 173, + 0, + 1, + 1000, + 59957, + 4, + 1, + 11183, + 32, + 201305, + 8356, + 4, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 100, + 100, + 16000, + 100, + 94375, + 32, + 132994, + 32, + 61462, + 4, + 72010, + 178, + 0, + 1, + 22151, + 32, + 91189, + 769, + 4, + 2, + 85848, + 228465, + 122, + 0, + 1, + 1, + 1000, + 42921, + 4, + 2, + 24548, + 29498, + 38, + 1, + 898148, + 27279, + 1, + 51775, + 558, + 1, + 39184, + 1000, + 60594, + 1, + 141895, + 32, + 83150, + 32, + 15299, + 32, + 76049, + 1, + 13169, + 4, + 22100, + 10, + 28999, + 74, + 1, + 28999, + 74, + 1, + 43285, + 552, + 1, + 44749, + 541, + 1, + 33852, + 32, + 68246, + 32, + 72362, + 32, + 7243, + 32, + 7391, + 32, + 11546, + 32, + 85848, + 228465, + 122, + 0, + 1, + 1, + 90434, + 519, + 0, + 1, + 74433, + 32, + 85848, + 228465, + 122, + 0, + 1, + 1, + 85848, + 228465, + 122, + 0, + 1, + 1, + 955506, + 213312, + 0, + 2, + 270652, + 22588, + 4, + 1457325, + 64566, + 4, + 20467, + 1, + 4, + 0, + 141992, + 32, + 100788, + 420, + 1, + 1, + 81663, + 32, + 59498, + 32, + 20142, + 32, + 24588, + 32, + 20744, + 32, + 25933, + 32, + 24623, + 32, + 43053543, + 10, + 53384111, + 14333, + 10, + 43574283, + 26308, + 10, + 1293828, + 28716, + 63, + 0, + 1, + 1006041, + 43623, + 251, + 0, + 1 + ], + "PlutusV3": [ + 100788, + 420, + 1, + 1, + 1000, + 173, + 0, + 1, + 1000, + 59957, + 4, + 1, + 11183, + 32, + 201305, + 8356, + 4, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 100, + 100, + 16000, + 100, + 94375, + 32, + 132994, + 32, + 61462, + 4, + 72010, + 178, + 0, + 1, + 22151, + 32, + 91189, + 769, + 4, + 2, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, + 0, + 1, + 1, + 1000, + 42921, + 4, + 2, + 24548, + 29498, + 38, + 1, + 898148, + 27279, + 1, + 51775, + 558, + 1, + 39184, + 1000, + 60594, + 1, + 141895, + 32, + 83150, + 32, + 15299, + 32, + 76049, + 1, + 13169, + 4, + 22100, + 10, + 28999, + 74, + 1, + 28999, + 74, + 1, + 43285, + 552, + 1, + 44749, + 541, + 1, + 33852, + 32, + 68246, + 32, + 72362, + 32, + 7243, + 32, + 7391, + 32, + 11546, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, + 0, + 1, + 90434, + 519, + 0, + 1, + 74433, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, + 0, + 1, + 1, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, + 0, + 1, + 955506, + 213312, + 0, + 2, + 270652, + 22588, + 4, + 1457325, + 64566, + 4, + 20467, + 1, + 4, + 0, + 141992, + 32, + 100788, + 420, + 1, + 1, + 81663, + 32, + 59498, + 32, + 20142, + 32, + 24588, + 32, + 20744, + 32, + 25933, + 32, + 24623, + 32, + 43053543, + 10, + 53384111, + 14333, + 10, + 43574283, + 26308, + 10, + 16000, + 100, + 16000, + 100, + 962335, + 18, + 2780678, + 6, + 442008, + 1, + 52538055, + 3756, + 18, + 267929, + 18, + 76433006, + 8868, + 18, + 52948122, + 18, + 1995836, + 36, + 3227919, + 12, + 901022, + 1, + 166917843, + 4307, + 36, + 284546, + 36, + 158221314, + 26549, + 36, + 74698472, + 36, + 333849714, + 1, + 254006273, + 72, + 2174038, + 72, + 2261318, + 64571, + 4, + 207616, + 8310, + 4, + 1293828, + 28716, + 63, + 0, + 1, + 1006041, + 43623, + 251, + 0, + 1 + ] + }, + "decentralization": null, + "executionUnitPrices": { + "priceMemory": 5.77e-2, + "priceSteps": 7.21e-5 + }, + "extraPraosEntropy": null, + "maxBlockBodySize": 90112, + "maxBlockExecutionUnits": { + "memory": 62000000, + "steps": 40000000000 + }, + "maxBlockHeaderSize": 1100, + "maxCollateralInputs": 3, + "maxTxExecutionUnits": { + "memory": 14000000, + "steps": 10000000000 + }, + "maxTxSize": 16384, + "maxValueSize": 5000, + "minPoolCost": 340000000, + "minUTxOValue": null, + "monetaryExpansion": 3.0e-3, + "poolPledgeInfluence": 0.3, + "poolRetireMaxEpoch": 18, + "protocolVersion": { + "major": 10, + "minor": 0 + }, + "stakeAddressDeposit": 2000000, + "stakePoolDeposit": 500000000, + "stakePoolTargetNum": 500, + "treasuryCut": 0.2, + "txFeeFixed": 155381, + "txFeePerByte": 44, + "utxoCostPerByte": 538 +} \ No newline at end of file diff --git a/nix/workbench/profile/prof1-variants.jq b/nix/workbench/profile/prof1-variants.jq index 11ac8cfb543..712bac716ba 100644 --- a/nix/workbench/profile/prof1-variants.jq +++ b/nix/workbench/profile/prof1-variants.jq @@ -1539,7 +1539,7 @@ def all_profile_variants: } ## development profile for voting workload: PV9, Conway costmodel, 1000 DReps injected - , $cibench_base * $voting_base * $double_plus_tps_saturation_plutus * $genesis_voltaire * $dreps_small * + , $cibench_base * $voting_base * $double_plus_tps_saturation_plutus * $genesis_voltaire * $costmodel_v10_preview * $dreps_small * { name: "development-voting" } diff --git a/nix/workbench/profile/prof2-pparams.jq b/nix/workbench/profile/prof2-pparams.jq index b068acd17b6..1d2efc00ebb 100644 --- a/nix/workbench/profile/prof2-pparams.jq +++ b/nix/workbench/profile/prof2-pparams.jq @@ -32,6 +32,7 @@ def overlays: , "v9-preview": v9preview::delta , "v10-preview": v10preview::delta , "blocksize64k": blocksizes::delta_64kblocks + , "voting": voting::delta_voting }; def pParamsWithOverlays(epoch; overlay_names): From 615153c9366f8aa90f120e809a51692d92ba244e Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Tue, 8 Oct 2024 15:34:13 +0200 Subject: [PATCH 5/9] tx-generator: new selftest scaffold for voting --- .../protocol-parameters-conway-voting.json | 4 +- .../data/protocol-parameters-conway.json | 4 +- .../src/Cardano/Benchmarking/Command.hs | 19 ++++--- .../src/Cardano/Benchmarking/Script/Core.hs | 2 + .../Cardano/Benchmarking/Script/Selftest.hs | 54 +++++++++++++++++-- .../src/Cardano/Benchmarking/Script/Types.hs | 5 +- .../Cardano/TxGenerator/Setup/SigningKey.hs | 16 +++++- 7 files changed, 85 insertions(+), 19 deletions(-) diff --git a/bench/tx-generator/data/protocol-parameters-conway-voting.json b/bench/tx-generator/data/protocol-parameters-conway-voting.json index 7317c548607..2e48b8e38d2 100644 --- a/bench/tx-generator/data/protocol-parameters-conway-voting.json +++ b/bench/tx-generator/data/protocol-parameters-conway-voting.json @@ -610,7 +610,7 @@ 1 ] }, - "decentralization": null, + "decentralization": 0, "executionUnitPrices": { "priceMemory": 5.77e-2, "priceSteps": 7.21e-5 @@ -630,7 +630,7 @@ "maxTxSize": 16384, "maxValueSize": 5000, "minPoolCost": 340000000, - "minUTxOValue": null, + "minUTxOValue": 4310, "monetaryExpansion": 3.0e-3, "poolPledgeInfluence": 0.3, "poolRetireMaxEpoch": 18, diff --git a/bench/tx-generator/data/protocol-parameters-conway.json b/bench/tx-generator/data/protocol-parameters-conway.json index e633e850110..cab779321b3 100644 --- a/bench/tx-generator/data/protocol-parameters-conway.json +++ b/bench/tx-generator/data/protocol-parameters-conway.json @@ -610,7 +610,7 @@ 1 ] }, - "decentralization": null, + "decentralization": 0, "executionUnitPrices": { "priceMemory": 5.77e-2, "priceSteps": 7.21e-5 @@ -630,7 +630,7 @@ "maxTxSize": 16384, "maxValueSize": 5000, "minPoolCost": 340000000, - "minUTxOValue": null, + "minUTxOValue": 4310, "monetaryExpansion": 3.0e-3, "poolPledgeInfluence": 0.3, "poolRetireMaxEpoch": 18, diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs index 8478ef2d5bb..5ce97f0f88c 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs @@ -72,7 +72,7 @@ data Command = Json FilePath | JsonHL FilePath (Maybe FilePath) (Maybe FilePath) | Compile FilePath - | Selftest (Maybe FilePath) + | Selftest Bool (Maybe FilePath) -- True for selftesting the voting workload; specifying an optional file for dumping txns via Show | VersionCmd runCommand :: IO () @@ -83,7 +83,7 @@ runCommand' iocp = do envConsts <- installSignalHandler cmd <- customExecParser (prefs showHelpOnEmpty) - (info commandParser mempty) + (info commandParser fullDesc) case cmd of Json actionFile -> do script <- parseScriptFileAeson actionFile @@ -107,7 +107,7 @@ runCommand' iocp = do case compileOptions o of Right script -> BSL.putStr $ prettyPrint script Left err -> die $ "tx-generator:Cardano.Command.runCommand Compile: " ++ show err - Selftest outFile -> runSelftest emptyEnv envConsts outFile >>= handleError + Selftest doVoting outFile -> runSelftest emptyEnv envConsts doVoting outFile >>= handleError VersionCmd -> runVersionCommand where handleError :: Show a => Either a b -> IO () @@ -212,14 +212,14 @@ commandParser cmdParser "json" jsonCmd "Run a generic benchmarking script." <> cmdParser "json_highlevel" jsonHLCmd "Run the tx-generator using a flat config." <> cmdParser "compile" compileCmd "Compile flat-options to benchmarking script." - <> cmdParser "selftest" selfTestCmd "Run a build-in selftest." + <> cmdParser "selftest" selfTestCmd "Run a built-in selftest." <> cmdParser "version" versionCmd "Show the tx-generator version" ) where - cmdParser cmd parser description = command cmd $ info parser $ progDesc description + cmdParser cmd parser description = command cmd $ info (parser <**> helper) $ progDesc description filePath :: String -> Parser String - filePath helpMsg = strArgument (metavar "FILEPATH" <> help helpMsg) + filePath helpMsg = strArgument (metavar "FILE" <> completer (bashCompleter "file") <> help helpMsg) jsonCmd :: Parser Command jsonCmd = Json <$> filePath "low-level benchmarking script" @@ -231,13 +231,16 @@ commandParser compileCmd :: Parser Command compileCmd = Compile <$> filePath "benchmarking options" - selfTestCmd = Selftest <$> optional (filePath "output file") + selfTestCmd = Selftest + <$> switch (short 'v' <> long "voting" <> help "run voting selftest, not value split (default)") + <*> optional (filePath "output file") nodeConfigOpt :: Parser (Maybe FilePath) nodeConfigOpt = option (Just <$> str) ( long "nodeConfig" <> short 'n' - <> metavar "FILENAME" + <> metavar "FILE" + <> completer (bashCompleter "file") <> value Nothing <> help "the node configfile" ) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 68a6201d4b3..806d4622508 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -396,6 +396,8 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do OneOf _l -> error "todo: implement Quickcheck style oneOf generator" + EmptyStream -> return mempty + where feeInEra = Utils.mkTxFee fee diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index 03677bbc69b..b6b0f245aaf 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -40,14 +40,14 @@ import Paths_tx_generator -- transaction 'Streaming.Stream' that -- 'Cardano.Benchmarking.Script.Core.submitInEra' -- does 'show' and 'writeFile' on. -runSelftest :: Env -> EnvConsts -> Maybe FilePath -> IO (Either Env.Error ()) -runSelftest env envConsts@EnvConsts { .. } outFile = do - protocolFile <- getDataFileName "data/protocol-parameters.json" +runSelftest :: Env -> EnvConsts -> Bool -> Maybe FilePath -> IO (Either Env.Error ()) +runSelftest env envConsts@EnvConsts { .. } doVoting outFile = do + protocolFile <- getDataFileName pparamFile let submitMode = maybe DiscardTX DumpToFile outFile fullScript = do Env.setBenchTracers initNullTracers - forM_ (testScript protocolFile submitMode) action + forM_ (useThisScript protocolFile submitMode) action (result, Env { }, ()) <- Env.runActionMEnv env fullScript envConsts abcMaybe <- STM.atomically $ STM.readTVar envThreads case abcMaybe of @@ -56,6 +56,9 @@ runSelftest env envConsts@EnvConsts { .. } outFile = do [ "Cardano.Benchmarking.Script.Selftest.runSelftest:" , "thread state spuriously initialized" ] Nothing -> pure result + where + pparamFile = "data/" ++ if doVoting then "protocol-parameters-conway-voting.json" else "protocol-parameters.json" + useThisScript = if doVoting then testScriptVoting else testScript -- | 'printJSON' prints out the list of actions using Aeson. -- It has no callers within @cardano-node@. @@ -110,3 +113,46 @@ testScript protocolFile submitMode = createChange :: String -> String -> Int -> Int -> Action createChange src dest txCount outputs = Submit era submitMode txParams $ Take txCount $ Cycle $ SplitN src (PayToAddr key dest) outputs + +testScriptVoting :: FilePath -> SubmitMode -> [Action] +testScriptVoting protocolFile submitMode = + [ SetProtocolParameters (UseLocalProtocolFile protocolFile) + , SetNetworkId (Testnet (NetworkMagic {unNetworkMagic = 42})) + , InitWallet genesisWallet + , DefineSigningKey key skey + , AddFund era genesisWallet + (TxIn "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162" (TxIx 0)) + (L.Coin 90000000000000) key + + -- TODO: manually inject an (unnamed) DRep key into the Env by means of a new Action constructor + -- DefineDRepKey _drepKey + + , Submit era submitMode txParams + EmptyStream + -- TODO: instead, create 4(?) proposal transactions using the new constructor for Generator + -- $ Take 4 $ Cycle $ + + , Submit era submitMode txParams + EmptyStream + -- TODO: instead, create 8(?) vote transactions using the new constructor for Generator + -- $ Take 8 $ Cycle $ + + ] + where + skey :: SigningKey PaymentKey + skey = fromRight (error "could not parse hardcoded signing key") $ + parseSigningKeyTE $ + TextEnvelope { + teType = TextEnvelopeType "GenesisUTxOSigningKey_ed25519" + , teDescription = fromString "Genesis Initial UTxO Signing Key" + , teRawCBOR = "X \vl1~\182\201v(\152\250A\202\157h0\ETX\248h\153\171\SI/m\186\242D\228\NAK\182(&\162" + } + + _drepKey :: SigningKey DRepKey + _drepKey = fromRight (error "could not parse hardcoded drep key") $ + parseDRepKeyBase16 "5820aa7f780a2dcd099762ebc31a43860c1373970c2e2062fcd02cceefe682f39ed8" + + era = AnyCardanoEra ConwayEra + txParams = defaultTxGenTxParams {txParamFee = 1000000} + genesisWallet = "genesisWallet" + key = "pass-partout" diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index acd2ae519c6..e08599bb40f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -25,8 +25,7 @@ things one might do with the connexion. -} module Cardano.Benchmarking.Script.Types ( Action(..) - , Generator(Cycle, NtoM, OneOf, RoundRobin, SecureGenesis, - Sequence, Split, SplitN, Take) + , Generator(..) , PayMode(PayToAddr, PayToScript) , ProtocolParameterMode(..) , ProtocolParametersSource(QueryLocalNode, UseLocalProtocolFile) @@ -174,6 +173,8 @@ data Generator where -- practical level is unclear, though its name suggests something -- tough to reconcile with the constructor type. OneOf :: [(Generator, Double)] -> Generator + -- | 'EmptyStream' will yield an empty stream. For testing only. + EmptyStream :: Generator deriving (Show, Eq) deriving instance Generic Generator diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs index f120384c571..909f638164c 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs @@ -2,7 +2,8 @@ -- | This module provides convenience functions when dealing with signing keys. module Cardano.TxGenerator.Setup.SigningKey - ( parseSigningKeyTE + ( parseDRepKeyBase16 + , parseSigningKeyTE , parseSigningKeyBase16 , readDRepKeyFile , readSigningKeyFile @@ -38,6 +39,19 @@ parseSigningKeyBase16 k , teRawCBOR = addr } +parseDRepKeyBase16 :: BS.ByteString -> Either TxGenError (SigningKey DRepKey) +parseDRepKeyBase16 k + = either + (const $ Left $ TxGenError "parseSigningKeyBase16: ill-formed base16 encoding") + (first ApiError . deserialiseFromTextEnvelope (AsSigningKey AsDRepKey) . asTE) + (Base16.decode k) + where + asTE k' = TextEnvelope { + teType = TextEnvelopeType "DRepSigningKey_ed25519" + , teDescription = "Delegated Representative Signing Key" + , teRawCBOR = k' + } + readSigningKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey PaymentKey)) readSigningKeyFile f = first ApiError <$> readFileTextEnvelopeAnyOf acceptedTypes f From 5ded59bbd7d296a26d471e2259e6fd555a29b7da Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Fri, 11 Oct 2024 14:13:21 +0200 Subject: [PATCH 6/9] tx-generator: load StakeCredentials from genesis into environment --- .../src/Cardano/Benchmarking/Compiler.hs | 5 +- .../src/Cardano/Benchmarking/Script/Action.hs | 2 + .../src/Cardano/Benchmarking/Script/Aeson.hs | 12 ++- .../src/Cardano/Benchmarking/Script/Core.hs | 24 +++-- .../src/Cardano/Benchmarking/Script/Env.hs | 12 ++- .../Cardano/Benchmarking/Script/Selftest.hs | 10 ++- .../src/Cardano/Benchmarking/Script/Types.hs | 7 ++ .../src/Cardano/TxGenerator/Genesis.hs | 21 ++++- .../src/Cardano/TxGenerator/PureExample.hs | 2 +- .../Cardano/TxGenerator/Setup/SigningKey.hs | 87 +++++++++++++------ bench/tx-generator/test/Bench.hs | 2 +- 11 files changed, 140 insertions(+), 44 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index 866fd9dec7e..6f6c5b53920 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs @@ -65,7 +65,8 @@ compileToScript = do whenM (fromMaybe False <$> askNixOption _nix_drep_voting) do emit $ ReadDRepKeys nc - logMsg "Importing DRep SigningKeys. Done." + emit $ ReadStakeKeys nc + logMsg "Importing DRep SigningKeys and StakeCredentials. Done." genesisWallet <- importGenesisFunds collateralWallet <- addCollaterals genesisWallet @@ -280,7 +281,7 @@ newWallet n = do -- we assume the hardcoded base16 keys to successfully evaluate to a SigningKey PaymentKey parseKey :: BS.ByteString -> SigningKey PaymentKey parseKey k - = let ~(Right k') = parseSigningKeyBase16 k in k' + = let ~(Right k') = parsePaymentKeyBase16 k in k' keyNameGenesisInputFund :: String keyNameGenesisInputFund = "GenesisInputFund" diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs index 389572784ca..061aa7cc2d7 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs @@ -43,7 +43,9 @@ action a = case a of StartProtocol configFile cardanoTracerSocket -> startProtocol configFile cardanoTracerSocket ReadSigningKey name filePath -> readSigningKey name filePath ReadDRepKeys filepath -> readDRepKeys filepath + ReadStakeKeys filepath -> readStakeCredentials filepath DefineSigningKey name descr -> defineSigningKey name descr + DefineStakeKey k -> defineStakeCrendential k AddFund era wallet txIn lovelace keyName -> addFund era wallet txIn lovelace keyName Delay t -> delay t Submit era submitMode txParams generator -> submitAction era submitMode generator txParams diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs index 353c2f5c2c1..eb778c72c0e 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs @@ -62,7 +62,7 @@ instance ToJSON TxGenTxParams where instance FromJSON TxGenTxParams where parseJSON = genericParseJSON jsonOptionsUnTaggedSum --- FIXME: workaround instances +-- FIXME: workaround instance instance ToJSON (SigningKey PaymentKey) where toJSON = toJSON . serialiseToTextEnvelope Nothing instance FromJSON (SigningKey PaymentKey) where @@ -72,6 +72,16 @@ instance FromJSON (SigningKey PaymentKey) where Right k -> pure k Left err -> fail $ show err +-- FIXME: workaround instance +instance ToJSON (VerificationKey StakeKey) where + toJSON = toJSON . serialiseToTextEnvelope Nothing +instance FromJSON (VerificationKey StakeKey) where + parseJSON o = do + te <- parseJSON o + case deserialiseFromTextEnvelope (AsVerificationKey AsStakeKey) te of + Right k -> pure k + Left err -> fail $ show err + instance ToJSON ProtocolParametersSource where toJSON = genericToJSON jsonOptionsUnTaggedSum toEncoding = genericToEncoding jsonOptionsUnTaggedSum diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 806d4622508..a7d492e65ac 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -19,8 +19,8 @@ where import Cardano.Api import Cardano.Api.Shelley (PlutusScriptOrReferenceInput (..), ProtocolParameters, - ShelleyLedgerEra, convertToLedgerProtocolParameters, protocolParamMaxTxExUnits, - protocolParamPrices) + ShelleyLedgerEra, StakeCredential (..), convertToLedgerProtocolParameters, + protocolParamMaxTxExUnits, protocolParamPrices) import Cardano.Benchmarking.GeneratorTx as GeneratorTx (AsyncBenchmarkControl) import qualified Cardano.Benchmarking.GeneratorTx as GeneratorTx (waitBenchmark, walletBenchmark) @@ -92,11 +92,14 @@ setProtocolParameters s = case s of readSigningKey :: String -> SigningKeyFile In -> ActionM () readSigningKey name filePath = - setEnvKeys name =<< liftIOSafe (readSigningKeyFile filePath) + setEnvKeys name =<< liftIOSafe (readPaymentKeyFile filePath) defineSigningKey :: String -> SigningKey PaymentKey -> ActionM () defineSigningKey = setEnvKeys +defineStakeCrendential :: VerificationKey StakeKey -> ActionM () +defineStakeCrendential = setEnvStakeCredentials . (: []) . StakeCredentialByKey . verificationKeyHash + readDRepKeys :: FilePath -> ActionM () readDRepKeys ncFile = do genesis <- onNothing throwKeyErr $ getGenesisDirectory <$> liftIOSafe (mkNodeConfig ncFile) @@ -107,8 +110,19 @@ readDRepKeys ncFile = do traceDebug $ "DRep SigningKeys loaded: " ++ show (length ks) ++ " from: " ++ genesis where throwKeyErr = liftTxGenError . TxGenError $ - "readDRepKeys: no genesisDirectory could " - <> "be retrieved from the node config" + "readDRepKeys: no genesisDirectory could be retrieved from the node config" + +readStakeCredentials :: FilePath -> ActionM () +readStakeCredentials ncFile = do + genesis <- onNothing throwKeyErr $ getGenesisDirectory <$> liftIOSafe (mkNodeConfig ncFile) + -- "cache-entry" is a link or copy of the actual genesis folder created by "create-testnet-data" + -- in the workbench's run directory structure, this link or copy is created for each run - by workbench + ks <- liftIOSafe . Genesis.genesisLoadStakeKeys $ genesis + setEnvStakeCredentials $ map (StakeCredentialByKey . verificationKeyHash) ks + traceDebug $ "StakeCredentials loaded: " ++ show (length ks) ++ " from: " ++ genesis + where + throwKeyErr = liftTxGenError . TxGenError $ + "readStakeCredentials: no genesisDirectory could be retrieved from the node config" addFund :: AnyCardanoEra -> String -> TxIn -> L.Coin -> String -> ActionM () addFund era wallet txIn lovelace keyName = do diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs index 96320f82d39..394985abfa1 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs @@ -55,6 +55,8 @@ module Cardano.Benchmarking.Script.Env ( , setProtoParamMode , getEnvSocketPath , setEnvSocketPath + , getEnvStakeCredentials + , setEnvStakeCredentials , getEnvThreads , setEnvThreads , getEnvWallets @@ -63,7 +65,7 @@ module Cardano.Benchmarking.Script.Env ( , setEnvSummary ) where -import Cardano.Api (File (..), DRepKey, SocketPath) +import Cardano.Api (DRepKey, File (..), SocketPath, StakeCredential) import Cardano.Benchmarking.GeneratorTx import qualified Cardano.Benchmarking.LogTypes as Tracer @@ -109,6 +111,7 @@ data Env = Env { -- | 'Cardano.Api.ProtocolParameters' is ultimately , envWallets :: Map String WalletRef , envSummary :: Maybe PlutusBudgetSummary , envDRepKeys :: [SigningKey DRepKey] + , envStakeCredentials :: [StakeCredential] } -- | `Env` uses `Maybe` to represent values that might be uninitialized. -- This being empty means `Nothing` is used across the board, along with @@ -123,6 +126,7 @@ emptyEnv = Env { protoParams = Nothing , envWallets = Map.empty , envSummary = Nothing , envDRepKeys = [] + , envStakeCredentials = [] } newEnvConsts :: IOManager -> Maybe Nix.NixServiceOptions -> STM Tracer.EnvConsts @@ -202,6 +206,9 @@ setEnvKeys key val = modifyEnv (\e -> e { envKeys = Map.insert key val (envKeys setEnvDRepKeys :: [SigningKey DRepKey] -> ActionM () setEnvDRepKeys val = modifyEnv (\e -> e { envDRepKeys = val }) +setEnvStakeCredentials :: [StakeCredential] -> ActionM () +setEnvStakeCredentials val = modifyEnv (\e -> e { envStakeCredentials = val }) + -- | Write accessor for `envProtocol`. setEnvProtocol :: SomeConsensusProtocol -> ActionM () setEnvProtocol val = modifyEnv (\e -> e { envProtocol = Just val }) @@ -281,6 +288,9 @@ getEnvKeys = getEnvMap envKeys getEnvDRepKeys :: ActionM [SigningKey DRepKey] getEnvDRepKeys = lift $ RWS.gets envDRepKeys +getEnvStakeCredentials :: ActionM [StakeCredential] +getEnvStakeCredentials = lift $ RWS.gets envStakeCredentials + -- | Read accessor for `envNetworkId`. getEnvNetworkId :: ActionM NetworkId getEnvNetworkId = getEnvVal envNetworkId "Genesis" diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index b6b0f245aaf..0f5ebce6eef 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -96,7 +96,7 @@ testScript protocolFile submitMode = ] where skey = fromRight (error "could not parse hardcoded signing key") $ - parseSigningKeyTE $ + parsePaymentKeyTE $ TextEnvelope { teType = TextEnvelopeType "GenesisUTxOSigningKey_ed25519" , teDescription = fromString "Genesis Initial UTxO Signing Key" @@ -124,6 +124,8 @@ testScriptVoting protocolFile submitMode = (TxIn "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162" (TxIx 0)) (L.Coin 90000000000000) key + , DefineStakeKey stakeKey + -- TODO: manually inject an (unnamed) DRep key into the Env by means of a new Action constructor -- DefineDRepKey _drepKey @@ -141,7 +143,7 @@ testScriptVoting protocolFile submitMode = where skey :: SigningKey PaymentKey skey = fromRight (error "could not parse hardcoded signing key") $ - parseSigningKeyTE $ + parsePaymentKeyTE $ TextEnvelope { teType = TextEnvelopeType "GenesisUTxOSigningKey_ed25519" , teDescription = fromString "Genesis Initial UTxO Signing Key" @@ -152,6 +154,10 @@ testScriptVoting protocolFile submitMode = _drepKey = fromRight (error "could not parse hardcoded drep key") $ parseDRepKeyBase16 "5820aa7f780a2dcd099762ebc31a43860c1373970c2e2062fcd02cceefe682f39ed8" + stakeKey :: VerificationKey StakeKey + stakeKey = fromRight (error "could not parse hardcoded stake key") $ + parseStakeKeyBase16 "5820bbbfe3f3b71b00d1d61f4fe2a82526597740f61a0aa06f1324557925803c7d3e" + era = AnyCardanoEra ConwayEra txParams = defaultTxGenTxParams {txParamFee = 1000000} genesisWallet = "genesisWallet" diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index e08599bb40f..7982d7d1213 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -94,8 +94,15 @@ data Action where -- been created with cardano-cli create-testnet-data, and from -- where DRep signing keys can be loaded. ReadDRepKeys :: !FilePath -> Action + -- | 'ReadDRepKeys' expects the path to a node config file. This + -- configuration is supposed to refer to a genesis which has + -- been created with cardano-cli create-testnet-data, and from + -- where stake verification keys can be loaded. + ReadStakeKeys :: !FilePath -> Action -- | 'DefineSigningKey' is just a 'Map.insert' on the state variable. DefineSigningKey :: !String -> !(SigningKey PaymentKey) -> Action + -- | inject a singleton StakeCredential into the environment + DefineStakeKey :: !(VerificationKey StakeKey) -> Action -- | 'AddFund' is mostly a wrapper around -- 'Cardano.Benchmarking.Wallet.walletRefInsertFund' which in turn -- is just 'Control.Concurrent.modifyMVar' around diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs index 55c016ebac6..81aa086797a 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs @@ -13,6 +13,7 @@ module Cardano.TxGenerator.Genesis ( genesisInitialFunds , genesisInitialFundForKey , genesisLoadDRepKeys + , genesisLoadStakeKeys , genesisTxInput , genesisExpenditure , genesisSecureInitialFund @@ -24,11 +25,11 @@ import Cardano.Api import Cardano.Api.Shelley (ReferenceScript (..), fromShelleyPaymentCredential, fromShelleyStakeReference) -import Cardano.CLI.Types.Common (SigningKeyFile) +import Cardano.CLI.Types.Common (SigningKeyFile, VerificationKeyFile) import qualified Cardano.Ledger.Coin as L import Cardano.Ledger.Shelley.API (Addr (..), sgInitialFunds) import Cardano.TxGenerator.Fund -import Cardano.TxGenerator.Setup.SigningKey (readDRepKeyFile) +import Cardano.TxGenerator.Setup.SigningKey (readDRepKeyFile, readStakeKeyFile) import Cardano.TxGenerator.Types import Cardano.TxGenerator.Utils import Ouroboros.Consensus.Shelley.Node (validateGenesis) @@ -36,7 +37,7 @@ import Ouroboros.Consensus.Shelley.Node (validateGenesis) import Data.Bifunctor (bimap, second) import Data.Char (isDigit) import Data.Function ((&)) -import Data.List (find) +import Data.List (find, isPrefixOf, isSuffixOf) import qualified Data.ListMap as ListMap (toList) import System.Directory (listDirectory) import System.FilePath (()) @@ -163,3 +164,17 @@ genesisLoadDRepKeys genesisDir = runExceptT $ do _ -> False drepDir = genesisDir "drep-keys" + +genesisLoadStakeKeys :: FilePath -> IO (Either TxGenError [VerificationKey StakeKey]) +genesisLoadStakeKeys genesisDir = runExceptT $ do + dirContents <- handleIOExceptT IOError (listDirectory poolsDir) + let fs = filter (\f -> "staking-reward" `isPrefixOf` f && ".vkey" `isSuffixOf` f) dirContents + mapM loadFile fs + where + asVerificationKeyFile :: FilePath -> VerificationKeyFile In + asVerificationKeyFile = File + + loadFile f = hoistEither =<< handleIOExceptT IOError + (readStakeKeyFile $ asVerificationKeyFile $ poolsDir f) + + poolsDir = genesisDir "pools" diff --git a/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs b/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs index ed4f27d63d9..313fa260cf8 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs @@ -61,7 +61,7 @@ demo' parametersFile = do return newState signingKey :: SigningKey PaymentKey -signingKey = fromRight (error "signingKey: parseError") $ parseSigningKeyTE keyData +signingKey = fromRight (error "signingKey: parseError") $ parsePaymentKeyTE keyData where keyData = TextEnvelope { teType = TextEnvelopeType "GenesisUTxOSigningKey_ed25519" , teDescription = fromString "Genesis Initial UTxO Signing Key" diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs index 909f638164c..5ed19e0f491 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs @@ -1,12 +1,16 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | This module provides convenience functions when dealing with signing keys. module Cardano.TxGenerator.Setup.SigningKey ( parseDRepKeyBase16 - , parseSigningKeyTE - , parseSigningKeyBase16 + , parsePaymentKeyBase16 + , parseStakeKeyBase16 + , parsePaymentKeyTE , readDRepKeyFile - , readSigningKeyFile + , readPaymentKeyFile + , readStakeKeyFile , PaymentKey , SigningKey ) @@ -14,7 +18,7 @@ module Cardano.TxGenerator.Setup.SigningKey import Cardano.Api -import Cardano.CLI.Types.Common (SigningKeyFile) +import Cardano.CLI.Types.Common (SigningKeyFile, VerificationKeyFile) import Cardano.TxGenerator.Types (TxGenError (..)) import Data.Bifunctor (first) @@ -22,42 +26,69 @@ import qualified Data.ByteString as BS (ByteString) import Data.ByteString.Base16 as Base16 (decode) -parseSigningKeyTE :: TextEnvelope -> Either TxGenError (SigningKey PaymentKey) -parseSigningKeyTE +parsePaymentKeyTE :: TextEnvelope -> Either TxGenError (SigningKey PaymentKey) +parsePaymentKeyTE = first ApiError . deserialiseFromTextEnvelopeAnyOf acceptedTypes -parseSigningKeyBase16 :: BS.ByteString -> Either TxGenError (SigningKey PaymentKey) -parseSigningKeyBase16 k - = either - (const $ Left $ TxGenError "parseSigningKeyBase16: ill-formed base16 encoding") - (parseSigningKeyTE . asTE) - (Base16.decode k) +parsePaymentKeyBase16 :: BS.ByteString -> Either TxGenError (SigningKey PaymentKey) +parsePaymentKeyBase16 k + = parseSigningKeyBase16 AsPaymentKey acceptedTypes k teTemplate where - asTE addr = TextEnvelope { - teType = "PaymentSigningKeyShelley_ed25519" - , teDescription = "Payment Signing Key" - , teRawCBOR = addr - } + teTemplate = TextEnvelope { + teType = "PaymentSigningKeyShelley_ed25519" + , teDescription = "Payment Signing Key" + , teRawCBOR = "" + } parseDRepKeyBase16 :: BS.ByteString -> Either TxGenError (SigningKey DRepKey) parseDRepKeyBase16 k - = either - (const $ Left $ TxGenError "parseSigningKeyBase16: ill-formed base16 encoding") - (first ApiError . deserialiseFromTextEnvelope (AsSigningKey AsDRepKey) . asTE) - (Base16.decode k) + = parseSigningKeyBase16 AsDRepKey [] k teTemplate where - asTE k' = TextEnvelope { - teType = TextEnvelopeType "DRepSigningKey_ed25519" - , teDescription = "Delegated Representative Signing Key" - , teRawCBOR = k' - } + teTemplate = TextEnvelope { + teType = TextEnvelopeType "DRepSigningKey_ed25519" + , teDescription = "Delegated Representative Signing Key" + , teRawCBOR = "" + } -readSigningKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey PaymentKey)) -readSigningKeyFile f = first ApiError <$> readFileTextEnvelopeAnyOf acceptedTypes f +parseStakeKeyBase16 :: BS.ByteString -> Either TxGenError (VerificationKey StakeKey) +parseStakeKeyBase16 key + = do + key' <- parseBase16 key + first ApiError $ + deserialiseFromTextEnvelope (AsVerificationKey AsStakeKey) (teTemplate key') + where + teTemplate k = TextEnvelope { + teType = TextEnvelopeType "StakeVerificationKeyShelley_ed25519" + , teDescription = "Stake Verification Key" + , teRawCBOR = k + } + +parseBase16 :: BS.ByteString -> Either TxGenError BS.ByteString +parseBase16 + = first (const $ TxGenError "parseBase16: ill-formed base16 encoding") + . Base16.decode + +parseSigningKeyBase16 + :: HasTextEnvelope (SigningKey k) + => AsType k + -> [FromSomeType HasTextEnvelope (SigningKey k)] + -> BS.ByteString -> TextEnvelope -> Either TxGenError (SigningKey k) +parseSigningKeyBase16 k paymentKeys key te = do + key' <- parseBase16 key + let te' = te {teRawCBOR = key'} + first ApiError $ if null paymentKeys + then deserialiseFromTextEnvelope (AsSigningKey k) te' + else deserialiseFromTextEnvelopeAnyOf paymentKeys te' + +readPaymentKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey PaymentKey)) +readPaymentKeyFile f = first ApiError <$> readFileTextEnvelopeAnyOf acceptedTypes f readDRepKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey DRepKey)) readDRepKeyFile f = first ApiError <$> readKeyFileTextEnvelope (AsSigningKey AsDRepKey) f +readStakeKeyFile :: VerificationKeyFile In -> IO (Either TxGenError (VerificationKey StakeKey)) +readStakeKeyFile f = first ApiError <$> readKeyFileTextEnvelope (AsVerificationKey AsStakeKey) f + acceptedTypes :: [FromSomeType HasTextEnvelope (SigningKey PaymentKey)] acceptedTypes = [ FromSomeType (AsSigningKey AsGenesisUTxOKey) castSigningKey diff --git a/bench/tx-generator/test/Bench.hs b/bench/tx-generator/test/Bench.hs index ec35408a6e1..586f36c60db 100644 --- a/bench/tx-generator/test/Bench.hs +++ b/bench/tx-generator/test/Bench.hs @@ -18,7 +18,7 @@ main = defaultMain [ bench "tx-gen" $ whnfIO do envConsts <- atomically do newEnvConsts (error "No IOManager!") Nothing - runSelftest emptyEnv envConsts Nothing >>= \case + runSelftest emptyEnv envConsts False Nothing >>= \case Right _ -> pure () Left err -> error $ show err ] From 4e8f32a097316fddcae9cfeb4bebcefce103e26d Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Fri, 11 Oct 2024 15:43:31 +0200 Subject: [PATCH 7/9] tx-generator: query GovState and store in environment --- .../src/Cardano/Benchmarking/Command.hs | 3 + .../Cardano/Benchmarking/OuroborosImports.hs | 20 +- .../src/Cardano/Benchmarking/Script/Core.hs | 49 +---- .../src/Cardano/Benchmarking/Script/Env.hs | 17 +- .../Cardano/Benchmarking/Script/Queries.hs | 185 ++++++++++++++++++ .../src/Cardano/Benchmarking/Script/Types.hs | 32 +-- .../src/Cardano/TxGenerator/Genesis.hs | 3 +- .../Cardano/TxGenerator/Setup/SigningKey.hs | 3 +- bench/tx-generator/tx-generator.cabal | 2 + 9 files changed, 238 insertions(+), 76 deletions(-) create mode 100644 bench/tx-generator/src/Cardano/Benchmarking/Script/Queries.hs diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs index 5ce97f0f88c..466ccbaf0c3 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs @@ -24,6 +24,7 @@ import Cardano.Benchmarking.Script (parseScriptFileAeson, runScript) import Cardano.Benchmarking.Script.Aeson (parseJSONFile, prettyPrint) import Cardano.Benchmarking.Script.Env as Env (emptyEnv, newEnvConsts) import Cardano.Benchmarking.Script.Selftest (runSelftest) +import Cardano.Benchmarking.Script.Queries (debugDumpProposalsPeriodically) import Cardano.Benchmarking.Version as Version import Cardano.TxGenerator.PlutusContext (readScriptData) import Cardano.TxGenerator.Setup.NixService @@ -99,6 +100,8 @@ runCommand' iocp = do quickTestPlutusDataOrDie finalOpts + debugDumpProposalsPeriodically finalOpts + case compileOptions finalOpts of Right script -> runScript emptyEnv script consts >>= handleError . fst err -> die $ "tx-generator:Cardano.Command.runCommand JsonHL: " ++ show err diff --git a/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs b/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs index 6843b2a3d21..5bed4817267 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs @@ -10,8 +10,7 @@ module Cardano.Benchmarking.OuroborosImports , LoggingLayer , PaymentKey , ShelleyGenesis - , SigningKey - , SigningKeyFile + -- , SigningKey , StandardShelley , NetworkId -- , getGenesis @@ -22,8 +21,13 @@ module Cardano.Benchmarking.OuroborosImports , submitTxToNodeLocal ) where -import Prelude +import Cardano.Api (BlockType (..), ConsensusModeParams (..), EpochSlots (..), + LocalNodeConnectInfo (..), NetworkId (..), PaymentKey, SocketPath, TxInMode, + TxValidationErrorInCardanoMode, protocolInfo, submitTxToNodeLocal) +import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis) +import Cardano.Node.Configuration.Logging (LoggingLayer) +import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..)) import Ouroboros.Consensus.Block.Abstract import qualified Ouroboros.Consensus.Cardano as Consensus import Ouroboros.Consensus.Config (TopLevelConfig, configBlock, configCodec) @@ -32,15 +36,7 @@ import Ouroboros.Consensus.Node (ProtocolInfo (..)) import Ouroboros.Consensus.Shelley.Eras (StandardCrypto, StandardShelley) import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (..)) -import Cardano.Node.Configuration.Logging (LoggingLayer) -import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..)) - -import Cardano.CLI.Types.Common (SigningKeyFile) - -import Cardano.Api (BlockType (..), ConsensusModeParams (..), EpochSlots (..), - LocalNodeConnectInfo (..), NetworkId (..), PaymentKey, SigningKey, SocketPath, - TxInMode, TxValidationErrorInCardanoMode, protocolInfo, submitTxToNodeLocal) -import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis) +import Prelude type CardanoBlock = Consensus.CardanoBlock StandardCrypto diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index a7d492e65ac..e759d2b9f9f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -19,7 +19,7 @@ where import Cardano.Api import Cardano.Api.Shelley (PlutusScriptOrReferenceInput (..), ProtocolParameters, - ShelleyLedgerEra, StakeCredential (..), convertToLedgerProtocolParameters, + StakeCredential (..), convertToLedgerProtocolParameters, protocolParamMaxTxExUnits, protocolParamPrices) import Cardano.Benchmarking.GeneratorTx as GeneratorTx (AsyncBenchmarkControl) @@ -29,17 +29,17 @@ import Cardano.Benchmarking.GeneratorTx.NodeToNode (ConnectClient, import Cardano.Benchmarking.GeneratorTx.SizedMetadata (mkMetadata) import Cardano.Benchmarking.LogTypes as Core (AsyncBenchmarkControl (..), TraceBenchTxSubmit (..), btConnect_, btN2N_, btSubmission2_, btTxSubmit_) -import Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, SigningKeyFile, - makeLocalConnectInfo, protocolToCodecConfig) +import Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, + protocolToCodecConfig) import Cardano.Benchmarking.Script.Aeson (prettyPrintOrdered, readProtocolParametersFile) import Cardano.Benchmarking.Script.Env hiding (Error (TxGenError)) import qualified Cardano.Benchmarking.Script.Env as Env (Error (TxGenError)) +import Cardano.Benchmarking.Script.Queries import Cardano.Benchmarking.Script.Types 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.Core as Ledger import Cardano.Logging hiding (LocalSocket) import Cardano.TxGenerator.Fund as Fund import qualified Cardano.TxGenerator.FundQueue as FundQueue @@ -52,9 +52,6 @@ import Cardano.TxGenerator.Tx import Cardano.TxGenerator.Types import qualified Cardano.TxGenerator.Utils as Utils import Cardano.TxGenerator.UTxO -import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) - -import Prelude import Control.Concurrent (threadDelay) import Control.Monad @@ -185,43 +182,6 @@ cancelBenchmark = do liftIO abcShutdown waitBenchmarkCore abc -getLocalConnectInfo :: ActionM LocalNodeConnectInfo -getLocalConnectInfo = makeLocalConnectInfo <$> getEnvNetworkId <*> getEnvSocketPath - -queryEra :: ActionM AnyCardanoEra -queryEra = do - localNodeConnectInfo <- getLocalConnectInfo - chainTip <- getLocalChainTip localNodeConnectInfo - mapExceptT liftIO . - modifyError (Env.TxGenError . TxGenError . show) $ - queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) QueryCurrentEra - -queryRemoteProtocolParameters :: ActionM ProtocolParameters -queryRemoteProtocolParameters = do - localNodeConnectInfo <- getLocalConnectInfo - chainTip <- liftIO $ getLocalChainTip localNodeConnectInfo - era <- queryEra - let - callQuery :: forall era. - QueryInEra era (Ledger.PParams (ShelleyLedgerEra era)) - -> ActionM ProtocolParameters - callQuery query@(QueryInShelleyBasedEra shelleyEra _) = do - pp <- liftEither . first (Env.TxGenError . TxGenError . show) =<< mapExceptT liftIO (modifyError (Env.TxGenError . TxGenError . show) $ - queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) (QueryInEra query)) - let pp' = fromLedgerPParams shelleyEra pp - pparamsFile = "protocol-parameters-queried.json" - liftIO $ BSL.writeFile pparamsFile $ prettyPrintOrdered pp' - traceDebug $ "queryRemoteProtocolParameters : query result saved in: " ++ pparamsFile - return pp' - case era of - AnyCardanoEra ByronEra -> liftTxGenError $ TxGenError "queryRemoteProtocolParameters Byron not supported" - AnyCardanoEra ShelleyEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraShelley QueryProtocolParameters - AnyCardanoEra AllegraEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAllegra QueryProtocolParameters - AnyCardanoEra MaryEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraMary QueryProtocolParameters - AnyCardanoEra AlonzoEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAlonzo QueryProtocolParameters - AnyCardanoEra BabbageEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraBabbage QueryProtocolParameters - AnyCardanoEra ConwayEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraConway QueryProtocolParameters - getProtocolParameters :: ActionM ProtocolParameters getProtocolParameters = do getProtoParamMode >>= \case @@ -312,6 +272,7 @@ evalGenerator :: IsShelleyBasedEra era => Generator -> TxGenTxParams -> AsType e evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do networkId <- getEnvNetworkId protocolParameters <- getProtocolParameters + case convertToLedgerProtocolParameters shelleyBasedEra protocolParameters of Left err -> throwE (Env.TxGenError (ApiError err)) Right ledgerParameters -> diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs index 394985abfa1..d8021cdfd12 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs @@ -45,6 +45,8 @@ module Cardano.Benchmarking.Script.Env ( , setEnvDRepKeys , getEnvGenesis , setEnvGenesis + , getEnvGovSummary + , setEnvGovSummary , getEnvKeys , setEnvKeys , getEnvNetworkId @@ -65,12 +67,11 @@ module Cardano.Benchmarking.Script.Env ( , setEnvSummary ) where -import Cardano.Api (DRepKey, File (..), SocketPath, StakeCredential) +import Cardano.Api (DRepKey, File (..), ShelleyBasedEra (..), SocketPath, StakeCredential) import Cardano.Benchmarking.GeneratorTx import qualified Cardano.Benchmarking.LogTypes as Tracer -import Cardano.Benchmarking.OuroborosImports (NetworkId, PaymentKey, ShelleyGenesis, - SigningKey) +import Cardano.Benchmarking.OuroborosImports (NetworkId, PaymentKey, ShelleyGenesis) import Cardano.Benchmarking.Script.Types import Cardano.Benchmarking.Wallet import Cardano.Ledger.Crypto (StandardCrypto) @@ -78,6 +79,7 @@ import Cardano.Logging import Cardano.Node.Protocol.Types (SomeConsensusProtocol) import Cardano.TxGenerator.PlutusContext (PlutusBudgetSummary) import Cardano.TxGenerator.Setup.NixService as Nix (NixServiceOptions) +import Cardano.TxGenerator.Setup.SigningKey (SigningKey) import Cardano.TxGenerator.Types (TxGenError (..)) import Ouroboros.Network.NodeToClient (IOManager) @@ -92,6 +94,7 @@ import Control.Monad.Trans.RWS.Strict (RWST) import qualified Control.Monad.Trans.RWS.Strict as RWS import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Data.Ratio import qualified Data.Text as Text import qualified System.IO as IO (hPutStrLn, stderr) @@ -112,6 +115,7 @@ data Env = Env { -- | 'Cardano.Api.ProtocolParameters' is ultimately , envSummary :: Maybe PlutusBudgetSummary , envDRepKeys :: [SigningKey DRepKey] , envStakeCredentials :: [StakeCredential] + , envGovStateSummary :: GovStateSummary } -- | `Env` uses `Maybe` to represent values that might be uninitialized. -- This being empty means `Nothing` is used across the board, along with @@ -127,6 +131,7 @@ emptyEnv = Env { protoParams = Nothing , envSummary = Nothing , envDRepKeys = [] , envStakeCredentials = [] + , envGovStateSummary = GovStateSummary 1 (1 % 2) (GovernanceActionIds ShelleyBasedEraConway []) } newEnvConsts :: IOManager -> Maybe Nix.NixServiceOptions -> STM Tracer.EnvConsts @@ -235,6 +240,9 @@ setEnvWallets key val = modifyEnv (\e -> e { envWallets = Map.insert key val (en setEnvSummary :: PlutusBudgetSummary -> ActionM () setEnvSummary val = modifyEnv (\e -> e { envSummary = Just val }) +setEnvGovSummary :: GovStateSummary -> ActionM () +setEnvGovSummary val = modifyEnv (\e -> e { envGovStateSummary = val }) + -- | Read accessor helper for `Maybe` record fields of `Env`. getEnvVal :: (Env -> Maybe t) -> String -> ActionM t getEnvVal acc s = do @@ -317,6 +325,9 @@ getEnvWallets = getEnvMap envWallets getEnvSummary :: ActionM (Maybe PlutusBudgetSummary) getEnvSummary = lift (RWS.gets envSummary) +getEnvGovSummary :: ActionM GovStateSummary +getEnvGovSummary = lift (RWS.gets envGovStateSummary) + -- | Helper to make submissions to the `Tracer.BenchTracers`. traceBenchTxSubmit :: (forall txId. x -> Tracer.TraceBenchTxSubmit txId) -> x -> ActionM () traceBenchTxSubmit tag msg = do diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Queries.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Queries.hs new file mode 100644 index 00000000000..36d7bbb6ac7 --- /dev/null +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Queries.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.Benchmarking.Script.Queries + ( getLocalConnectInfo + , queryEra + , queryGovernanceState + , queryRemoteProtocolParameters + + , debugDumpProposalsPeriodically + ) where + +import Cardano.Api +import Cardano.Api.Shelley (ProtocolParameters, ShelleyLedgerEra) + +import Cardano.Benchmarking.OuroborosImports +import Cardano.Benchmarking.Script.Aeson (prettyPrintOrdered) +import Cardano.Benchmarking.Script.Env hiding (Error (TxGenError)) +import qualified Cardano.Benchmarking.Script.Env as Env (Error (TxGenError)) +import Cardano.Benchmarking.Script.Types +import Cardano.Ledger.BaseTypes (unboundRational) +import qualified Cardano.Ledger.Conway.Governance as LC +import qualified Cardano.Ledger.Conway.PParams as LC +import qualified Cardano.Ledger.Core as Ledger +import Cardano.TxGenerator.Setup.NixService (NixServiceOptions (..)) +import Cardano.TxGenerator.Setup.NodeConfig (mkConsensusProtocol, mkNodeConfig) +import Cardano.TxGenerator.Types +import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) + +import Control.Concurrent (forkIO, threadDelay) +import Control.Exception (SomeException (..), catch, try) +import Control.Monad (forever, void) +import Data.Bifunctor (first) +import Data.ByteString.Lazy.Char8 as BSL (writeFile) +import qualified Data.Foldable as Foldable +import Data.Ratio +import Data.Time (defaultTimeLocale, formatTime) +import Data.Time.Clock.System (getSystemTime, systemToUTCTime) +import Lens.Micro ((^.)) + + +fileNamePParams :: FilePath +fileNamePParams = "protocol-parameters-queried.json" + +fileNameProposals :: String -> FilePath +fileNameProposals tStamp = "govstate-proposals-" ++ tStamp ++ ".json" + +getLocalConnectInfo :: ActionM LocalNodeConnectInfo +getLocalConnectInfo = makeLocalConnectInfo <$> getEnvNetworkId <*> getEnvSocketPath + +queryEra :: ActionM AnyCardanoEra +queryEra = do + localNodeConnectInfo <- getLocalConnectInfo + chainTip <- getLocalChainTip localNodeConnectInfo + mapExceptT liftIO . + modifyError (Env.TxGenError . TxGenError . show) $ + queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) QueryCurrentEra + +queryRemoteProtocolParameters :: ActionM ProtocolParameters +queryRemoteProtocolParameters = do + localNodeConnectInfo <- getLocalConnectInfo + chainTip <- liftIO $ getLocalChainTip localNodeConnectInfo + era <- queryEra + + let + callQuery :: forall era. + QueryInEra era (Ledger.PParams (ShelleyLedgerEra era)) + -> ActionM ProtocolParameters + callQuery query@(QueryInShelleyBasedEra shelleyEra _) = do + pp <- liftEither . first (Env.TxGenError . TxGenError . show) =<< mapExceptT liftIO (modifyError (Env.TxGenError . TxGenError . show) $ + queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) (QueryInEra query)) + let pp' = fromLedgerPParams shelleyEra pp + liftIO $ BSL.writeFile fileNamePParams $ prettyPrintOrdered pp' + traceDebug $ "queryRemoteProtocolParameters: query result saved in: " ++ fileNamePParams + return pp' + + case era of + AnyCardanoEra ByronEra -> liftTxGenError $ TxGenError "queryRemoteProtocolParameters Byron not supported" + AnyCardanoEra ShelleyEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraShelley QueryProtocolParameters + AnyCardanoEra AllegraEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAllegra QueryProtocolParameters + AnyCardanoEra MaryEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraMary QueryProtocolParameters + AnyCardanoEra AlonzoEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAlonzo QueryProtocolParameters + AnyCardanoEra BabbageEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraBabbage QueryProtocolParameters + AnyCardanoEra ConwayEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraConway QueryProtocolParameters + +queryGovernanceState :: ActionM GovStateSummary +queryGovernanceState = do + localNodeConnectInfo <- getLocalConnectInfo + chainTip <- liftIO $ getLocalChainTip localNodeConnectInfo + currentEra <- queryEra + + let + callQuery :: forall era ledgerEra. + ( ShelleyLedgerEra era ~ ledgerEra + , LC.GovState ledgerEra ~ LC.ConwayGovState ledgerEra + , LC.ConwayEraPParams ledgerEra + ) => ShelleyBasedEra era -> ActionM GovStateSummary + callQuery era = shelleyBasedEraConstraints era $ do + let + query = QueryInEra $ QueryInShelleyBasedEra era QueryGovState + + gs <- liftEither . first (Env.TxGenError . TxGenError . show) =<< mapExceptT liftIO (modifyError (Env.TxGenError . TxGenError . show) $ + queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) query) + let + props = LC.cgsProposals gs + govActIds = Foldable.toList $ LC.proposalsIds props + + pparams = LC.cgsCurPParams gs + deposit = pparams ^. LC.ppGovActionDepositL + threshold = unboundRational $ LC.dvtTreasuryWithdrawal $ pparams ^. LC.ppDRepVotingThresholdsL + threshInt = fromInteger (numerator threshold) % fromInteger (denominator threshold) + + pure $ GovStateSummary deposit threshInt (GovernanceActionIds era govActIds) + + case currentEra of + AnyCardanoEra ConwayEra -> callQuery ShelleyBasedEraConway + AnyCardanoEra _ -> liftTxGenError $ TxGenError "queryGovState: pre-Conway eras not supported" + +-- | This spawns a debug thread to dump the proposals section of the governance state every minute, +-- iff tx-generator voting workload is specified, and we're in a ConwayEraOnwards. +-- +-- All failures and exceptions are silent and non-blocking, i.e. there are just no file dumps appearing. +-- +-- NB. This must NEVER be used during an actual benchmark, as this query potentially forces the ledger pulser. +-- +debugDumpProposalsPeriodically :: NixServiceOptions -> IO () +debugDumpProposalsPeriodically NixServiceOptions{..} + | not (or _nix_drep_voting) = pure () + | otherwise = try setup >>= \case + Left SomeException{} -> pure () + Right (connInfo, era) -> case era of + AnyCardanoEra ConwayEra -> forkTheThread ConwayEraOnwardsConway connInfo + _ -> pure () + + where + setup :: IO (LocalNodeConnectInfo, AnyCardanoEra) + setup = do + proto <- startProtocol _nix_nodeConfigFile + + let + nodeConnInfo :: LocalNodeConnectInfo + nodeConnInfo = makeLocalConnectInfo (protocolToNetworkId proto) (File _nix_localNodeSocketPath) + + queryEraIO :: ChainTip -> IO AnyCardanoEra + queryEraIO tip = fromRightOrFail pure =<< runExceptT + (queryNodeLocalState nodeConnInfo (SpecificPoint $ chainTipToChainPoint tip) QueryCurrentEra) + + chainTip <- getLocalChainTip nodeConnInfo + (,) nodeConnInfo <$> queryEraIO chainTip + + forkTheThread :: () => ConwayEraOnwards era -> LocalNodeConnectInfo -> IO () + forkTheThread era nodeConnInfo = conwayEraOnwardsConstraints era $ do + let + sbe = conwayEraOnwardsToShelleyBasedEra era + query = QueryInEra $ QueryInShelleyBasedEra sbe QueryGovState + + threadBody = do + chainTip <- getLocalChainTip nodeConnInfo + govState <- fromRightOrFail pure =<< runExceptT + (queryNodeLocalState nodeConnInfo (SpecificPoint $ chainTipToChainPoint chainTip) query) + props <- fromRightOrFail (pure . LC.cgsProposals) govState + tStamp <- formatTime defaultTimeLocale timeStampFormat . systemToUTCTime <$> getSystemTime + BSL.writeFile (fileNameProposals tStamp) (prettyPrintOrdered props) + + void $ forkIO $ forever $ do + !_ <- threadBody `catch` \SomeException{} -> pure () + threadDelay 60_000_000 -- 1 minute + + -- an ExceptT for the masses + fromRightOrFail :: MonadFail m => (b -> m c) -> Either a b -> m c + fromRightOrFail cont = \case + Left{} -> fail "" + Right v -> cont v + + startProtocol Nothing = fail "" + startProtocol (Just cfgFile) = do + mkNodeConfig cfgFile >>= fromRightOrFail mkConsensusProtocol >>= fromRightOrFail pure + + timeStampFormat :: String + timeStampFormat = "%H-%M-%S" diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 7982d7d1213..01d7792f5f7 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -24,32 +24,24 @@ transactions as interchangeable, and focuses more on the variety of things one might do with the connexion. -} module Cardano.Benchmarking.Script.Types ( - Action(..) - , Generator(..) - , PayMode(PayToAddr, PayToScript) - , ProtocolParameterMode(..) - , ProtocolParametersSource(QueryLocalNode, UseLocalProtocolFile) - , ScriptBudget(AutoScript, StaticScriptBudget) - , ScriptSpec(..) - , SubmitMode(Benchmark, DiscardTX, DumpToFile, LocalSocket, - NodeToNode) - , TargetNodes - , TxList(..) + module Cardano.Benchmarking.Script.Types + ) where import Cardano.Api import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley -import Cardano.Benchmarking.OuroborosImports (SigningKeyFile) +import Cardano.Ledger.Conway.Governance (GovActionId) +import Cardano.Ledger.Core (EraCrypto) import Cardano.Node.Configuration.NodeAddress (NodeIPv4Address) import Cardano.TxGenerator.Setup.NixService (NodeDescription) +import Cardano.TxGenerator.Setup.SigningKey (SigningKeyFile) import Cardano.TxGenerator.Types -import Prelude - import Data.Function (on) import Data.List.NonEmpty +import Data.Ratio (Ratio) import Data.Text (Text) import GHC.Generics @@ -228,3 +220,15 @@ newtype TxList era = TxList [Tx era] data ProtocolParameterMode where ProtocolParameterQuery :: ProtocolParameterMode ProtocolParameterLocal :: ProtocolParameters -> ProtocolParameterMode + +data GovernanceActionIds where + GovernanceActionIds :: + forall era. () => ShelleyBasedEra era + -> [GovActionId (EraCrypto (ShelleyLedgerEra era))] + -> GovernanceActionIds + +data GovStateSummary = GovStateSummary + { govGovActionDeposit :: !L.Coin + , govDRepThresholdTreasuryWithdrawal :: !(Ratio Int) + , govProposals :: !GovernanceActionIds + } diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs index 81aa086797a..3082c76b668 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs @@ -25,11 +25,10 @@ import Cardano.Api import Cardano.Api.Shelley (ReferenceScript (..), fromShelleyPaymentCredential, fromShelleyStakeReference) -import Cardano.CLI.Types.Common (SigningKeyFile, VerificationKeyFile) import qualified Cardano.Ledger.Coin as L import Cardano.Ledger.Shelley.API (Addr (..), sgInitialFunds) import Cardano.TxGenerator.Fund -import Cardano.TxGenerator.Setup.SigningKey (readDRepKeyFile, readStakeKeyFile) +import Cardano.TxGenerator.Setup.SigningKey import Cardano.TxGenerator.Types import Cardano.TxGenerator.Utils import Ouroboros.Consensus.Shelley.Node (validateGenesis) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs index 5ed19e0f491..d12a8a8c232 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs @@ -13,12 +13,13 @@ module Cardano.TxGenerator.Setup.SigningKey , readStakeKeyFile , PaymentKey , SigningKey + , module CLI ) where import Cardano.Api -import Cardano.CLI.Types.Common (SigningKeyFile, VerificationKeyFile) +import Cardano.CLI.Types.Common as CLI (SigningKeyFile, VerificationKeyFile) import Cardano.TxGenerator.Types (TxGenError (..)) import Data.Bifunctor (first) diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 31d2dd94226..f2d9fe570b0 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -67,6 +67,7 @@ library Cardano.Benchmarking.Script.Aeson Cardano.Benchmarking.Script.Core Cardano.Benchmarking.Script.Env + Cardano.Benchmarking.Script.Queries Cardano.Benchmarking.Script.Selftest Cardano.Benchmarking.Script.Types Cardano.Benchmarking.TpsThrottle @@ -117,6 +118,7 @@ library , cardano-ledger-api , cardano-ledger-byron , cardano-ledger-core + , cardano-ledger-conway , cardano-node , cardano-prelude , contra-tracer From a29d6a9aa9a724d643c52c02e52b2ad83bd002d2 Mon Sep 17 00:00:00 2001 From: Nadia Yvette Chambers Date: Mon, 14 Oct 2024 13:21:17 +0000 Subject: [PATCH 8/9] add DefineDRepKey Action --- .../src/Cardano/Benchmarking/Script/Action.hs | 5 +++-- .../src/Cardano/Benchmarking/Script/Aeson.hs | 20 +++++++++++++++++++ .../src/Cardano/Benchmarking/Script/Core.hs | 7 +++++-- .../Cardano/Benchmarking/Script/Selftest.hs | 8 ++++---- .../src/Cardano/Benchmarking/Script/Types.hs | 4 ++++ 5 files changed, 36 insertions(+), 8 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs index 061aa7cc2d7..2ffa014351c 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs @@ -35,7 +35,7 @@ import qualified Data.Text as Text (unpack) -- the cases' fields to functions with very similar names to the -- constructors. action :: Action -> ActionM () -action a = case a of +action = \case SetNetworkId val -> setEnvNetworkId val SetSocketPath val -> setEnvSocketPath val InitWallet name -> initWallet name @@ -44,8 +44,9 @@ action a = case a of ReadSigningKey name filePath -> readSigningKey name filePath ReadDRepKeys filepath -> readDRepKeys filepath ReadStakeKeys filepath -> readStakeCredentials filepath + DefineDRepKey drepKey -> defineDRepCredential drepKey DefineSigningKey name descr -> defineSigningKey name descr - DefineStakeKey k -> defineStakeCrendential k + DefineStakeKey k -> defineStakeCredential k AddFund era wallet txIn lovelace keyName -> addFund era wallet txIn lovelace keyName Delay t -> delay t Submit era submitMode txParams generator -> submitAction era submitMode generator txParams diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs index eb778c72c0e..968b3c9cd0c 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs @@ -72,6 +72,26 @@ instance FromJSON (SigningKey PaymentKey) where Right k -> pure k Left err -> fail $ show err +-- FIXME: workaround instance +instance ToJSON (SigningKey DRepKey) where + toJSON = toJSON . serialiseToTextEnvelope Nothing +instance FromJSON (SigningKey DRepKey) where + parseJSON o = do + te <- parseJSON o + case deserialiseFromTextEnvelope (AsSigningKey AsDRepKey) te of + Right k -> pure k + Left err -> fail $ show err + +-- FIXME: workaround instance +instance ToJSON (VerificationKey DRepKey) where + toJSON = toJSON . serialiseToTextEnvelope Nothing +instance FromJSON (VerificationKey DRepKey) where + parseJSON o = do + te <- parseJSON o + case deserialiseFromTextEnvelope (AsVerificationKey AsDRepKey) te of + Right k -> pure k + Left err -> fail $ show err + -- FIXME: workaround instance instance ToJSON (VerificationKey StakeKey) where toJSON = toJSON . serialiseToTextEnvelope Nothing diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index e759d2b9f9f..d42c8870ce3 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -94,8 +94,11 @@ readSigningKey name filePath = defineSigningKey :: String -> SigningKey PaymentKey -> ActionM () defineSigningKey = setEnvKeys -defineStakeCrendential :: VerificationKey StakeKey -> ActionM () -defineStakeCrendential = setEnvStakeCredentials . (: []) . StakeCredentialByKey . verificationKeyHash +defineDRepCredential :: SigningKey DRepKey -> ActionM () +defineDRepCredential = setEnvDRepKeys . (: []) + +defineStakeCredential :: VerificationKey StakeKey -> ActionM () +defineStakeCredential = setEnvStakeCredentials . (: []) . StakeCredentialByKey . verificationKeyHash readDRepKeys :: FilePath -> ActionM () readDRepKeys ncFile = do diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index 0f5ebce6eef..37b61e9fb34 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -126,8 +126,8 @@ testScriptVoting protocolFile submitMode = , DefineStakeKey stakeKey - -- TODO: manually inject an (unnamed) DRep key into the Env by means of a new Action constructor - -- DefineDRepKey _drepKey + -- manually inject an (unnamed) DRep key into the Env by means of an Action constructor + , DefineDRepKey drepKey , Submit era submitMode txParams EmptyStream @@ -150,8 +150,8 @@ testScriptVoting protocolFile submitMode = , teRawCBOR = "X \vl1~\182\201v(\152\250A\202\157h0\ETX\248h\153\171\SI/m\186\242D\228\NAK\182(&\162" } - _drepKey :: SigningKey DRepKey - _drepKey = fromRight (error "could not parse hardcoded drep key") $ + drepKey :: SigningKey DRepKey + drepKey = error "could not parse hardcoded drep key" `fromRight` parseDRepKeyBase16 "5820aa7f780a2dcd099762ebc31a43860c1373970c2e2062fcd02cceefe682f39ed8" stakeKey :: VerificationKey StakeKey diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 01d7792f5f7..c8d7060fd71 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -93,6 +93,8 @@ data Action where ReadStakeKeys :: !FilePath -> Action -- | 'DefineSigningKey' is just a 'Map.insert' on the state variable. DefineSigningKey :: !String -> !(SigningKey PaymentKey) -> Action + -- | inject a singleton DRepCredential into the environment + DefineDRepKey :: !(SigningKey DRepKey) -> Action -- | inject a singleton StakeCredential into the environment DefineStakeKey :: !(VerificationKey StakeKey) -> Action -- | 'AddFund' is mostly a wrapper around @@ -131,6 +133,8 @@ data Action where deriving (Show, Eq) deriving instance Generic Action +deriving instance Eq (SigningKey DRepKey) + -- | 'Generator' is interpreted by -- 'Cardano.Bencmarking.Script.Core.evalGenerator' as a series of -- transactions, albeit in the form of precursors to UTxO's. From a7e33548df8e312e317bb8fef802fe09fcaf6b12 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Mon, 4 Nov 2024 10:43:15 +0100 Subject: [PATCH 9/9] fixup post-refactor --- bench/tx-generator/test/ApiTest.hs | 2 +- nix/workbench/profile/prof2-pparams.jq | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/bench/tx-generator/test/ApiTest.hs b/bench/tx-generator/test/ApiTest.hs index cc22e36d71f..5edb59392a1 100644 --- a/bench/tx-generator/test/ApiTest.hs +++ b/bench/tx-generator/test/ApiTest.hs @@ -95,7 +95,7 @@ main genesisValidate genesis sigKey :: SigningKey PaymentKey <- - hoistEither =<< handleIOExceptT IOError (readSigningKeyFile $ _nix_sigKey nixService) + hoistEither =<< handleIOExceptT IOError (readPaymentKeyFile $ _nix_sigKey nixService) pure (nixService, nc, genesis, sigKey) diff --git a/nix/workbench/profile/prof2-pparams.jq b/nix/workbench/profile/prof2-pparams.jq index 1d2efc00ebb..b068acd17b6 100644 --- a/nix/workbench/profile/prof2-pparams.jq +++ b/nix/workbench/profile/prof2-pparams.jq @@ -32,7 +32,6 @@ def overlays: , "v9-preview": v9preview::delta , "v10-preview": v10preview::delta , "blocksize64k": blocksizes::delta_64kblocks - , "voting": voting::delta_voting }; def pParamsWithOverlays(epoch; overlay_names):