From 73ff84ca08c08538b16212bcf7fa87681dcac6ca Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Wed, 25 Sep 2024 09:59:49 +0200 Subject: [PATCH 01/13] 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, 26 insertions(+), 3 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 f1cb530fda2..a99a6037a34 100644 --- a/nix/workbench/genesis/genesis.sh +++ b/nix/workbench/genesis/genesis.sh @@ -693,8 +693,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 70a6fa2029d..2542832c9ed 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: @@ -1478,6 +1486,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 23f3681c9ee..9fe79bcac97 100644 --- a/wb_profiles.mk +++ b/wb_profiles.mk @@ -1,5 +1,5 @@ PROFILES_EMPTY := fast-solo fast fast-p2p fast-oldtracing fast-notracer fast-plutus ci-test ci-test-rtview ci-test-notracer ci-test-p2p ci-test-plutus trace-bench trace-bench-rtview trace-bench-oldtracing trace-bench-notracer trace-full trace-full-rtview default default-p2p oldtracing plutus plutus-secp-ecdsa plutus-secp-schnorr epoch-transition -PROFILES_MINIATURE := ci-bench ci-bench-lmdb ci-bench-rtview ci-bench-p2p ci-bench-notracer ci-bench-drep ci-bench-plutus ci-bench-plutus24 ci-bench-plutus-secp-ecdsa ci-bench-plutus-secp-schnorr ci-bench-plutusv3-blst 10 10-p2p 10-notracer 10-plutus 6-dense 6-dense-rtsprof 6-dense-1h 6-dense-1h-rtsprof 6-dense-4h 6-dense-4h-rtsprof +PROFILES_MINIATURE := ci-bench ci-bench-lmdb ci-bench-rtview ci-bench-p2p ci-bench-notracer ci-bench-drep ci-bench-plutus ci-bench-plutus24 ci-bench-plutus-secp-ecdsa ci-bench-plutus-secp-schnorr ci-bench-plutusv3-blst 10 10-p2p 10-notracer 10-plutus 6-dense 6-dense-rtsprof 6-dense-1h 6-dense-1h-rtsprof 6-dense-4h 6-dense-4h-rtsprof development-voting PROFILES_FORGE_STRESS := forge-stress-solo-xs forge-stress-solo forge-stress-plutus-solo forge-stress-pre-solo-xs forge-stress-pre-solo forge-stress-pre-solo-xl forge-stress forge-stress-notracer forge-stress-p2p forge-stress-plutus forge-stress-pre forge-stress-pre-rtsA4m forge-stress-pre-rtsA64m forge-stress-pre-rtsN3 forge-stress-pre-rtsA4mN3 forge-stress-pre-rtsA64mN3 forge-stress-pre-rtsxn forge-stress-pre-notracer forge-stress-pre-plutus forge-stress-large PROFILES_PLUTUSCALL := plutuscall-loop-plain plutuscall-loop-half plutuscall-loop-double plutuscall-secp-ecdsa-plain plutuscall-secp-ecdsa-half plutuscall-secp-ecdsa-double plutuscall-secp-schnorr-plain plutuscall-secp-schnorr-half plutuscall-secp-schnorr-double PROFILES_MODEL := model-secp-ecdsa-double model-secp-ecdsa-half model-secp-ecdsa-plain model-value model-value-test From 75f7a71f3a9f323191e9fea72c8cf58569f91dd2 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Wed, 25 Sep 2024 18:46:11 +0200 Subject: [PATCH 02/13] 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 c1fbc0cd1ed..6d11d17ab66 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 @@ -159,7 +161,8 @@ library , yaml default-language: Haskell2010 - default-extensions: OverloadedStrings + default-extensions: LambdaCase + OverloadedStrings executable tx-generator import: project-config From b30b1fc28c619327d642dc35566fe00b338d6753 Mon Sep 17 00:00:00 2001 From: Nadia Yvette Chambers Date: Mon, 30 Sep 2024 04:25:44 +0000 Subject: [PATCH 03/13] 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 41b391ecb66..95104299a3b 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 08a21618e74..04bb63f1e06 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 TypeApplications #-} 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 6d11d17ab66..44e7978c177 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -161,7 +161,8 @@ library , yaml default-language: Haskell2010 - default-extensions: LambdaCase + default-extensions: BlockArguments + LambdaCase OverloadedStrings executable tx-generator From 0977551f651459c584e3ac5219a1c0fc4c0885ea Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Fri, 4 Oct 2024 12:44:59 +0000 Subject: [PATCH 04/13] wb | switch local voting profile to protocol version 10 --- .../protocol-parameters-conway-voting.json | 648 ++++++++++++++++++ nix/workbench/profile/pparams/delta-voting.jq | 8 + nix/workbench/profile/prof1-variants.jq | 7 +- nix/workbench/profile/prof2-pparams.jq | 2 + 4 files changed, 664 insertions(+), 1 deletion(-) create mode 100644 bench/tx-generator/data/protocol-parameters-conway-voting.json create mode 100644 nix/workbench/profile/pparams/delta-voting.jq 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/pparams/delta-voting.jq b/nix/workbench/profile/pparams/delta-voting.jq new file mode 100644 index 00000000000..89c94b860d4 --- /dev/null +++ b/nix/workbench/profile/pparams/delta-voting.jq @@ -0,0 +1,8 @@ +def delta_voting: +{ + shelley: { + "protocolVersion": { + "major": 10 + } + } +}; diff --git a/nix/workbench/profile/prof1-variants.jq b/nix/workbench/profile/prof1-variants.jq index 2542832c9ed..24403031ca9 100644 --- a/nix/workbench/profile/prof1-variants.jq +++ b/nix/workbench/profile/prof1-variants.jq @@ -564,6 +564,11 @@ def all_profile_variants: ({} | .genesis.pparamsEpoch = timeline::lastKnownEpoch ) as $genesis_voltaire + | + ($genesis_voltaire + | .genesis.pparamsOverlays as $ovls + | .genesis.pparamsOverlays = $ovls + ["voting"] + ) as $genesis_voltaire_10 ## ### Definition vocabulary: node + tracer config variants ## @@ -1487,7 +1492,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_10 * $dreps_small * { name: "development-voting" } diff --git a/nix/workbench/profile/prof2-pparams.jq b/nix/workbench/profile/prof2-pparams.jq index 03ff69b9163..b737bea8631 100644 --- a/nix/workbench/profile/prof2-pparams.jq +++ b/nix/workbench/profile/prof2-pparams.jq @@ -6,6 +6,7 @@ import "delta-blockbudget" as blockbudget; import "delta-blocksizes" as blocksizes; import "delta-v8-preview" as v8preview; import "delta-v9-preview" as v9preview; +import "delta-voting" as voting; def filterMapPParams(flt; map): timeline::epochs @@ -30,6 +31,7 @@ def overlays: , "v8-preview": v8preview::delta , "v9-preview": v9preview::delta , "blocksize64k": blocksizes::delta_64kblocks + , "voting": voting::delta_voting }; def pParamsWithOverlays(epoch; overlay_names): From 29c292b7ae0434c830bf01d585e1bb99e7af4053 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Tue, 8 Oct 2024 15:34:13 +0200 Subject: [PATCH 05/13] 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 95104299a3b..96173a525c7 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs @@ -70,7 +70,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 () @@ -81,7 +81,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 @@ -105,7 +105,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 () @@ -210,14 +210,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" @@ -229,13 +229,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 8918487b7c8f9c79b5fa117e5fca1858dfe5ce97 Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Wed, 16 Oct 2024 15:49:37 +0000 Subject: [PATCH 06/13] wb | lower gov action deposit --- nix/workbench/profile/pparams/delta-voting.jq | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/nix/workbench/profile/pparams/delta-voting.jq b/nix/workbench/profile/pparams/delta-voting.jq index 89c94b860d4..796f7d90ca6 100644 --- a/nix/workbench/profile/pparams/delta-voting.jq +++ b/nix/workbench/profile/pparams/delta-voting.jq @@ -1,8 +1,11 @@ def delta_voting: { - shelley: { + "shelley": { "protocolVersion": { "major": 10 } } +, "conway": { + "govActionDeposit": 100000 + } }; From d5cbff144e9d67a42faf504b42204d644251fc13 Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Mon, 7 Oct 2024 14:23:23 +0000 Subject: [PATCH 07/13] HACK: wb | run fixed-loaded until termination requested --- nix/workbench/scenario.sh | 6 +++--- nix/workbench/service/nodes.nix | 20 ++++++++++---------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/nix/workbench/scenario.sh b/nix/workbench/scenario.sh index d8572585b50..31fe43a8772 100644 --- a/nix/workbench/scenario.sh +++ b/nix/workbench/scenario.sh @@ -178,10 +178,10 @@ scenario_watcher() { if ! test -f "${run_dir}"/flag/cluster-stopping then echo >&2 - touch "${run_dir}"/flag/cluster-stopping +# touch "${run_dir}"/flag/cluster-stopping msg "scenario: $(yellow end of time reached) for: $(red $(jq '.meta.tag' -r ${__scenario_exit_trap_dir}/meta.json))" - msg "scenario: $(red signalled termination)" - progress "scenario" "now: $(yellow $(date))" + msg "scenario: $(red I DONT CARE, KEEP RUNNING ......)" +# progress "scenario" "now: $(yellow $(date))" fi } diff --git a/nix/workbench/service/nodes.nix b/nix/workbench/service/nodes.nix index 837727b7f3c..9098d72ff6b 100644 --- a/nix/workbench/service/nodes.nix +++ b/nix/workbench/service/nodes.nix @@ -117,16 +117,16 @@ let profile.node.verbatim); extraArgs = - [ "+RTS" "-scardano-node.gcstats" "-RTS" ] - ++ - optionals (nodeSpec.shutdown_on_block_synced != null) [ - "--shutdown-on-block-synced" - (toString nodeSpec.shutdown_on_block_synced) - ] ++ - optionals (nodeSpec.shutdown_on_slot_synced != null) [ - "--shutdown-on-slot-synced" - (toString nodeSpec.shutdown_on_slot_synced) - ]; + [ "+RTS" "-scardano-node.gcstats" "-RTS" ]; +# ++ +# optionals (nodeSpec.shutdown_on_block_synced != null) [ +# "--shutdown-on-block-synced" +# (toString nodeSpec.shutdown_on_block_synced) +# ] ++ +# optionals (nodeSpec.shutdown_on_slot_synced != null) [ +# "--shutdown-on-slot-synced" +# (toString nodeSpec.shutdown_on_slot_synced) +# ]; } // optionalAttrs (profiling != "none") { inherit profiling; } // optionalAttrs (profiling == "none") { From 08c7aceeb6481f7e4b10863b869ddbd06c03876c Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Mon, 7 Oct 2024 17:19:06 +0000 Subject: [PATCH 08/13] HACK: WIP: wb | separate funds for indepedent governance workload --- nix/workbench/genesis/genesis.jq | 2 +- nix/workbench/modules/genesis.nix | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/nix/workbench/genesis/genesis.jq b/nix/workbench/genesis/genesis.jq index 1c48f65406c..e593caf21bb 100644 --- a/nix/workbench/genesis/genesis.jq +++ b/nix/workbench/genesis/genesis.jq @@ -23,7 +23,7 @@ def profile_cli_args($p): , createTestnetDataArgs: ([ "--testnet-magic", $p.genesis.network_magic , "--total-supply", fmt_decimal_10_5($p.genesis.funds_balance + $p.derived.supply_delegated) - , "--utxo-keys", 1 + , "--utxo-keys", 2 , "--genesis-keys", $p.composition.n_bft_hosts , "--delegated-supply", fmt_decimal_10_5($p.derived.supply_delegated) , "--pools", $p.composition.n_pools diff --git a/nix/workbench/modules/genesis.nix b/nix/workbench/modules/genesis.nix index cc5d774336c..9f100978bc3 100644 --- a/nix/workbench/modules/genesis.nix +++ b/nix/workbench/modules/genesis.nix @@ -307,7 +307,7 @@ in create-testnet-data-args = concatStringsSep " " [ "--total-supply ${toString genesis.total_supply}" - "--utxo-keys 1" + "--utxo-keys 2" "--genesis-keys ${toString composition.n_bft_hosts}" "--delegated-supply ${toString derived.supply_delegated}" "--pools ${toString composition.n_pools}" From 60a1e8a1e3c4e188482321688badb1591d591383 Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Tue, 8 Oct 2024 02:09:36 +0000 Subject: [PATCH 09/13] HACK: WIP: wb | create constitution, withdrawals and keep voting yes --- nix/workbench/backend/nomad/exec.sh | 7 + nix/workbench/backend/supervisor.sh | 7 + .../genesis/guardrails-script.plutus | 5 + nix/workbench/service/generator.nix | 10 + nix/workbench/service/healthcheck.nix | 28 +- nix/workbench/service/voting.nix | 1063 +++++++++++++++++ 6 files changed, 1116 insertions(+), 4 deletions(-) create mode 100644 nix/workbench/genesis/guardrails-script.plutus create mode 100644 nix/workbench/service/voting.nix diff --git a/nix/workbench/backend/nomad/exec.sh b/nix/workbench/backend/nomad/exec.sh index 38a21875f9e..5c746903766 100644 --- a/nix/workbench/backend/nomad/exec.sh +++ b/nix/workbench/backend/nomad/exec.sh @@ -221,6 +221,13 @@ deploy-genesis-nomadexec() { msg "$(blue Reusing) already running local $(yellow "HTTP server")" fi msg "$(blue Creating) $(yellow "\"${nomad_job_name}.tar.zst\"") ..." +################################################################################ +################################################################################ +################################################################################ + cp /tmp/guardrails-script.plutus "$dir"/genesis/guardrails-script.plutus +################################################################################ +################################################################################ +################################################################################ if ! wb_nomad webfs add-genesis-dir "${dir}"/genesis "${nomad_job_name}" then if test "${nomad_agents_were_already_running}" = "false" diff --git a/nix/workbench/backend/supervisor.sh b/nix/workbench/backend/supervisor.sh index cdfe5bc049d..5f121ad822a 100755 --- a/nix/workbench/backend/supervisor.sh +++ b/nix/workbench/backend/supervisor.sh @@ -91,6 +91,13 @@ case "$op" in deploy-genesis ) local usage="USAGE: wb backend $op RUN-DIR" local dir=${1:?$usage}; shift +################################################################################ +################################################################################ +################################################################################ + cp /tmp/guardrails-script.plutus "${dir}"/genesis/guardrails-script.plutus +################################################################################ +################################################################################ +################################################################################ ;; describe-run ) diff --git a/nix/workbench/genesis/guardrails-script.plutus b/nix/workbench/genesis/guardrails-script.plutus new file mode 100644 index 00000000000..46ab9559eb6 --- /dev/null +++ b/nix/workbench/genesis/guardrails-script.plutus @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "*BE CAREFUL* that this is compiled from a release commit of plutus and not from master", + "cborHex": "5908545908510101003232323232323232323232323232323232323232323232323232323232323232323232323232323232259323255333573466e1d20000011180098111bab357426ae88d55cf00104554ccd5cd19b87480100044600422c6aae74004dd51aba1357446ae88d55cf1baa3255333573466e1d200a35573a002226ae84d5d11aab9e00111637546ae84d5d11aba235573c6ea800642b26006003149a2c8a4c301f801c0052000c00e0070018016006901e406cc00e003000c00d20d00fc000c0003003800a4005801c00e003002c00d20c09a0c80d9801c006001801a4101b5881380018000600700148013003801c006005801a410100078001801c006001801a4101001f8001800060070014801b0038018096007001800600690404002600060001801c0052008c00e006025801c006001801a41209d8001800060070014802b003801c006005801a410112f501b3003800c00300348202b7881300030000c00e00290066007003800c00b003482032ad7b806036403060070014803b00380180960003003800a4021801c00e003002c00d20f40380d9801c006001801a41403f800100a0c00e0029009600f0030078040c00e002900a600f003800c00b003301c483403e01a600700180060066038904801e00060001801c0052016c01e00600f801c006001801980ca402900e30000c00e002901060070030128060c00e00290116007003800c00b003483c0ba03660070018006006906432e00040283003800a40498003003800a404d802c00e00f003800c00b003301c480cb0003003800c003003301c4802b00030001801c01e0070018016006603890605c0160006007001800600660389048276000600030000c00e0029014600b003801c00c04b003800c00300348203a2489b00030001801c00e006025801c006001801a4101b11dc2df80018000c0003003800a4055802c00e007003012c00e003000c00d2080b8b872c000c0006007003801809600700180060069040607e4155016000600030000c00e00290166007003012c00e003000c00d2080c001c000c0003003800a405d801c00e003002c00d20c80180d9801c006001801a412007800100a0c00e00290186007003014c0006007001480cb0058018016006007801801e00600300403003800a4069802c00c00b003003c00c00f003803c00e003002c00c03f00333023480692028c0004014c00c007003002c00c00b003002c00e00f003800c00b00300f80590052008003003800a406d801c00e003002c00d2000c00d2006c00060070018006006900a600060001801c0052038c00e007001801600690006006901260003003800c003003483281300020141801c005203ac00e006029801c006001801a403d800180006007001480f3003801804e00700180060069040404af3c4e302600060001801c005203ec00e006013801c006001801a4101416f0fd20b80018000600700148103003801c006005801a403501b3003800c0030034812b00030000c00e0029021600f003800c00a01ac00e003000c00ccc08d20d00f4800b00030000c0000000000803c00c017003800c003003014c00c04b00018000803c00c013003800c00300301380498000803c00c00e004400e00f003800c00b00300bc000802180020070018006006021801808e00030004006005801804e0060158000800c00b00330154805200c400e00300080330004006005801a4001801a410112f58000801c00600901160008019807240118002007001800600690404a75ee01e00060008018026000801803e000300d48010c03520c80130074800a0030028048c011200a800c00b0034800b0000c01d2002300448050c0312008300b48000c029200630094804a00690006000300748008c0192066300a2233335573e00250002801994004d55ce800cd55cf0008d5d08014c00cd5d10011263009222532900389800a4d2219002912c80344c01526910c80148964cc04cdd68010034564cc03801400626601800e0071801226601800e01518010096400a3000910c008600444002600244004a664600200244246466004460044460040064600444600200646a660080080066a00600224446600644b20051800484ccc02600244666ae68cdc3801000c00200500a91199ab9a33710004003000801488ccd5cd19b89002001800400a44666ae68cdc4801000c00a00122333573466e20008006005000912a999ab9a3371200400222002220052255333573466e2400800444008440040026eb400a42660080026eb000a4264666015001229002914801c8954ccd5cd19b8700400211333573466e1c00c006001002118011229002914801c88cc044cdc100200099b82002003245200522900391199ab9a3371066e08010004cdc1001001c002004403245200522900391199ab9a3371266e08010004cdc1001001c00a00048a400a45200722333573466e20cdc100200099b820020038014000912c99807001000c40062004912c99807001000c400a2002001199919ab9a357466ae880048cc028dd69aba1003375a6ae84008d5d1000934000dd60010a40064666ae68d5d1800c0020052225933006003357420031330050023574400318010600a444aa666ae68cdc3a400000222c22aa666ae68cdc4000a4000226600666e05200000233702900000088994004cdc2001800ccdc20010008cc010008004c01088954ccd5cd19b87480000044400844cc00c004cdc300100091119803112c800c60012219002911919806912c800c4c02401a442b26600a004019130040018c008002590028c804c8888888800d1900991111111002a244b267201722222222008001000c600518000001112a999ab9a3370e004002230001155333573466e240080044600823002229002914801c88ccd5cd19b893370400800266e0800800e00100208c8c0040048c0088cc008008005" +} diff --git a/nix/workbench/service/generator.nix b/nix/workbench/service/generator.nix index 3f347c2a643..7e6812639e3 100644 --- a/nix/workbench/service/generator.nix +++ b/nix/workbench/service/generator.nix @@ -129,6 +129,16 @@ let value = '' #!${pkgs.stdenv.shell} + ############################### VOTING ############################### + ############################### VOTING ############################### + ############################### VOTING ############################### + ${import ./voting.nix {inherit pkgs profile nodeSpecs;}} + workflow_generator \ + ${if profile.composition.with_explorer then "explorer" else "node-0"} + ############################### VOTING ############################### + ############################### VOTING ############################### + ############################### VOTING ############################### + ${service.script} ''; JSON = pkgs.writeScript "startup-generator.sh" value; diff --git a/nix/workbench/service/healthcheck.nix b/nix/workbench/service/healthcheck.nix index 76a967f63e1..0ded928c612 100644 --- a/nix/workbench/service/healthcheck.nix +++ b/nix/workbench/service/healthcheck.nix @@ -53,12 +53,14 @@ let active_slots="$(${jq}/bin/jq --null-input -r \ "''${epoch_length} * ''${active_slots_coeff}" \ )" + with_explorer="$(${jq}/bin/jq .composition.with_explorer ../profile.json)" ${coreutils}/bin/echo "profile.json:" ${coreutils}/bin/echo "- network_magic: ''${network_magic}" ${coreutils}/bin/echo "- slot_duration: ''${slot_duration}" ${coreutils}/bin/echo "- epoch_length: ''${epoch_length}" ${coreutils}/bin/echo "- active_slots_coeff: ''${active_slots_coeff}" ${coreutils}/bin/echo "- active_slots: ''${active_slots}" + ${coreutils}/bin/echo "- with_explorer: ''${with_explorer}" # Fetch all defined node names (Including "explorer" nodes) ########################################################### @@ -191,9 +193,21 @@ let done else - # Seconds supervisor needs to consider the start successful - ${coreutils}/bin/sleep 5 - msg "Done, bye!" + # Producers only!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ############################# VOTING ############################# + ############################# VOTING ############################# + ############################# VOTING ############################# + # If running supervisord (local only), only one healthcheck is run + # for all nodes, so sending to background and sleeping forever + # fits all backends for all producers to vote simultaneously. + for node in ''${nodes[*]} # nodes array is only deployed nodes! + do + workflow_producer "''${node}" & + done + ${coreutils}/bin/sleep 80000 + ############################# VOTING ############################# + ############################# VOTING ############################# + ############################# VOTING ############################# fi } @@ -223,7 +237,7 @@ let # If the ping fails the whole script must fail! ${cardano-cli}/bin/cardano-cli ping \ --magic "''${network_magic}" \ - --count 3 \ + --count 1 \ --json \ --host "''${host}" \ --port "''${port}" @@ -935,6 +949,12 @@ let exit 22 } + ###################################################################### + # Conway/governance functions! ####################################### + ###################################################################### + + ${import ./voting.nix {inherit pkgs profile nodeSpecs;}} + if test -n "''${NOMAD_DEBUG:-}" then DEBUG_FILE="$(${coreutils}/bin/dirname "$(${coreutils}/bin/readlink -f "$0")")"/"$0".debug diff --git a/nix/workbench/service/voting.nix b/nix/workbench/service/voting.nix new file mode 100644 index 00000000000..2f99d8d00c8 --- /dev/null +++ b/nix/workbench/service/voting.nix @@ -0,0 +1,1063 @@ +{ pkgs +, profile +, nodeSpecs +}: + +let + + # Packages + ########## + bashInteractive = pkgs.bashInteractive; + coreutils = pkgs.coreutils; + jq = pkgs.jq; + cardano-cli = pkgs.cardanoNodePackages.cardano-cli; + + # Script params! + ################ + testnetMagic = profile.genesis.network_magic; + # Where to obtain the genesis funds from. + genesis_funds_vkey = "../genesis/cache-entry/utxo-keys/utxo2.vkey"; + genesis_funds_skey = "../genesis/cache-entry/utxo-keys/utxo2.skey"; + # How many constitutions to create with the genesis funds. + constitutions_from_genesis = 1; + # Initial donation from genesis funds to make "valid" withdrawal proposals. + treasury_donation = 500000; + # Construct an "array" with node producers to use in BASH `for` loops. + producers_array = + "(" + + (builtins.concatStringsSep + " " + (builtins.map + (x: "\"" + x.name + "\"") + (builtins.filter + (nodeSpec: nodeSpec.isProducer) + (pkgs.lib.mapAttrsToList + (nodeName: nodeSpec: {inherit (nodeSpec) name isProducer;}) + nodeSpecs + ) + ) + ) + ) + + ")" + ; + # When splitting the genesis funds, we first move to a "node address" (called + # DRep 0) for each producer, and then to a "node-drep address" for each + # node-drep combination. + dreps_per_producer = builtins.floor ( + profile.genesis.dreps + / (builtins.length + (builtins.filter + (nodeSpec: nodeSpec.isProducer) + (builtins.attrValues nodeSpecs) + ) + ) + ); + # Max number of '--tx-out' when splitting funds. + # DUCT TAPE: Split 10000 DReps to 52 nodes in 1 TX per node. + # Signed tx file is 16337 bytes of a tx maximum of 16384 bytes!!! + outs_per_transaction = 193; + # To calculate how much funds to leave on nodes' addresses (DRep 0) for the + # node to create withdrawal proposals (`--governance-action-deposit` arg). + withdrawal_proposals_per_node = 2; + # Sleeps. + wait_any_utxo_tries = 12; + wait_any_utxo_sleep = 10; # 2 minutes in 10s steps. + wait_utxo_id_tries = 24; + wait_utxo_id_sleep = 10; # 4 minutes in 10s steps. + wait_proposal_id_tries = 12; + wait_proposal_id_sleep = 10; # 2 minutes + +in '' + +################################################################################ +# Given a tx.signed return TxHash#TxIx of the FIRST occurrence of an address in +# its "outputs". If NO ADDRESS IS SUPPLIED as argument to this function we +# use/assume the last output is the change address (--change-address) and you +# want to use that one to calculate a future expected UTxO. +# Returns UTxO formatted to use in "--tx-in" arguments. +# Fails if the address in the function argument was not present. +################################################################################ +function calculate_next_utxo { + + # Function arguments. + local tx_signed=$1 + local addr=''${2:-null} + + local tx_id tx_ix + # Prints a transaction identifier. + tx_id="$( \ + ${cardano-cli}/bin/cardano-cli conway transaction txid \ + --tx-file "''${tx_signed}" \ + )" + # Format transaction view output to JSON and get FIRST index of "$addr". + tx_ix="$( \ + ${cardano-cli}/bin/cardano-cli debug transaction view \ + --output-json \ + --tx-file "''${tx_signed}" \ + | \ + ${jq}/bin/jq -r \ + --argjson addr "\"''${addr}\"" \ + ' + if $addr == null + then + (.outputs | length - 1) + else + ( + .outputs + | map(.address == $addr) + | index(true) + ) + end + ' \ + )" + + if test "''${tx_ix}" = "null" + then + # Fail + ${coreutils}/bin/echo "calculate_next_utxo: ''${tx_signed} - ''${addr}" + exit 1 + else + ${coreutils}/bin/echo "''${tx_id}#''${tx_ix}" + fi +} + +################################################################################ +# Get the first UTxO available (Must be non-empty or it fails!) +################################################################################ +function get_address_utxo_0 { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local addr=$2 + + # Only defined in functions that use it. + local socket_path="../''${node_str}/node.socket" + + ${cardano-cli}/bin/cardano-cli query utxo \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --address "''${addr}" \ + --output-json \ + | ${jq}/bin/jq -r 'keys[0]' +} + +################################################################################ +# Get pre-calculated "cached" future UTxO or nothing (an "empty" string). +################################################################################ +function get_address_utxo_expected { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local addr=$2 + + local utxo_file=../"''${node_str}"/"''${addr}".utxo + if test -f "''${utxo_file}" + then + ${coreutils}/bin/cat "''${utxo_file}" + fi +} + +################################################################################ +# Must be called by UTxO consumers. +# Returns the node's socket path and creates a lock. +################################################################################ +function get_socket_lock { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + + local socket_path="../''${node_str}/node.socket" + local lockfile_path="''${socket_path}".lock + + exec 200>"''${lockfile_path}" + flock 200 + ${coreutils}/bin/echo "''${socket_path}" +} + +################################################################################ +# Release the socket and cache the next, expected, UTxO. +################################################################################ +function release_socket_lock { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local tx_signed=$2 + local addr=$3 # Mandatory argument to store the tx_id in a file! + + local socket_path="../''${node_str}/node.socket" + local lockfile_path="''${socket_path}".lock + + # Store address next UTxO + calculate_next_utxo \ + "''${tx_signed}" \ + "''${addr}" \ + > ../"''${node_str}"/"''${addr}".utxo + + # A mystery! + flock -u 200 2>/dev/null || true + exec 200>&- +} + +################################################################################ +# Evenly split the first UTxO of this key to the addresses in the array! +# Does it in batchs so we don't exceed "maxTxSize" of 16384. +# Stores the future UTxO in a file for later references. +# Not to be run during the benchmarking phase: waits for funds between batchs! +################################################################################ +function funds_from_to { + + # Function arguments. + local node_str=''${1}; shift # node name / folder to find the socket. + local utxo_vkey=''${1}; shift # In + local utxo_skey=''${1}; shift # In + local reminder=''${1}; shift # Funds to keep in the origin address. + local donation=''${1}; shift # To treasury. + local addrs_array=("$@") # Outs + + # Only defined in functions that use it. + local socket_path + # Lock needed. Creates or destroys UTxOs. + socket_path="$(get_socket_lock "''${node_str}")" + + # Get the "in" address and its first UTxO only once we have the lock. + local funds_addr + funds_addr="$( \ + ${cardano-cli}/bin/cardano-cli address build \ + --testnet-magic ${toString testnetMagic} \ + --payment-verification-key-file "''${utxo_vkey}" \ + )" + # This three only needed for the first batch and to calculate funds per node. + local funds_json funds_tx funds_lovelace + funds_json="$( \ + ${cardano-cli}/bin/cardano-cli query utxo \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --address "''${funds_addr}" \ + --output-json \ + )" + funds_tx="$( \ + ${coreutils}/bin/echo "''${funds_json}" \ + | ${jq}/bin/jq -r \ + 'keys[0]' \ + )" + funds_lovelace="$( \ + ${coreutils}/bin/echo "''${funds_json}" \ + | ${jq}/bin/jq -r \ + --arg keyName "''${funds_tx}" \ + '.[$keyName].value.lovelace' \ + )" + + # Calculate how much lovelace for each output address. + local outs_count per_out_lovelace + outs_count="''${#addrs_array[@]}" + ### HACK: Fees! Always using 300000!!! + ### With 2 outputs: "Estimated transaction fee: 172233 Lovelace" + ### With 10 outputs: "Estimated transaction fee: 186665 Lovelace" + ### With 53 outputs: "Estimated transaction fee: 264281 Lovelace" + ### With 150 outputs: "Estimated transaction fee: 439357 Lovelace" + ### With 193 outputs: "Estimated transaction fee: 516929 Lovelace" + per_out_lovelace="$( \ + ${jq}/bin/jq -r --null-input \ + --argjson numerator "''${funds_lovelace}" \ + --argjson denominator "''${outs_count}" \ + --argjson reminder "''${reminder}" \ + --argjson donation "''${donation}" \ + '( + ( $numerator + - $reminder + - $donation + - (500000 * $denominator / ${toString outs_per_transaction} | ceil) + ) + / $denominator + | round + )' \ + )" + + # Split the funds in batchs (donations only happen in the first batch). + local i=0 + local txOuts_array=() + local batch=${toString outs_per_transaction} + local tx_in treasury_donation + for addr in "''${addrs_array[@]}" + do + i="$((i + 1))" + # Build the "--tx-out" arguments array of this batch. + txOuts_array+=("--tx-out") + txOuts_array+=("''${addr}+''${per_out_lovelace}") + # We send if last addr in the for loop or batch max exceeded. + if test "$i" -ge "''${#addrs_array[@]}" || test "$i" -ge "$batch" + then + if test "$batch" -eq ${toString outs_per_transaction} + then + # First transaction. + # The input comes from the function arguments. + tx_in="''${funds_tx}" + # Treasury donation happens only once. + treasury_donation="''${donation}" + else + # Not the first batch. + # The input comes from the last transaction submitted. Wait for it!!! + tx_in="$(get_address_utxo_expected "''${node_str}" "''${funds_addr}")" + ${coreutils}/bin/echo "funds_from_to: Wait for funds: $(${coreutils}/bin/date --rfc-3339=seconds)" + wait_utxo_id "''${node_str}" "''${funds_addr}" "''${tx_in}" + ${coreutils}/bin/echo "funds_from_to: Funds available: $(${coreutils}/bin/date --rfc-3339=seconds)" + # Treasury donation happens only once. + treasury_donation=0 + fi + # Some debugging! + ${coreutils}/bin/echo "funds_from_to: ''${utxo_vkey} (''${funds_addr}): --tx-in ''${tx_in} ''${txOuts_array[*]}" + # Send this batch to each node! + # Build transaction. + local tx_filename=../"''${node_str}"/tx."''${tx_in}" + ${cardano-cli}/bin/cardano-cli conway transaction build \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --tx-in "''${tx_in}" \ + ''${txOuts_array[@]} \ + --treasury-donation "''${treasury_donation}" \ + --change-address "''${funds_addr}" \ + --out-file "''${tx_filename}.raw" + # Sign transaction. + ${cardano-cli}/bin/cardano-cli conway transaction sign \ + --testnet-magic ${toString testnetMagic} \ + --signing-key-file "''${utxo_skey}" \ + --tx-body-file "''${tx_filename}.raw" \ + --out-file "''${tx_filename}.signed" + # Submit transaction. + ${cardano-cli}/bin/cardano-cli conway transaction submit \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --tx-file "''${tx_filename}.signed" + # Store address next UTxO. + # Without this we can't properly wait for the funds! + calculate_next_utxo \ + "''${tx_filename}.signed" \ + "''${funds_addr}" \ + > ../"''${node_str}"/"''${funds_addr}".utxo + # Reset variables for next batch iteration. + txOuts_array=() + batch="$((batch + ${toString outs_per_transaction}))" + fi + done + + # All the waiting / batchs above do not release the lock. + # The next, expected, UTxO is stored again by this function! + release_socket_lock \ + "''${node_str}" \ + "''${tx_filename}.signed" \ + "''${funds_addr}" +} + +################################################################################ +# Waits until the UTxOs of this address are not empty (errors on timeout). +################################################################################ +function wait_any_utxo { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local addr=$2 + + # Only defined in functions that use it. + local socket_path="../''${node_str}/node.socket" + + local tries=${toString wait_any_utxo_tries} + local utxos_json="{}" + while test "''${utxos_json}" = "{}" + do + if test "''${tries}" -le 0 + then + # Time's up! + ${coreutils}/bin/echo "wait_any_utxo: Timeout waiting for: ''${addr}" + exit 1 + fi + utxos_json="$( \ + ${cardano-cli}/bin/cardano-cli query utxo \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --address "''${addr}" \ + --output-json \ + )" + if ! test "''${tries}" = ${toString wait_any_utxo_tries} + then + ${coreutils}/bin/sleep ${toString wait_any_utxo_sleep} + fi + tries="$((tries - 1))" + done + + # Return first tx_id from the "cached" response (not get_address_utxo_0!). + ${coreutils}/bin/echo "''${utxos_json}" \ + | ${jq}/bin/jq -r \ + 'keys[0]' +} + +################################################################################ +# Waits until an specific UTxO of this address appears (errors on timeout). +################################################################################ +function wait_utxo_id { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local addr=$2 + local utxo_id=$3 + + # Only defined in functions that use it. + local socket_path="../''${node_str}/node.socket" + + local contains_addr="false" + local tries=${toString wait_utxo_id_tries} + while test "''${contains_addr}" = "false" + do + if test "''${tries}" -le 0 + then + # Time's up! + ${coreutils}/bin/echo "wait_utxo_id: Timeout waiting for: ''${addr} - ''${utxo_id}" + exit 1 + else + local utxos_json + utxos_json="$( \ + ${cardano-cli}/bin/cardano-cli query utxo \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --address "''${addr}" \ + --output-json \ + )" + contains_addr="$( \ + ${coreutils}/bin/echo "''${utxos_json}" \ + | ${jq}/bin/jq --raw-output \ + --argjson utxo_id "\"''${utxo_id}\"" \ + 'keys | any(. == $utxo_id) // false' \ + )" + if ! test "''${tries}" = ${toString wait_utxo_id_tries} + then + ${coreutils}/bin/sleep ${toString wait_utxo_id_sleep} + fi + tries="$((tries - 1))" + fi + done + + # Return the expected UTxO ID to be able to easily check the response. + ${coreutils}/bin/echo "''${utxo_id}" +} + +################################################################################ +# Waits until an specific proposal appears and returns its "txId" or fails. +################################################################################ +function wait_proposal_id { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local tx_signed=$2 + + # Only defined in functions that use it. + local socket_path="../''${node_str}/node.socket" + + # Get proposal's "txId" from the "--tx-file". + local tx_id + tx_id="$( \ + ${cardano-cli}/bin/cardano-cli conway transaction txid \ + --tx-file "''${tx_signed}" \ + )" + + local contains_proposal="false" + local tries=${toString wait_proposal_id_tries} + while test "''${contains_proposal}" = "false" + do + if test "''${tries}" -le 0 + then + # Time's up! + ${coreutils}/bin/echo "wait_proposal_id: Timeout waiting for: ''${tx_id}" + exit 1 + else + local proposals_json + # No "--output-json" needed. + proposals_json="$( \ + ${cardano-cli}/bin/cardano-cli conway query gov-state \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + )" + contains_proposal="$( \ + ${coreutils}/bin/echo "''${proposals_json}" \ + | ${jq}/bin/jq --raw-output \ + --argjson tx_id "\"''${tx_id}\"" \ + '.proposals | any(.actionId.txId == $tx_id) // false' \ + )" + if ! test "''${tries}" = ${toString wait_proposal_id_tries} + then + ${coreutils}/bin/sleep ${toString wait_proposal_id_sleep} + fi + tries="$((tries - 1))" + fi + done + + # Returns the proposal ID. + ${coreutils}/bin/echo "''${tx_id}" +} + +################################################################################ +# Hack: Given a node "i" and a DRep number create always the same address keys. +# Only supports up to 99 nodes and 999999 DReps by adding the missing Hex chars. +# Returns the file path without the extensions (the ".skey" or ".vkey" part). +################################################################################ +function create_node_drep_keys { + + # Function arguments. + local node_str=$1 # String for the key file name (not for the socket). + local node_i=$2 # This "i" is part of the node name ("node-i"). + local drep_i=$3 + + local filename=../"''${node_str}"-drep-"''${drep_i}" + # Now with the extensions. + local skey="''${filename}".skey + local vkey="''${filename}".vkey + + # Only create if not already there! + if ! test -f "''${vkey}" + then + ${jq}/bin/jq --null-input \ + --argjson node_i "''${node_i}" \ + --argjson drep_i "''${drep_i}" \ + ' + {"type": "PaymentSigningKeyShelley_ed25519", + "description": "Payment Signing Key", + "cborHex": ( + "5820b02868d722df021278c78be3b7363759b37f5852b8747b488bab20c3" + + (if $node_i <= 9 + then ("0" + ($node_i | tostring)) + elif $node_i >= 10 and $node_i <= 99 + then ( $node_i | tostring) + else (error ("Node ID above 99")) + end + ) + + (if $drep_i <= 9 + then ( "00000" + ($drep_i | tostring)) + elif $drep_i >= 10 and $drep_i <= 99 + then ( "0000" + ($drep_i | tostring)) + elif $drep_i >= 100 and $drep_i <= 999 + then ( "000" + ($drep_i | tostring)) + elif $drep_i >= 1000 and $drep_i <= 9999 + then ( "00" + ($drep_i | tostring)) + elif $drep_i >= 10000 and $drep_i <= 99999 + then ( "0" + ($drep_i | tostring)) + elif $drep_i >= 100000 and $drep_i <= 999999 + then ( ($drep_i | tostring)) + else (error ("DRep ID above 999999")) + end + ) + ) + } + ' \ + > "''${skey}" + ${cardano-cli}/bin/cardano-cli conway key verification-key \ + --signing-key-file "''${skey}" \ + --verification-key-file "''${vkey}" + fi + ${coreutils}/bin/echo "''${filename}" +} + +################################################################################ +# Get address of the node-drep combination! +################################################################################ +function build_node_drep_address { + + # Function arguments. + local node_str=$1 # String for the key file name (not for the socket). + local node_i=$2 # This "i" is part of the node name ("node-i"). + local drep_i=$3 + + local filename addr + filename="$(create_node_drep_keys "''${node_str}" "''${node_i}" "''${drep_i}")" + addr="''${filename}.addr" + # Only create if not already there! + if ! test -f "''${addr}" + then + local vkey="''${filename}".vkey + ${cardano-cli}/bin/cardano-cli address build \ + --testnet-magic ${toString testnetMagic} \ + --payment-verification-key-file "''${vkey}" \ + > "''${addr}" + fi + ${coreutils}/bin/cat "''${addr}" +} + +################################################################################ +# Deposit needed to create a proposal (`--governance-action-deposit` argument). +################################################################################ +function get_gov_action_deposit { + + local node_str=$1 # node name / folder to find the socket. + + # Only defined in functions that use it. + local socket_path="../''${node_str}/node.socket" + + ${cardano-cli}/bin/cardano-cli conway query gov-state \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + | ${jq}/bin/jq -r '.currentPParams.govActionDeposit' +} + +################################################################################ +# Evenly distribute the "utxo_*key" genesis funds to all producer nodes. +# Splits all funds evenly to all producer-assigned addresses so then you can +# call function `governance_funds_producer_dreps` to split funds into the DReps +# each producer controls. +# Not to be run during the benchmarking phase: waits for funds to arrive! +################################################################################ +function governance_funds_producers { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local utxo_vkey=$2 + local utxo_skey=$3 + local producers=${toString producers_array} + + # Send funds to each node (using DRep ID 0 as a special logical separation). + ${coreutils}/bin/echo "governance_funds_producers: Node(s) splitting phase!" + + local action_deposit constitution_reminder + action_deposit="$(get_gov_action_deposit "''${node_str}")" + # HACK: Plus a fee estimate ("Estimated transaction fee: 172585 Lovelace"). + # Plus "Minimum UTxO threshold: 105986 Lovelace" + constitution_reminder="$(( (action_deposit + 2000000) * ${toString constitutions_from_genesis} + 200000 ))" + + local producers_addrs_array=() + for producer_name in ''${producers[*]} + do + local producer_i + producer_i="$( \ + ${jq}/bin/jq --raw-output \ + --arg keyName "''${producer_name}" \ + '.[$keyName].i' \ + ../node-specs.json \ + )" + local producer_addr + # Drep 0 is No DRep (funds for the node). + producer_addr="$(build_node_drep_address "''${producer_name}" "''${producer_i}" 0)" + producers_addrs_array+=("''${producer_addr}") + ${coreutils}/bin/echo "governance_funds_producers: Splitting to: ''${producer_name} - ''${producer_i} - 0 - ''${producer_addr}" + done + + # Split! + funds_from_to \ + "''${node_str}" \ + "''${utxo_vkey}" "''${utxo_skey}" \ + "''${constitution_reminder}" \ + ${toString treasury_donation} \ + "''${producers_addrs_array[@]}" + + # Wait for the funds of the last producer to arrive. + wait_any_utxo "''${node_str}" "''${producers_addrs_array[-1]}" +} + +################################################################################ +# Evenly distribute producer funds to all producer-assigned DReps. +# First send all funds evenly to all producer-assigned addresses using function +# `governance_funds_producers` and later call this function to do the same with +# the addresses assigned to each producers' DRep. +# (TODO in as many UTxO as the times it intends to vote ???). +# Not to be run during the benchmarking phase: waits for funds to arrive! +################################################################################ +function governance_funds_producer_dreps { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local producer_name=$2 + + # Send funds to each node's assigned DReps (DReps N to ???). + ${coreutils}/bin/echo "governance_funds_producer_dreps: Node(s)-DRep(s) splitting phase!" + + local action_deposit proposals_reminder + action_deposit="$(get_gov_action_deposit "''${node_str}")" + # HACK: Plus a fee estimate ("Estimated transaction fee: 374457 Lovelace"). + # Plus "Minimum UTxO threshold: 105986 Lovelace" + proposals_reminder="$(( (action_deposit + 4000000) * ${toString withdrawal_proposals_per_node} + 200000 ))" + + local producer_i + producer_i="$( \ + ${jq}/bin/jq --raw-output \ + --arg keyName "''${producer_name}" \ + '.[$keyName].i' \ + ../node-specs.json \ + )" + local producer_addr producer_vkey producer_skey + producer_addr="$(build_node_drep_address "''${producer_name}" "''${producer_i}" 0)" + producer_vkey="$(create_node_drep_keys "''${producer_name}" "''${producer_i}" 0)".vkey + producer_skey="$(create_node_drep_keys "''${producer_name}" "''${producer_i}" 0)".skey + + # Wait for initial funds to arrive! + ${coreutils}/bin/echo "governance_funds_producer_dreps: Wait for funds: $(${coreutils}/bin/date --rfc-3339=seconds)" + wait_any_utxo "''${node_str}" "''${producer_addr}" >/dev/null + ${coreutils}/bin/echo "governance_funds_producer_dreps: Funds available: $(${coreutils}/bin/date --rfc-3339=seconds)" + + local producer_dreps_addrs_array=() + local drep_step=0 + drep_step="$((producer_i * ${toString dreps_per_producer}))" + local actual_drep + for i in {1..${toString dreps_per_producer}} + do + local producer_drep_addr + actual_drep="$((drep_step + i))" + producer_drep_addr="$(build_node_drep_address "''${producer_name}" "''${producer_i}" "''${actual_drep}")" + producer_dreps_addrs_array+=("''${producer_drep_addr}") + ${coreutils}/bin/echo "governance_funds_producer_dreps: Splitting to: ''${producer_name} - ''${producer_i} - ''${actual_drep} - ''${producer_drep_addr}" + done + + # Split! + funds_from_to \ + "''${node_str}" \ + "''${producer_vkey}" "''${producer_skey}" \ + "''${proposals_reminder}" \ + 0 \ + "''${producer_dreps_addrs_array[@]}" + + # Wait for the funds of the last producer-drep to arrive. + wait_any_utxo "''${node_str}" "''${producer_dreps_addrs_array[-1]}" +} + +################################################################################ +# Create constitution proposal and wait for it in the `gov-state` query. +# Not to be run during the benchmarking phase: Waits for the expected UTxO and +# if timeout uses the first one available. +# Not to be run during the benchmarking phase: waits for proposal to appear! +################################################################################ +function governance_create_constitution { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local utxo_vkey=$2 + local utxo_skey=$3 + + ${coreutils}/bin/echo "governance_create_constitution: ''${node_str} - ''${utxo_vkey}" + + # Only defined in functions that use it. + local socket_path + # Lock needed. Creates or destroys UTxOs. + socket_path="$(get_socket_lock "''${node_str}")" + + local node_addr + node_addr="$( \ + ${cardano-cli}/bin/cardano-cli address build \ + --testnet-magic ${toString testnetMagic} \ + --payment-verification-key-file "''${utxo_vkey}" + )" + + # Funds needed for this governance action ? + local action_deposit + action_deposit="$(get_gov_action_deposit "''${node_str}")" + # Funds address. + # The input is calculated from the last transaction submitted. + # No waiting! But, if last submitted transaction fails (function + # `governance_funds_producers` in current workflow), everything else fails. + local funds_tx + funds_tx="$(get_address_utxo_expected "''${node_str}" "''${node_addr}")" + + # Show current gov-state. + ${cardano-cli}/bin/cardano-cli conway query gov-state \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + | ${jq}/bin/jq -r \ + '.nextRatifyState.nextEnactState.prevGovActionIds' + + # Create dummy constitution. + ${coreutils}/bin/echo "My Constitution: free mate and asado" \ + > ../"''${node_str}"/constitution.txt + # Calculate constitution hash. + ${cardano-cli}/bin/cardano-cli hash anchor-data \ + --file-text ../"''${node_str}"/constitution.txt \ + --out-file ../"''${node_str}"/constitution.hash + # Copy guardrails-script. + ${coreutils}/bin/cp \ + ../genesis/guardrails-script.plutus \ + ../"''${node_str}"/guardrails-script.plutus + # Calculate guardrails-script hash. + ${cardano-cli}/bin/cardano-cli hash script \ + --script-file ../"''${node_str}"/guardrails-script.plutus \ + --out-file ../"''${node_str}"/guardrails-script.hash + + # Create action. + local tx_filename=../"''${node_str}"/create-constitution + ${cardano-cli}/bin/cardano-cli conway governance action create-constitution \ + --testnet \ + --anchor-url "https://raw.githubusercontent.com/cardano-foundation/CIPs/master/CIP-0100/cip-0100.common.schema.json" \ + --anchor-data-hash "9d99fbca260b2d77e6d3012204e1a8658f872637ae94cdb1d8a53f4369400aa9" \ + --constitution-url "https://ipfs.io/ipfs/Qmdo2J5vkGKVu2ur43PuTrM7FdaeyfeFav8fhovT6C2tto" \ + --constitution-hash "$(${coreutils}/bin/cat ../"''${node_str}"/constitution.hash)" \ + --constitution-script-hash "$(${coreutils}/bin/cat ../"''${node_str}"/guardrails-script.hash)" \ + --governance-action-deposit "''${action_deposit}" \ + --deposit-return-stake-verification-key-file ../genesis/pools/staking-reward1.vkey \ + --out-file "''${tx_filename}".action + # Build transaction. + ${cardano-cli}/bin/cardano-cli conway transaction build \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --tx-in "''${funds_tx}" \ + --change-address "''${node_addr}" \ + --proposal-file "''${tx_filename}".action \ + --out-file "''${tx_filename}".raw \ + > /dev/null + # Sign transaction. + ${cardano-cli}/bin/cardano-cli conway transaction sign \ + --testnet-magic ${toString testnetMagic} \ + --signing-key-file "''${utxo_skey}" \ + --tx-body-file "''${tx_filename}".raw \ + --out-file "''${tx_filename}".signed + # Submit transaction. + ${cardano-cli}/bin/cardano-cli conway transaction submit \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --tx-file "''${tx_filename}".signed \ + > /dev/null + + # Wait for the proposal without releasing the local socket. + wait_proposal_id "''${node_str}" "''${tx_filename}".signed + + release_socket_lock \ + "''${node_str}" \ + "''${tx_filename}.signed" \ + "''${node_addr}" +} + +################################################################################ +# Create withdrawal proposal and wait for it in the `gov-state` query. +# Not to be run during the benchmarking phase: Waits for the expected UTxO and +# if timeout uses the first one available. +# Not to be run during the benchmarking phase: waits for proposal to appear! +################################################################################ +function governance_create_withdrawal { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local node_i=$2 + local drep_i=$3 + + ${coreutils}/bin/echo "governance_create_withdrawal: ''${node_str} - ''${drep_i}" + + # Only defined in functions that use it. + local socket_path + # Lock needed. Creates or destroys UTxOs. + socket_path="$(get_socket_lock "''${node_str}")" + + local node_drep_skey node_drep_addr + node_drep_skey="$(create_node_drep_keys "''${node_str}" "''${node_i}" "''${drep_i}")".skey + node_drep_addr="$(build_node_drep_address "''${node_str}" "''${node_i}" "''${drep_i}")" + + # Funds needed for this governance action ? + local action_deposit + action_deposit="$(get_gov_action_deposit "''${node_str}")" + # Funds address. + # The input is calculated from the last transaction submitted. + # No waiting! But, if last submitted transaction fails (function + # `governance_funds_producer_dreps` current workflow), everything else fails. + local funds_tx + funds_tx="$(get_address_utxo_expected "''${node_str}" "''${node_drep_addr}")" + + local tx_filename=../"''${node_str}"/create-withdrawal."''${node_str}"."''${drep_i}" + # Create action. + ${cardano-cli}/bin/cardano-cli conway governance action create-treasury-withdrawal \ + --testnet \ + --anchor-url "https://raw.githubusercontent.com/cardano-foundation/CIPs/master/CIP-0108/examples/treasury-withdrawal.jsonld" \ + --anchor-data-hash "311b148ca792007a3b1fee75a8698165911e306c3bc2afef6cf0145ecc7d03d4" \ + --governance-action-deposit "''${action_deposit}" \ + --transfer 50 \ + --deposit-return-stake-verification-key-file ../genesis/pools/staking-reward1.vkey \ + --funds-receiving-stake-verification-key-file ../genesis/pools/staking-reward2.vkey \ + --out-file "''${tx_filename}".action + # Build transaction. + ${cardano-cli}/bin/cardano-cli conway transaction build \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --tx-in "''${funds_tx}" \ + --change-address "''${node_drep_addr}" \ + --proposal-file "''${tx_filename}".action \ + --out-file "''${tx_filename}".raw \ + > /dev/null + # Sign transaction. + ${cardano-cli}/bin/cardano-cli conway transaction sign \ + --testnet-magic ${toString testnetMagic} \ + --signing-key-file "''${node_drep_skey}" \ + --tx-body-file "''${tx_filename}".raw \ + --out-file "''${tx_filename}".signed + # Submit transaction. + ${cardano-cli}/bin/cardano-cli conway transaction submit \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --tx-file "''${tx_filename}".signed \ + > /dev/null + + # Wait for the proposal without releasing the local socket. + wait_proposal_id "''${node_str}" "''${tx_filename}".signed + + release_socket_lock \ + "''${node_str}" \ + "''${tx_filename}.signed" \ + "''${node_drep_addr}" +} + +################################################################################ +function governance_vote_proposal { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local node_i=$2 + local proposal_id=$3 + + # Only defined in functions that use it. + local socket_path + + local drep_step actual_drep + drep_step=$((node_i * ${toString dreps_per_producer})) + for i in {1..${toString dreps_per_producer}} # for drepDir in ../genesis/cache-entry/drep-keys/drep* + do + actual_drep="$((drep_step + i))" + + local proposal_flag="../''${node_str}/''${txId}.''${actual_drep}.voted" + if test -f "''${proposal_flag}" + then + break + fi + + ${coreutils}/bin/echo "governance_vote_proposal: ''${proposal_id} - ''${node_str} - ''${actual_drep}" + + # Lock needed. Creates or destroys UTxOs. + socket_path="$(get_socket_lock "''${node_str}")" + + local node_drep_skey node_drep_addr + node_drep_skey="$(create_node_drep_keys "''${node_str}" "''${node_i}" "''${actual_drep}")".skey + node_drep_addr="$(build_node_drep_address "''${node_str}" "''${node_i}" "''${actual_drep}")" + + # Funds address. + # The input is calculated from the last transaction submitted. + # No waiting! But, if last submitted transaction fails (function + # `governance_funds_producer_dreps` or `governance_vote_proposal` in current + # workflow), everything else fails. + local funds_tx + funds_tx="$(get_address_utxo_expected "''${node_str}" "''${node_drep_addr}")" + # No cache if it's the first one from this node-drep. + if test -z "''${funds_tx}" + then + funds_tx="$(get_address_utxo_0 "''${node_str}" "''${node_drep_addr}")" + fi + + # Voting with DRep keys: + local tx_filename=../"''${node_str}"/vote."''${node_str}"."''${actual_drep}" + ${cardano-cli}/bin/cardano-cli conway governance vote create \ + --yes \ + --governance-action-tx-id "''${proposal_id}" \ + --governance-action-index "0" \ + --drep-verification-key-file ../genesis/cache-entry/drep-keys/drep"''${actual_drep}"/drep.vkey \ + --out-file "''${tx_filename}".action + # Build the transaction. + ${cardano-cli}/bin/cardano-cli conway transaction build \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --tx-in "''${funds_tx}" \ + --change-address "''${node_drep_addr}" \ + --witness-override 2 \ + --vote-file "''${tx_filename}".action \ + --out-file "''${tx_filename}".raw \ + > /dev/null + # Sign it with the DRep key: + ${cardano-cli}/bin/cardano-cli transaction sign \ + --testnet-magic ${toString testnetMagic} \ + --signing-key-file ../genesis/cache-entry/drep-keys/drep"''${actual_drep}"/drep.skey \ + --signing-key-file "''${node_drep_skey}" \ + --tx-body-file "''${tx_filename}".raw \ + --out-file "''${tx_filename}".signed + # Submit the transaction: + ${cardano-cli}/bin/cardano-cli transaction submit \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + --tx-file "''${tx_filename}".signed \ + >/dev/null + + ${coreutils}/bin/touch "''${proposal_flag}" + + release_socket_lock \ + "''${node_str}" \ + "''${tx_filename}.signed" \ + "''${node_drep_addr}" + + done +} + +################################################################################ +function governance_vote_all { + + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + local node_i=$2 + + ${coreutils}/bin/echo "governance_vote_all: ''${node_str}" + + # Only defined in functions that use it. + local socket_path="../''${node_str}/node.socket" + + # Store actual gov-state + ${cardano-cli}/bin/cardano-cli conway query gov-state \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + > "../''${node_str}/gov-state.json" + + # Cycle proposals. + local txIdsJSON txIds + txIdsJSON="$( \ + ${cardano-cli}/bin/cardano-cli conway query gov-state \ + --testnet-magic ${toString testnetMagic} \ + --socket-path "''${socket_path}" \ + | ${jq}/bin/jq '.proposals | map(.actionId.txId)' \ + )" + txIds=$(echo "''${txIdsJSON}" | ${jq}/bin/jq --raw-output '. | join (" ")') + for txId in ''${txIds[*]} + do + local proposal_flag="../''${node_str}/''${txId}.voted" + if ! test -f "''${proposal_flag}" + then + governance_vote_proposal "''${node_str}" "''${node_i}" "''${txId}" + ${coreutils}/bin/touch "''${proposal_flag}" + fi + done +} + +################################################################################ +# Entrypoints. +################################################################################ + +function workflow_generator { + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + + ${coreutils}/bin/echo "governance_funds_producers ........" + governance_funds_producers \ + "''${node_str}" \ + ${toString genesis_funds_vkey} \ + ${toString genesis_funds_skey} + + ${coreutils}/bin/echo "governance_create_constitution ..." + governance_create_constitution \ + "''${node_str}" \ + ${toString genesis_funds_vkey} \ + ${toString genesis_funds_skey} +} + +function workflow_producer { + # Function arguments. + local node_str=$1 # node name / folder to find the socket. + + local producer_i + producer_i="$( \ + ${jq}/bin/jq --raw-output \ + --arg keyName "''${node_str}" \ + '.[$keyName].i' \ + ../node-specs.json \ + )" + + governance_funds_producer_dreps "''${node_str}" "''${node_str}" + + for i in {1..${toString withdrawal_proposals_per_node}} + do + governance_create_withdrawal "''${node_str}" "''${producer_i}" 0 + done + + governance_vote_all "''${node_str}" "''${producer_i}" +} + +'' From f52f64ba37a031b62f7cec93e98855bb6a9c742e Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Wed, 16 Oct 2024 17:42:33 +0000 Subject: [PATCH 10/13] HACK: WIP: wb | create constitution, withdrawals and keep voting yes (nomad enabled) --- nix/workbench/backend/nomad.nix | 6 ++++++ nix/workbench/backend/nomad/cloud.sh | 7 +++++++ nix/workbench/service/voting.nix | 5 +++-- 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/nix/workbench/backend/nomad.nix b/nix/workbench/backend/nomad.nix index a63db0ec8e2..09b0f7011bc 100644 --- a/nix/workbench/backend/nomad.nix +++ b/nix/workbench/backend/nomad.nix @@ -78,6 +78,12 @@ let flake-output = "legacyPackages.x86_64-linux.coreutils"; installable = null; }; + flock = { + nix-store-path = pkgs.flock; + flake-reference = "github:intersectmbo/cardano-node"; + flake-output = "legacyPackages.x86_64-linux.flock"; + installable = null; + }; bashInteractive = { nix-store-path = pkgs.bashInteractive; flake-reference = "github:intersectmbo/cardano-node"; diff --git a/nix/workbench/backend/nomad/cloud.sh b/nix/workbench/backend/nomad/cloud.sh index 35a98bc1899..9edf31d3e7b 100644 --- a/nix/workbench/backend/nomad/cloud.sh +++ b/nix/workbench/backend/nomad/cloud.sh @@ -834,6 +834,13 @@ deploy-genesis-nomadcloud() { local dir=${1:?$usage}; shift local nomad_job_name=$(jq -r ". [\"job\"] | keys[0]" "${dir}"/nomad/nomad-job.json) +################################################################################ +################################################################################ +################################################################################ + cp /tmp/guardrails-script.plutus "$dir"/genesis/guardrails-script.plutus +################################################################################ +################################################################################ +################################################################################ # Create genesis tar file local genesis_file_name="${nomad_job_name}.tar.zst" msg "$(blue Creating) $(yellow "\"${genesis_file_name}\"") ..." diff --git a/nix/workbench/service/voting.nix b/nix/workbench/service/voting.nix index 2f99d8d00c8..fced0e03eb2 100644 --- a/nix/workbench/service/voting.nix +++ b/nix/workbench/service/voting.nix @@ -9,6 +9,7 @@ let ########## bashInteractive = pkgs.bashInteractive; coreutils = pkgs.coreutils; + flock = pkgs.flock; jq = pkgs.jq; cardano-cli = pkgs.cardanoNodePackages.cardano-cli; @@ -170,7 +171,7 @@ function get_socket_lock { local lockfile_path="''${socket_path}".lock exec 200>"''${lockfile_path}" - flock 200 + ${flock}/bin/flock 200 ${coreutils}/bin/echo "''${socket_path}" } @@ -194,7 +195,7 @@ function release_socket_lock { > ../"''${node_str}"/"''${addr}".utxo # A mystery! - flock -u 200 2>/dev/null || true + ${flock}/bin/flock -u 200 2>/dev/null || true exec 200>&- } From 46b1b3a42d3240e59fe6997c311a3f7bc52c5a59 Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Wed, 16 Oct 2024 17:43:13 +0000 Subject: [PATCH 11/13] Revert "HACK: wb | run fixed-loaded until termination requested" This reverts commit d5cbff144e9d67a42faf504b42204d644251fc13. --- nix/workbench/scenario.sh | 6 +++--- nix/workbench/service/nodes.nix | 20 ++++++++++---------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/nix/workbench/scenario.sh b/nix/workbench/scenario.sh index 31fe43a8772..d8572585b50 100644 --- a/nix/workbench/scenario.sh +++ b/nix/workbench/scenario.sh @@ -178,10 +178,10 @@ scenario_watcher() { if ! test -f "${run_dir}"/flag/cluster-stopping then echo >&2 -# touch "${run_dir}"/flag/cluster-stopping + touch "${run_dir}"/flag/cluster-stopping msg "scenario: $(yellow end of time reached) for: $(red $(jq '.meta.tag' -r ${__scenario_exit_trap_dir}/meta.json))" - msg "scenario: $(red I DONT CARE, KEEP RUNNING ......)" -# progress "scenario" "now: $(yellow $(date))" + msg "scenario: $(red signalled termination)" + progress "scenario" "now: $(yellow $(date))" fi } diff --git a/nix/workbench/service/nodes.nix b/nix/workbench/service/nodes.nix index 9098d72ff6b..837727b7f3c 100644 --- a/nix/workbench/service/nodes.nix +++ b/nix/workbench/service/nodes.nix @@ -117,16 +117,16 @@ let profile.node.verbatim); extraArgs = - [ "+RTS" "-scardano-node.gcstats" "-RTS" ]; -# ++ -# optionals (nodeSpec.shutdown_on_block_synced != null) [ -# "--shutdown-on-block-synced" -# (toString nodeSpec.shutdown_on_block_synced) -# ] ++ -# optionals (nodeSpec.shutdown_on_slot_synced != null) [ -# "--shutdown-on-slot-synced" -# (toString nodeSpec.shutdown_on_slot_synced) -# ]; + [ "+RTS" "-scardano-node.gcstats" "-RTS" ] + ++ + optionals (nodeSpec.shutdown_on_block_synced != null) [ + "--shutdown-on-block-synced" + (toString nodeSpec.shutdown_on_block_synced) + ] ++ + optionals (nodeSpec.shutdown_on_slot_synced != null) [ + "--shutdown-on-slot-synced" + (toString nodeSpec.shutdown_on_slot_synced) + ]; } // optionalAttrs (profiling != "none") { inherit profiling; } // optionalAttrs (profiling == "none") { From 76ee5802ab45e7535d93f4478719993004cc0d75 Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Wed, 16 Oct 2024 17:48:18 +0000 Subject: [PATCH 12/13] HACK: WIP: to try in cluster (-nomadperf) --- nix/workbench/profile/prof1-variants.jq | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/nix/workbench/profile/prof1-variants.jq b/nix/workbench/profile/prof1-variants.jq index 24403031ca9..31d3df7fde4 100644 --- a/nix/workbench/profile/prof1-variants.jq +++ b/nix/workbench/profile/prof1-variants.jq @@ -916,7 +916,7 @@ def all_profile_variants: ) as $plutus_nomadperf_template | # P&T Nomad cluster: 52 nodes, P2P by default - value-only workload - ($nomad_perf_base * $nomad_perf_dense * $p2p * $genesis_voltaire + ($nomad_perf_base * $nomad_perf_dense * $p2p * $genesis_voltaire_10 ) as $valuevolt_nomadperf_template | # P&T Nomad cluster: 52 nodes, P2P by default - Plutus workload @@ -1252,6 +1252,8 @@ def all_profile_variants: ## P&T Nomad cluster: same, but new Voltaire era baseline with 10k DReps, updated cost models and protocol version 9 , $valuevolt_nomadperf_template * $dreps_large * { name: "value-volt-nomadperf" + , genesis: {funds_balance: 40000000000000} + , generator: {drep_voting: true} } , $plutusvolt_nomadperf_template * $dreps_large * { name: "plutus-volt-nomadperf" From 26684aa7482819740adb12532fa6454656cf10e3 Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Thu, 17 Oct 2024 14:45:48 +0000 Subject: [PATCH 13/13] HACK: WIP: to try cloud deployments without breaking our geneses cache --- nix/workbench/genesis/genesis.jq | 28 ++-------------------------- 1 file changed, 2 insertions(+), 26 deletions(-) diff --git a/nix/workbench/genesis/genesis.jq b/nix/workbench/genesis/genesis.jq index e593caf21bb..9254d4eced0 100644 --- a/nix/workbench/genesis/genesis.jq +++ b/nix/workbench/genesis/genesis.jq @@ -50,31 +50,7 @@ def profile_cli_args($p): ## def profile_genesis_cache_key($p; $profile_file): - ($p.genesis * $p.composition * $p.derived) - | - { network_magic - - , funds_balance - , per_pool_balance - , pool_coin - - , n_pools - , n_bft_hosts - , n_dense_hosts - , dense_pool_density - - , delegators - , utxo_stuffed - , dreps - - } as $genesis_crypto_affecting_data - - | $genesis_crypto_affecting_data | to_entries - | map(if .value == null - then error("FATAL: undefined key \(.key) in profile \(.profile_file)") - else null end) - - | $genesis_crypto_affecting_data + ($p.genesis * $p.composition) ; def profile_genesis_cache_entry_name($p; $params_hash): @@ -90,7 +66,7 @@ then [ "k\(.composition.n_pools)" ] + if .genesis.dreps != 0 then ["\(.genesis.dreps)Dr"] else [] end + - [ "\(.derived.utxo_stuffed / 1000)kU" + [ "\(([0, .genesis.utxo] | max) / 1000)kU" , "\($params_hash)" ] else [ "preset" , $profile[0].preset ]