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..2e48b8e38d2 --- /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": 0, + "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": 4310, + "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/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 0f5c865d5b8..466ccbaf0c3 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 #-} @@ -26,6 +24,7 @@ import Cardano.Benchmarking.Script (parseScriptFileAeson, runScript) import Cardano.Benchmarking.Script.Aeson (parseJSONFile, prettyPrint) import Cardano.Benchmarking.Script.Env as Env (emptyEnv, newEnvConsts) import Cardano.Benchmarking.Script.Selftest (runSelftest) +import Cardano.Benchmarking.Script.Queries (debugDumpProposalsPeriodically) import Cardano.Benchmarking.Version as Version import Cardano.TxGenerator.PlutusContext (readScriptData) import Cardano.TxGenerator.Setup.NixService @@ -74,7 +73,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 () @@ -85,7 +84,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 @@ -101,6 +100,8 @@ runCommand' iocp = do quickTestPlutusDataOrDie finalOpts + debugDumpProposalsPeriodically finalOpts + case compileOptions finalOpts of Right script -> runScript emptyEnv script consts >>= handleError . fst err -> die $ "tx-generator:Cardano.Command.runCommand JsonHL: " ++ show err @@ -109,7 +110,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 () @@ -214,14 +215,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" @@ -233,13 +234,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/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index 6881f9ab428..6f6c5b53920 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) @@ -62,6 +62,12 @@ compileToScript = do pure tc <- askNixOption _nix_cardanoTracerSocket emit $ StartProtocol nc tc + + whenM (fromMaybe False <$> askNixOption _nix_drep_voting) do + emit $ ReadDRepKeys nc + emit $ ReadStakeKeys nc + logMsg "Importing DRep SigningKeys and StakeCredentials. Done." + genesisWallet <- importGenesisFunds collateralWallet <- addCollaterals genesisWallet splitWallet <- splittingPhase genesisWallet @@ -275,7 +281,7 @@ newWallet n = do -- we assume the hardcoded base16 keys to successfully evaluate to a SigningKey PaymentKey parseKey :: BS.ByteString -> SigningKey PaymentKey parseKey k - = let ~(Right k') = parseSigningKeyBase16 k in k' + = let ~(Right k') = parsePaymentKeyBase16 k in k' keyNameGenesisInputFund :: String keyNameGenesisInputFund = "GenesisInputFund" diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs index e5a983f9ecd..1a7eba71574 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs @@ -109,7 +109,7 @@ metadataSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMeta metadataSize p m = dummyTxSize p m - dummyTxSize p Nothing dummyTxSizeInEra :: IsShelleyBasedEra era => TxMetadataInEra era -> Int -dummyTxSizeInEra metadata = case createAndValidateTransactionBody shelleyBasedEra dummyTx of +dummyTxSizeInEra metadata = case createTransactionBody shelleyBasedEra dummyTx of Right b -> BS.length $ serialiseToCBOR b Left err -> error $ "metaDataSize " ++ show err where diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs index e2d98eddf78..90444bba778 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs @@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoMonomorphismRestriction #-} diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs index 577c47df682..1d6cc734d2f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs @@ -5,10 +5,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} diff --git a/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs b/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs index 6843b2a3d21..5bed4817267 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs @@ -10,8 +10,7 @@ module Cardano.Benchmarking.OuroborosImports , LoggingLayer , PaymentKey , ShelleyGenesis - , SigningKey - , SigningKeyFile + -- , SigningKey , StandardShelley , NetworkId -- , getGenesis @@ -22,8 +21,13 @@ module Cardano.Benchmarking.OuroborosImports , submitTxToNodeLocal ) where -import Prelude +import Cardano.Api (BlockType (..), ConsensusModeParams (..), EpochSlots (..), + LocalNodeConnectInfo (..), NetworkId (..), PaymentKey, SocketPath, TxInMode, + TxValidationErrorInCardanoMode, protocolInfo, submitTxToNodeLocal) +import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis) +import Cardano.Node.Configuration.Logging (LoggingLayer) +import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..)) import Ouroboros.Consensus.Block.Abstract import qualified Ouroboros.Consensus.Cardano as Consensus import Ouroboros.Consensus.Config (TopLevelConfig, configBlock, configCodec) @@ -32,15 +36,7 @@ import Ouroboros.Consensus.Node (ProtocolInfo (..)) import Ouroboros.Consensus.Shelley.Eras (StandardCrypto, StandardShelley) import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (..)) -import Cardano.Node.Configuration.Logging (LoggingLayer) -import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..)) - -import Cardano.CLI.Types.Common (SigningKeyFile) - -import Cardano.Api (BlockType (..), ConsensusModeParams (..), EpochSlots (..), - LocalNodeConnectInfo (..), NetworkId (..), PaymentKey, SigningKey, SocketPath, - TxInMode, TxValidationErrorInCardanoMode, protocolInfo, submitTxToNodeLocal) -import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis) +import Prelude type CardanoBlock = Consensus.CardanoBlock StandardCrypto diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script.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/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs index 3435fbddeb9..2ffa014351c 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs @@ -35,14 +35,18 @@ import qualified Data.Text as Text (unpack) -- the cases' fields to functions with very similar names to the -- constructors. action :: Action -> ActionM () -action a = case a of +action = \case SetNetworkId val -> setEnvNetworkId val SetSocketPath val -> setEnvSocketPath val InitWallet name -> initWallet name SetProtocolParameters p -> setProtocolParameters p StartProtocol configFile cardanoTracerSocket -> startProtocol configFile cardanoTracerSocket ReadSigningKey name filePath -> readSigningKey name filePath + ReadDRepKeys filepath -> readDRepKeys filepath + ReadStakeKeys filepath -> readStakeCredentials filepath + DefineDRepKey drepKey -> defineDRepCredential drepKey DefineSigningKey name descr -> defineSigningKey name descr + DefineStakeKey k -> defineStakeCredential k AddFund era wallet txIn lovelace keyName -> addFund era wallet txIn lovelace keyName Delay t -> delay t Submit era submitMode txParams generator -> submitAction era submitMode generator txParams diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs index 353c2f5c2c1..968b3c9cd0c 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs @@ -62,7 +62,7 @@ instance ToJSON TxGenTxParams where instance FromJSON TxGenTxParams where parseJSON = genericParseJSON jsonOptionsUnTaggedSum --- FIXME: workaround instances +-- FIXME: workaround instance instance ToJSON (SigningKey PaymentKey) where toJSON = toJSON . serialiseToTextEnvelope Nothing instance FromJSON (SigningKey PaymentKey) where @@ -72,6 +72,36 @@ instance FromJSON (SigningKey PaymentKey) where Right k -> pure k Left err -> fail $ show err +-- FIXME: workaround instance +instance ToJSON (SigningKey DRepKey) where + toJSON = toJSON . serialiseToTextEnvelope Nothing +instance FromJSON (SigningKey DRepKey) where + parseJSON o = do + te <- parseJSON o + case deserialiseFromTextEnvelope (AsSigningKey AsDRepKey) te of + Right k -> pure k + Left err -> fail $ show err + +-- FIXME: workaround instance +instance ToJSON (VerificationKey DRepKey) where + toJSON = toJSON . serialiseToTextEnvelope Nothing +instance FromJSON (VerificationKey DRepKey) where + parseJSON o = do + te <- parseJSON o + case deserialiseFromTextEnvelope (AsVerificationKey AsDRepKey) te of + Right k -> pure k + Left err -> fail $ show err + +-- FIXME: workaround instance +instance ToJSON (VerificationKey StakeKey) where + toJSON = toJSON . serialiseToTextEnvelope Nothing +instance FromJSON (VerificationKey StakeKey) where + parseJSON o = do + te <- parseJSON o + case deserialiseFromTextEnvelope (AsVerificationKey AsStakeKey) te of + Right k -> pure k + Left err -> fail $ show err + instance ToJSON ProtocolParametersSource where toJSON = genericToJSON jsonOptionsUnTaggedSum toEncoding = genericToEncoding jsonOptionsUnTaggedSum diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 36810206321..d42c8870ce3 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 #-} @@ -20,8 +19,8 @@ where import Cardano.Api import Cardano.Api.Shelley (PlutusScriptOrReferenceInput (..), ProtocolParameters, - ShelleyLedgerEra, convertToLedgerProtocolParameters, protocolParamMaxTxExUnits, - protocolParamPrices) + StakeCredential (..), convertToLedgerProtocolParameters, + protocolParamMaxTxExUnits, protocolParamPrices) import Cardano.Benchmarking.GeneratorTx as GeneratorTx (AsyncBenchmarkControl) import qualified Cardano.Benchmarking.GeneratorTx as GeneratorTx (waitBenchmark, walletBenchmark) @@ -30,31 +29,29 @@ import Cardano.Benchmarking.GeneratorTx.NodeToNode (ConnectClient, import Cardano.Benchmarking.GeneratorTx.SizedMetadata (mkMetadata) import Cardano.Benchmarking.LogTypes as Core (AsyncBenchmarkControl (..), TraceBenchTxSubmit (..), btConnect_, btN2N_, btSubmission2_, btTxSubmit_) -import Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, SigningKeyFile, - makeLocalConnectInfo, protocolToCodecConfig) +import Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, + protocolToCodecConfig) import Cardano.Benchmarking.Script.Aeson (prettyPrintOrdered, readProtocolParametersFile) import Cardano.Benchmarking.Script.Env hiding (Error (TxGenError)) import qualified Cardano.Benchmarking.Script.Env as Env (Error (TxGenError)) +import Cardano.Benchmarking.Script.Queries import Cardano.Benchmarking.Script.Types import Cardano.Benchmarking.Types as Core (SubmissionErrorPolicy (..)) import Cardano.Benchmarking.Version as Version import Cardano.Benchmarking.Wallet as Wallet import qualified Cardano.Ledger.Coin as L -import qualified Cardano.Ledger.Core as Ledger import Cardano.Logging hiding (LocalSocket) import Cardano.TxGenerator.Fund as Fund import qualified Cardano.TxGenerator.FundQueue as FundQueue 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 import Cardano.TxGenerator.Types import qualified Cardano.TxGenerator.Utils as Utils import Cardano.TxGenerator.UTxO -import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) - -import Prelude import Control.Concurrent (threadDelay) import Control.Monad @@ -63,6 +60,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 @@ -91,13 +89,41 @@ 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 (readPaymentKeyFile filePath) defineSigningKey :: String -> SigningKey PaymentKey -> ActionM () defineSigningKey = setEnvKeys +defineDRepCredential :: SigningKey DRepKey -> ActionM () +defineDRepCredential = setEnvDRepKeys . (: []) + +defineStakeCredential :: VerificationKey StakeKey -> ActionM () +defineStakeCredential = setEnvStakeCredentials . (: []) . StakeCredentialByKey . verificationKeyHash + +readDRepKeys :: FilePath -> ActionM () +readDRepKeys ncFile = do + genesis <- onNothing throwKeyErr $ getGenesisDirectory <$> liftIOSafe (mkNodeConfig ncFile) + -- "cache-entry" is a link or copy of the actual genesis folder created by "create-testnet-data" + -- in the workbench's run directory structure, this link or copy is created for each run - by workbench + ks <- liftIOSafe . Genesis.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" + +readStakeCredentials :: FilePath -> ActionM () +readStakeCredentials ncFile = do + genesis <- onNothing throwKeyErr $ getGenesisDirectory <$> liftIOSafe (mkNodeConfig ncFile) + -- "cache-entry" is a link or copy of the actual genesis folder created by "create-testnet-data" + -- in the workbench's run directory structure, this link or copy is created for each run - by workbench + ks <- liftIOSafe . Genesis.genesisLoadStakeKeys $ genesis + setEnvStakeCredentials $ map (StakeCredentialByKey . verificationKeyHash) ks + traceDebug $ "StakeCredentials loaded: " ++ show (length ks) ++ " from: " ++ genesis + where + throwKeyErr = liftTxGenError . TxGenError $ + "readStakeCredentials: no genesisDirectory could be retrieved from the node config" + addFund :: AnyCardanoEra -> String -> TxIn -> L.Coin -> String -> ActionM () addFund era wallet txIn lovelace keyName = do fundKey <- getEnvKeys keyName @@ -159,43 +185,6 @@ cancelBenchmark = do liftIO abcShutdown waitBenchmarkCore abc -getLocalConnectInfo :: ActionM LocalNodeConnectInfo -getLocalConnectInfo = makeLocalConnectInfo <$> getEnvNetworkId <*> getEnvSocketPath - -queryEra :: ActionM AnyCardanoEra -queryEra = do - localNodeConnectInfo <- getLocalConnectInfo - chainTip <- getLocalChainTip localNodeConnectInfo - mapExceptT liftIO . - modifyError (Env.TxGenError . TxGenError . show) $ - queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) QueryCurrentEra - -queryRemoteProtocolParameters :: ActionM ProtocolParameters -queryRemoteProtocolParameters = do - localNodeConnectInfo <- getLocalConnectInfo - chainTip <- liftIO $ getLocalChainTip localNodeConnectInfo - era <- queryEra - let - callQuery :: forall era. - QueryInEra era (Ledger.PParams (ShelleyLedgerEra era)) - -> ActionM ProtocolParameters - callQuery query@(QueryInShelleyBasedEra shelleyEra _) = do - pp <- liftEither . first (Env.TxGenError . TxGenError . show) =<< mapExceptT liftIO (modifyError (Env.TxGenError . TxGenError . show) $ - queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) (QueryInEra query)) - let pp' = fromLedgerPParams shelleyEra pp - pparamsFile = "protocol-parameters-queried.json" - liftIO $ BSL.writeFile pparamsFile $ prettyPrintOrdered pp' - traceDebug $ "queryRemoteProtocolParameters : query result saved in: " ++ pparamsFile - return pp' - case era of - AnyCardanoEra ByronEra -> liftTxGenError $ TxGenError "queryRemoteProtocolParameters Byron not supported" - AnyCardanoEra ShelleyEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraShelley QueryProtocolParameters - AnyCardanoEra AllegraEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAllegra QueryProtocolParameters - AnyCardanoEra MaryEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraMary QueryProtocolParameters - AnyCardanoEra AlonzoEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAlonzo QueryProtocolParameters - AnyCardanoEra BabbageEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraBabbage QueryProtocolParameters - AnyCardanoEra ConwayEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraConway QueryProtocolParameters - getProtocolParameters :: ActionM ProtocolParameters getProtocolParameters = do getProtoParamMode >>= \case @@ -286,6 +275,7 @@ evalGenerator :: IsShelleyBasedEra era => Generator -> TxGenTxParams -> AsType e evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do networkId <- getEnvNetworkId protocolParameters <- getProtocolParameters + case convertToLedgerProtocolParameters shelleyBasedEra protocolParameters of Left err -> throwE (Env.TxGenError (ApiError err)) Right ledgerParameters -> @@ -384,6 +374,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/Env.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs index e17a94b7c8b..d8021cdfd12 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 #-} @@ -43,8 +41,12 @@ module Cardano.Benchmarking.Script.Env ( , traceBenchTxSubmit , getBenchTracers , setBenchTracers + , getEnvDRepKeys + , setEnvDRepKeys , getEnvGenesis , setEnvGenesis + , getEnvGovSummary + , setEnvGovSummary , getEnvKeys , setEnvKeys , getEnvNetworkId @@ -55,6 +57,8 @@ module Cardano.Benchmarking.Script.Env ( , setProtoParamMode , getEnvSocketPath , setEnvSocketPath + , getEnvStakeCredentials + , setEnvStakeCredentials , getEnvThreads , setEnvThreads , getEnvWallets @@ -63,12 +67,11 @@ module Cardano.Benchmarking.Script.Env ( , setEnvSummary ) where -import Cardano.Api (File (..), SocketPath) +import Cardano.Api (DRepKey, File (..), ShelleyBasedEra (..), SocketPath, StakeCredential) import Cardano.Benchmarking.GeneratorTx import qualified Cardano.Benchmarking.LogTypes as Tracer -import Cardano.Benchmarking.OuroborosImports (NetworkId, PaymentKey, ShelleyGenesis, - SigningKey) +import Cardano.Benchmarking.OuroborosImports (NetworkId, PaymentKey, ShelleyGenesis) import Cardano.Benchmarking.Script.Types import Cardano.Benchmarking.Wallet import Cardano.Ledger.Crypto (StandardCrypto) @@ -76,6 +79,7 @@ import Cardano.Logging import Cardano.Node.Protocol.Types (SomeConsensusProtocol) import Cardano.TxGenerator.PlutusContext (PlutusBudgetSummary) import Cardano.TxGenerator.Setup.NixService as Nix (NixServiceOptions) +import Cardano.TxGenerator.Setup.SigningKey (SigningKey) import Cardano.TxGenerator.Types (TxGenError (..)) import Ouroboros.Network.NodeToClient (IOManager) @@ -90,6 +94,7 @@ import Control.Monad.Trans.RWS.Strict (RWST) import qualified Control.Monad.Trans.RWS.Strict as RWS import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Data.Ratio import qualified Data.Text as Text import qualified System.IO as IO (hPutStrLn, stderr) @@ -108,6 +113,9 @@ data Env = Env { -- | 'Cardano.Api.ProtocolParameters' is ultimately , envKeys :: Map String (SigningKey PaymentKey) , envWallets :: Map String WalletRef , envSummary :: Maybe PlutusBudgetSummary + , envDRepKeys :: [SigningKey DRepKey] + , envStakeCredentials :: [StakeCredential] + , envGovStateSummary :: GovStateSummary } -- | `Env` uses `Maybe` to represent values that might be uninitialized. -- This being empty means `Nothing` is used across the board, along with @@ -121,6 +129,9 @@ emptyEnv = Env { protoParams = Nothing , envSocketPath = Nothing , envWallets = Map.empty , envSummary = Nothing + , envDRepKeys = [] + , envStakeCredentials = [] + , envGovStateSummary = GovStateSummary 1 (1 % 2) (GovernanceActionIds ShelleyBasedEraConway []) } newEnvConsts :: IOManager -> Maybe Nix.NixServiceOptions -> STM Tracer.EnvConsts @@ -197,6 +208,12 @@ 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 }) + +setEnvStakeCredentials :: [StakeCredential] -> ActionM () +setEnvStakeCredentials val = modifyEnv (\e -> e { envStakeCredentials = val }) + -- | Write accessor for `envProtocol`. setEnvProtocol :: SomeConsensusProtocol -> ActionM () setEnvProtocol val = modifyEnv (\e -> e { envProtocol = Just val }) @@ -223,6 +240,9 @@ setEnvWallets key val = modifyEnv (\e -> e { envWallets = Map.insert key val (en setEnvSummary :: PlutusBudgetSummary -> ActionM () setEnvSummary val = modifyEnv (\e -> e { envSummary = Just val }) +setEnvGovSummary :: GovStateSummary -> ActionM () +setEnvGovSummary val = modifyEnv (\e -> e { envGovStateSummary = val }) + -- | Read accessor helper for `Maybe` record fields of `Env`. getEnvVal :: (Env -> Maybe t) -> String -> ActionM t getEnvVal acc s = do @@ -273,6 +293,12 @@ getEnvGenesis = getEnvVal envGenesis "Genesis" getEnvKeys :: String -> ActionM (SigningKey PaymentKey) getEnvKeys = getEnvMap envKeys +getEnvDRepKeys :: ActionM [SigningKey DRepKey] +getEnvDRepKeys = lift $ RWS.gets envDRepKeys + +getEnvStakeCredentials :: ActionM [StakeCredential] +getEnvStakeCredentials = lift $ RWS.gets envStakeCredentials + -- | Read accessor for `envNetworkId`. getEnvNetworkId :: ActionM NetworkId getEnvNetworkId = getEnvVal envNetworkId "Genesis" @@ -299,6 +325,9 @@ getEnvWallets = getEnvMap envWallets getEnvSummary :: ActionM (Maybe PlutusBudgetSummary) getEnvSummary = lift (RWS.gets envSummary) +getEnvGovSummary :: ActionM GovStateSummary +getEnvGovSummary = lift (RWS.gets envGovStateSummary) + -- | Helper to make submissions to the `Tracer.BenchTracers`. traceBenchTxSubmit :: (forall txId. x -> Tracer.TraceBenchTxSubmit txId) -> x -> ActionM () traceBenchTxSubmit tag msg = do diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Queries.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Queries.hs new file mode 100644 index 00000000000..36d7bbb6ac7 --- /dev/null +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Queries.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.Benchmarking.Script.Queries + ( getLocalConnectInfo + , queryEra + , queryGovernanceState + , queryRemoteProtocolParameters + + , debugDumpProposalsPeriodically + ) where + +import Cardano.Api +import Cardano.Api.Shelley (ProtocolParameters, ShelleyLedgerEra) + +import Cardano.Benchmarking.OuroborosImports +import Cardano.Benchmarking.Script.Aeson (prettyPrintOrdered) +import Cardano.Benchmarking.Script.Env hiding (Error (TxGenError)) +import qualified Cardano.Benchmarking.Script.Env as Env (Error (TxGenError)) +import Cardano.Benchmarking.Script.Types +import Cardano.Ledger.BaseTypes (unboundRational) +import qualified Cardano.Ledger.Conway.Governance as LC +import qualified Cardano.Ledger.Conway.PParams as LC +import qualified Cardano.Ledger.Core as Ledger +import Cardano.TxGenerator.Setup.NixService (NixServiceOptions (..)) +import Cardano.TxGenerator.Setup.NodeConfig (mkConsensusProtocol, mkNodeConfig) +import Cardano.TxGenerator.Types +import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) + +import Control.Concurrent (forkIO, threadDelay) +import Control.Exception (SomeException (..), catch, try) +import Control.Monad (forever, void) +import Data.Bifunctor (first) +import Data.ByteString.Lazy.Char8 as BSL (writeFile) +import qualified Data.Foldable as Foldable +import Data.Ratio +import Data.Time (defaultTimeLocale, formatTime) +import Data.Time.Clock.System (getSystemTime, systemToUTCTime) +import Lens.Micro ((^.)) + + +fileNamePParams :: FilePath +fileNamePParams = "protocol-parameters-queried.json" + +fileNameProposals :: String -> FilePath +fileNameProposals tStamp = "govstate-proposals-" ++ tStamp ++ ".json" + +getLocalConnectInfo :: ActionM LocalNodeConnectInfo +getLocalConnectInfo = makeLocalConnectInfo <$> getEnvNetworkId <*> getEnvSocketPath + +queryEra :: ActionM AnyCardanoEra +queryEra = do + localNodeConnectInfo <- getLocalConnectInfo + chainTip <- getLocalChainTip localNodeConnectInfo + mapExceptT liftIO . + modifyError (Env.TxGenError . TxGenError . show) $ + queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) QueryCurrentEra + +queryRemoteProtocolParameters :: ActionM ProtocolParameters +queryRemoteProtocolParameters = do + localNodeConnectInfo <- getLocalConnectInfo + chainTip <- liftIO $ getLocalChainTip localNodeConnectInfo + era <- queryEra + + let + callQuery :: forall era. + QueryInEra era (Ledger.PParams (ShelleyLedgerEra era)) + -> ActionM ProtocolParameters + callQuery query@(QueryInShelleyBasedEra shelleyEra _) = do + pp <- liftEither . first (Env.TxGenError . TxGenError . show) =<< mapExceptT liftIO (modifyError (Env.TxGenError . TxGenError . show) $ + queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) (QueryInEra query)) + let pp' = fromLedgerPParams shelleyEra pp + liftIO $ BSL.writeFile fileNamePParams $ prettyPrintOrdered pp' + traceDebug $ "queryRemoteProtocolParameters: query result saved in: " ++ fileNamePParams + return pp' + + case era of + AnyCardanoEra ByronEra -> liftTxGenError $ TxGenError "queryRemoteProtocolParameters Byron not supported" + AnyCardanoEra ShelleyEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraShelley QueryProtocolParameters + AnyCardanoEra AllegraEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAllegra QueryProtocolParameters + AnyCardanoEra MaryEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraMary QueryProtocolParameters + AnyCardanoEra AlonzoEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAlonzo QueryProtocolParameters + AnyCardanoEra BabbageEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraBabbage QueryProtocolParameters + AnyCardanoEra ConwayEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraConway QueryProtocolParameters + +queryGovernanceState :: ActionM GovStateSummary +queryGovernanceState = do + localNodeConnectInfo <- getLocalConnectInfo + chainTip <- liftIO $ getLocalChainTip localNodeConnectInfo + currentEra <- queryEra + + let + callQuery :: forall era ledgerEra. + ( ShelleyLedgerEra era ~ ledgerEra + , LC.GovState ledgerEra ~ LC.ConwayGovState ledgerEra + , LC.ConwayEraPParams ledgerEra + ) => ShelleyBasedEra era -> ActionM GovStateSummary + callQuery era = shelleyBasedEraConstraints era $ do + let + query = QueryInEra $ QueryInShelleyBasedEra era QueryGovState + + gs <- liftEither . first (Env.TxGenError . TxGenError . show) =<< mapExceptT liftIO (modifyError (Env.TxGenError . TxGenError . show) $ + queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) query) + let + props = LC.cgsProposals gs + govActIds = Foldable.toList $ LC.proposalsIds props + + pparams = LC.cgsCurPParams gs + deposit = pparams ^. LC.ppGovActionDepositL + threshold = unboundRational $ LC.dvtTreasuryWithdrawal $ pparams ^. LC.ppDRepVotingThresholdsL + threshInt = fromInteger (numerator threshold) % fromInteger (denominator threshold) + + pure $ GovStateSummary deposit threshInt (GovernanceActionIds era govActIds) + + case currentEra of + AnyCardanoEra ConwayEra -> callQuery ShelleyBasedEraConway + AnyCardanoEra _ -> liftTxGenError $ TxGenError "queryGovState: pre-Conway eras not supported" + +-- | This spawns a debug thread to dump the proposals section of the governance state every minute, +-- iff tx-generator voting workload is specified, and we're in a ConwayEraOnwards. +-- +-- All failures and exceptions are silent and non-blocking, i.e. there are just no file dumps appearing. +-- +-- NB. This must NEVER be used during an actual benchmark, as this query potentially forces the ledger pulser. +-- +debugDumpProposalsPeriodically :: NixServiceOptions -> IO () +debugDumpProposalsPeriodically NixServiceOptions{..} + | not (or _nix_drep_voting) = pure () + | otherwise = try setup >>= \case + Left SomeException{} -> pure () + Right (connInfo, era) -> case era of + AnyCardanoEra ConwayEra -> forkTheThread ConwayEraOnwardsConway connInfo + _ -> pure () + + where + setup :: IO (LocalNodeConnectInfo, AnyCardanoEra) + setup = do + proto <- startProtocol _nix_nodeConfigFile + + let + nodeConnInfo :: LocalNodeConnectInfo + nodeConnInfo = makeLocalConnectInfo (protocolToNetworkId proto) (File _nix_localNodeSocketPath) + + queryEraIO :: ChainTip -> IO AnyCardanoEra + queryEraIO tip = fromRightOrFail pure =<< runExceptT + (queryNodeLocalState nodeConnInfo (SpecificPoint $ chainTipToChainPoint tip) QueryCurrentEra) + + chainTip <- getLocalChainTip nodeConnInfo + (,) nodeConnInfo <$> queryEraIO chainTip + + forkTheThread :: () => ConwayEraOnwards era -> LocalNodeConnectInfo -> IO () + forkTheThread era nodeConnInfo = conwayEraOnwardsConstraints era $ do + let + sbe = conwayEraOnwardsToShelleyBasedEra era + query = QueryInEra $ QueryInShelleyBasedEra sbe QueryGovState + + threadBody = do + chainTip <- getLocalChainTip nodeConnInfo + govState <- fromRightOrFail pure =<< runExceptT + (queryNodeLocalState nodeConnInfo (SpecificPoint $ chainTipToChainPoint chainTip) query) + props <- fromRightOrFail (pure . LC.cgsProposals) govState + tStamp <- formatTime defaultTimeLocale timeStampFormat . systemToUTCTime <$> getSystemTime + BSL.writeFile (fileNameProposals tStamp) (prettyPrintOrdered props) + + void $ forkIO $ forever $ do + !_ <- threadBody `catch` \SomeException{} -> pure () + threadDelay 60_000_000 -- 1 minute + + -- an ExceptT for the masses + fromRightOrFail :: MonadFail m => (b -> m c) -> Either a b -> m c + fromRightOrFail cont = \case + Left{} -> fail "" + Right v -> cont v + + startProtocol Nothing = fail "" + startProtocol (Just cfgFile) = do + mkNodeConfig cfgFile >>= fromRightOrFail mkConsensusProtocol >>= fromRightOrFail pure + + timeStampFormat :: String + timeStampFormat = "%H-%M-%S" diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index 03677bbc69b..37b61e9fb34 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@. @@ -93,7 +96,7 @@ testScript protocolFile submitMode = ] where skey = fromRight (error "could not parse hardcoded signing key") $ - parseSigningKeyTE $ + parsePaymentKeyTE $ TextEnvelope { teType = TextEnvelopeType "GenesisUTxOSigningKey_ed25519" , teDescription = fromString "Genesis Initial UTxO Signing Key" @@ -110,3 +113,52 @@ 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 + + , DefineStakeKey stakeKey + + -- manually inject an (unnamed) DRep key into the Env by means of an 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") $ + parsePaymentKeyTE $ + 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 = error "could not parse hardcoded drep key" `fromRight` + parseDRepKeyBase16 "5820aa7f780a2dcd099762ebc31a43860c1373970c2e2062fcd02cceefe682f39ed8" + + stakeKey :: VerificationKey StakeKey + stakeKey = fromRight (error "could not parse hardcoded stake key") $ + parseStakeKeyBase16 "5820bbbfe3f3b71b00d1d61f4fe2a82526597740f61a0aa06f1324557925803c7d3e" + + era = AnyCardanoEra ConwayEra + txParams = defaultTxGenTxParams {txParamFee = 1000000} + genesisWallet = "genesisWallet" + 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 06ca89cd594..c8d7060fd71 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -24,33 +24,24 @@ transactions as interchangeable, and focuses more on the variety of things one might do with the connexion. -} module Cardano.Benchmarking.Script.Types ( - Action(..) - , Generator(Cycle, NtoM, OneOf, RoundRobin, SecureGenesis, - Sequence, Split, SplitN, Take) - , PayMode(PayToAddr, PayToScript) - , ProtocolParameterMode(..) - , ProtocolParametersSource(QueryLocalNode, UseLocalProtocolFile) - , ScriptBudget(AutoScript, StaticScriptBudget) - , ScriptSpec(..) - , SubmitMode(Benchmark, DiscardTX, DumpToFile, LocalSocket, - NodeToNode) - , TargetNodes - , TxList(..) + module Cardano.Benchmarking.Script.Types + ) where import Cardano.Api import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley -import Cardano.Benchmarking.OuroborosImports (SigningKeyFile) +import Cardano.Ledger.Conway.Governance (GovActionId) +import Cardano.Ledger.Core (EraCrypto) import Cardano.Node.Configuration.NodeAddress (NodeIPv4Address) import Cardano.TxGenerator.Setup.NixService (NodeDescription) +import Cardano.TxGenerator.Setup.SigningKey (SigningKeyFile) import Cardano.TxGenerator.Types -import Prelude - import Data.Function (on) import Data.List.NonEmpty +import Data.Ratio (Ratio) import Data.Text (Text) import GHC.Generics @@ -90,8 +81,22 @@ 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 + -- | 'ReadDRepKeys' expects the path to a node config file. This + -- configuration is supposed to refer to a genesis which has + -- been created with cardano-cli create-testnet-data, and from + -- where stake verification keys can be loaded. + ReadStakeKeys :: !FilePath -> Action -- | 'DefineSigningKey' is just a 'Map.insert' on the state variable. DefineSigningKey :: !String -> !(SigningKey PaymentKey) -> Action + -- | inject a singleton DRepCredential into the environment + DefineDRepKey :: !(SigningKey DRepKey) -> Action + -- | inject a singleton StakeCredential into the environment + DefineStakeKey :: !(VerificationKey StakeKey) -> Action -- | 'AddFund' is mostly a wrapper around -- 'Cardano.Benchmarking.Wallet.walletRefInsertFund' which in turn -- is just 'Control.Concurrent.modifyMVar' around @@ -128,6 +133,8 @@ data Action where deriving (Show, Eq) deriving instance Generic Action +deriving instance Eq (SigningKey DRepKey) + -- | 'Generator' is interpreted by -- 'Cardano.Bencmarking.Script.Core.evalGenerator' as a series of -- transactions, albeit in the form of precursors to UTxO's. @@ -169,6 +176,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 @@ -215,3 +224,15 @@ newtype TxList era = TxList [Tx era] data ProtocolParameterMode where ProtocolParameterQuery :: ProtocolParameterMode ProtocolParameterLocal :: ProtocolParameters -> ProtocolParameterMode + +data GovernanceActionIds where + GovernanceActionIds :: + forall era. () => ShelleyBasedEra era + -> [GovActionId (EraCrypto (ShelleyLedgerEra era))] + -> GovernanceActionIds + +data GovStateSummary = GovStateSummary + { govGovActionDeposit :: !L.Coin + , govDRepThresholdTreasuryWithdrawal :: !(Ratio Int) + , govProposals :: !GovernanceActionIds + } diff --git a/bench/tx-generator/src/Cardano/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/Genesis.hs b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs index af2194e2d31..3082c76b668 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,8 @@ module Cardano.TxGenerator.Genesis ( genesisInitialFunds , genesisInitialFundForKey + , genesisLoadDRepKeys + , genesisLoadStakeKeys , genesisTxInput , genesisExpenditure , genesisSecureInitialFund @@ -25,14 +28,18 @@ import Cardano.Api.Shelley (ReferenceScript (..), fromShelleyPaymentCr import qualified Cardano.Ledger.Coin as L import Cardano.Ledger.Shelley.API (Addr (..), sgInitialFunds) import Cardano.TxGenerator.Fund +import Cardano.TxGenerator.Setup.SigningKey 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 Data.List (find, isPrefixOf, isSuffixOf) import qualified Data.ListMap as ListMap (toList) +import System.Directory (listDirectory) +import System.FilePath (()) genesisValidate :: ShelleyGenesis -> Either String () @@ -136,3 +143,37 @@ 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" + +genesisLoadStakeKeys :: FilePath -> IO (Either TxGenError [VerificationKey StakeKey]) +genesisLoadStakeKeys genesisDir = runExceptT $ do + dirContents <- handleIOExceptT IOError (listDirectory poolsDir) + let fs = filter (\f -> "staking-reward" `isPrefixOf` f && ".vkey" `isSuffixOf` f) dirContents + mapM loadFile fs + where + asVerificationKeyFile :: FilePath -> VerificationKeyFile In + asVerificationKeyFile = File + + loadFile f = hoistEither =<< handleIOExceptT IOError + (readStakeKeyFile $ asVerificationKeyFile $ poolsDir f) + + poolsDir = genesisDir "pools" diff --git a/bench/tx-generator/src/Cardano/TxGenerator/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/PureExample.hs b/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs index ed4f27d63d9..313fa260cf8 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs @@ -61,7 +61,7 @@ demo' parametersFile = do return newState signingKey :: SigningKey PaymentKey -signingKey = fromRight (error "signingKey: parseError") $ parseSigningKeyTE keyData +signingKey = fromRight (error "signingKey: parseError") $ parsePaymentKeyTE keyData where keyData = TextEnvelope { teType = TextEnvelopeType "GenesisUTxOSigningKey_ed25519" , teDescription = fromString "Genesis Initial UTxO Signing Key" diff --git a/bench/tx-generator/src/Cardano/TxGenerator/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/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/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..d12a8a8c232 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs @@ -1,45 +1,94 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | This module provides convenience functions when dealing with signing keys. module Cardano.TxGenerator.Setup.SigningKey - ( parseSigningKeyTE - , parseSigningKeyBase16 - , readSigningKeyFile + ( parseDRepKeyBase16 + , parsePaymentKeyBase16 + , parseStakeKeyBase16 + , parsePaymentKeyTE + , readDRepKeyFile + , readPaymentKeyFile + , readStakeKeyFile , PaymentKey , SigningKey + , module CLI ) where +import Cardano.Api + +import Cardano.CLI.Types.Common as CLI (SigningKeyFile, VerificationKeyFile) +import Cardano.TxGenerator.Types (TxGenError (..)) + 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.TxGenerator.Types (TxGenError (..)) +parsePaymentKeyTE :: TextEnvelope -> Either TxGenError (SigningKey PaymentKey) +parsePaymentKeyTE + = first ApiError . deserialiseFromTextEnvelopeAnyOf acceptedTypes +parsePaymentKeyBase16 :: BS.ByteString -> Either TxGenError (SigningKey PaymentKey) +parsePaymentKeyBase16 k + = parseSigningKeyBase16 AsPaymentKey acceptedTypes k teTemplate + where + teTemplate = TextEnvelope { + teType = "PaymentSigningKeyShelley_ed25519" + , teDescription = "Payment Signing Key" + , teRawCBOR = "" + } -parseSigningKeyTE :: TextEnvelope -> Either TxGenError (SigningKey PaymentKey) -parseSigningKeyTE - = first ApiError . deserialiseFromTextEnvelopeAnyOf acceptedTypes +parseDRepKeyBase16 :: BS.ByteString -> Either TxGenError (SigningKey DRepKey) +parseDRepKeyBase16 k + = parseSigningKeyBase16 AsDRepKey [] k teTemplate + where + teTemplate = TextEnvelope { + teType = TextEnvelopeType "DRepSigningKey_ed25519" + , teDescription = "Delegated Representative Signing Key" + , teRawCBOR = "" + } -parseSigningKeyBase16 :: BS.ByteString -> Either TxGenError (SigningKey PaymentKey) -parseSigningKeyBase16 k - = either - (const $ Left $ TxGenError "parseSigningKeyBase16: ill-formed base16 encoding") - (parseSigningKeyTE . asTE) - (Base16.decode k) +parseStakeKeyBase16 :: BS.ByteString -> Either TxGenError (VerificationKey StakeKey) +parseStakeKeyBase16 key + = do + key' <- parseBase16 key + first ApiError $ + deserialiseFromTextEnvelope (AsVerificationKey AsStakeKey) (teTemplate key') where - asTE addr = TextEnvelope { - teType = "PaymentSigningKeyShelley_ed25519" - , teDescription = "Payment Signing Key" - , teRawCBOR = addr - } - -readSigningKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey PaymentKey)) -readSigningKeyFile f = first ApiError <$> readFileTextEnvelopeAnyOf acceptedTypes f + teTemplate k = TextEnvelope { + teType = TextEnvelopeType "StakeVerificationKeyShelley_ed25519" + , teDescription = "Stake Verification Key" + , teRawCBOR = k + } + +parseBase16 :: BS.ByteString -> Either TxGenError BS.ByteString +parseBase16 + = first (const $ TxGenError "parseBase16: ill-formed base16 encoding") + . Base16.decode + +parseSigningKeyBase16 + :: HasTextEnvelope (SigningKey k) + => AsType k + -> [FromSomeType HasTextEnvelope (SigningKey k)] + -> BS.ByteString -> TextEnvelope -> Either TxGenError (SigningKey k) +parseSigningKeyBase16 k paymentKeys key te = do + key' <- parseBase16 key + let te' = te {teRawCBOR = key'} + first ApiError $ if null paymentKeys + then deserialiseFromTextEnvelope (AsSigningKey k) te' + else deserialiseFromTextEnvelopeAnyOf paymentKeys te' + +readPaymentKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey PaymentKey)) +readPaymentKeyFile f = first ApiError <$> readFileTextEnvelopeAnyOf acceptedTypes f + +readDRepKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey DRepKey)) +readDRepKeyFile f = first ApiError <$> readKeyFileTextEnvelope (AsSigningKey AsDRepKey) f + +readStakeKeyFile :: VerificationKeyFile In -> IO (Either TxGenError (VerificationKey StakeKey)) +readStakeKeyFile f = first ApiError <$> readKeyFileTextEnvelope (AsVerificationKey AsStakeKey) f acceptedTypes :: [FromSomeType HasTextEnvelope (SigningKey PaymentKey)] acceptedTypes = 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 741fbe2794d..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 #-} @@ -21,6 +20,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 +129,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..5edb59392a1 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 (readPaymentKeyFile $ _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/test/Bench.hs b/bench/tx-generator/test/Bench.hs index ec35408a6e1..586f36c60db 100644 --- a/bench/tx-generator/test/Bench.hs +++ b/bench/tx-generator/test/Bench.hs @@ -18,7 +18,7 @@ main = defaultMain [ bench "tx-gen" $ whnfIO do envConsts <- atomically do newEnvConsts (error "No IOManager!") Nothing - runSelftest emptyEnv envConsts Nothing >>= \case + runSelftest emptyEnv envConsts False Nothing >>= \case Right _ -> pure () Left err -> error $ show err ] diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index b8275a8da51..f2d9fe570b0 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -67,6 +67,7 @@ library Cardano.Benchmarking.Script.Aeson Cardano.Benchmarking.Script.Core Cardano.Benchmarking.Script.Env + Cardano.Benchmarking.Script.Queries Cardano.Benchmarking.Script.Selftest Cardano.Benchmarking.Script.Types Cardano.Benchmarking.TpsThrottle @@ -117,14 +118,17 @@ library , cardano-ledger-api , cardano-ledger-byron , cardano-ledger-core + , cardano-ledger-conway , cardano-node , cardano-prelude , contra-tracer , cborg >= 0.2.2 && < 0.3 , containers , constraints-extras + , directory , dlist , extra + , filepath , formatting , generic-monoid , ghc-prim @@ -160,7 +164,9 @@ library , yaml default-language: Haskell2010 - default-extensions: OverloadedStrings + default-extensions: BlockArguments + LambdaCase + OverloadedStrings executable tx-generator import: project-config diff --git a/nix/nixos/tx-generator-service.nix b/nix/nixos/tx-generator-service.nix index 1d76c50cb95..9f159ee65cb 100644 --- a/nix/nixos/tx-generator-service.nix +++ b/nix/nixos/tx-generator-service.nix @@ -42,6 +42,7 @@ let inherit add_tx_size debugMode + drep_voting init_cooldown inputs_per_tx localNodeSocketPath @@ -99,6 +100,8 @@ in pkgs.commonLib.defServiceModule redeemer = mayOpt attrs "Plutus script redeemer."; }; + drep_voting = mayOpt bool "Activate DRep voting workload (mutually excl. with plutus)"; + # Overrides the usage of Nix Store paths by default. plutusRedeemerFile = mayOpt str "Plutus redeemer file path."; plutusDatumFile = mayOpt str "Plutus datum file path."; diff --git a/nix/workbench/genesis/genesis.sh b/nix/workbench/genesis/genesis.sh index 7c42cf9f860..6f26d7598ea 100644 --- a/nix/workbench/genesis/genesis.sh +++ b/nix/workbench/genesis/genesis.sh @@ -737,8 +737,14 @@ genesis-create-testnet-data() { info genesis "removing delegator keys." rm "$dir/stake-delegators" -rf - info genesis "removing dreps keys." - rm "$dir"/drep-keys -rf + local is_voting + is_voting=$(jq --raw-output '.generator.drep_voting' "$profile_json") + if [[ "$is_voting" == "true" ]]; + then info genesis "voting workload specified - skipping deletion of DRep keys" + else + info genesis "removing dreps keys." + rm "$dir"/drep-keys -rf + fi info genesis "moving keys" Massage_the_key_file_layout_to_match_AWS "$profile_json" "$node_specs" "$dir" diff --git a/nix/workbench/profile/prof1-variants.jq b/nix/workbench/profile/prof1-variants.jq index a46a29f9124..712bac716ba 100644 --- a/nix/workbench/profile/prof1-variants.jq +++ b/nix/workbench/profile/prof1-variants.jq @@ -426,6 +426,14 @@ def all_profile_variants: { filters: ["size-small"] } }) as $plutus_base + | + ({ extra_desc: "with DRep voting workload" + , generator: + { inputs_per_tx: 1 + , outputs_per_tx: 1 + , drep_voting: true + } + }) as $voting_base | ({ generator: { plutus: @@ -1530,6 +1538,11 @@ def all_profile_variants: { name: "chainsync-early-alonzo-p2p" } + ## development profile for voting workload: PV9, Conway costmodel, 1000 DReps injected + , $cibench_base * $voting_base * $double_plus_tps_saturation_plutus * $genesis_voltaire * $costmodel_v10_preview * $dreps_small * + { name: "development-voting" + } + ## Last, but not least, the profile used by "nix-shell -A devops": , { name: "devops" , scenario: "idle" diff --git a/wb_profiles.mk b/wb_profiles.mk index b4c52a9f432..fd47aff71c4 100644 --- a/wb_profiles.mk +++ b/wb_profiles.mk @@ -9,6 +9,7 @@ PROFILES_LEGACY := ci-test-dense10 dish dish-10M dish-plutus dish-10M-plutus PROFILES_SCALING := faststartup-24M PROFILES_NOMAD_PERF := value-nomadperf value-nomadperf-nop2p value-drep1k-nomadperf value-drep2k-nomadperf value-drep10k-nomadperf value-drep100k-nomadperf value-oldtracing-nomadperf value-oldtracing-nomadperf-nop2p value-volt-nomadperf plutus-nomadperf plutus-nomadperf-nop2p plutus-drep1k-nomadperf plutus-drep2k-nomadperf plutus-drep10k-nomadperf plutus-drep100k-nomadperf plutus24-nomadperf plutus-secp-ecdsa-nomadperf plutus-secp-schnorr-nomadperf plutusv3-blst-nomadperf plutusv3-blst-double-nomadperf plutusv3-blst-half-nomadperf plutus-volt-nomadperf fast-nomadperf fast-nomadperf-nop2p ci-test-nomadperf ci-test-nomadperf-nop2p ci-test-oldtracing-nomadperf default-nomadperf-nop2p default-nomadperf oldtracing-nomadperf oldtracing-nomadperf-nop2p ci-bench-nomadperf ci-bench-nomadperf-nop2p ci-bench-oldtracing-nomadperf PROFILES_NOMAD_PERFSSD := utxoscale-solo-12M16G-nomadperfssd utxoscale-solo-12M64G-nomadperfssd utxoscale-solo-24M64G-nomadperfssd fast-nomadperfssd value-nomadperfssd +PROFILES_DEV := development-voting LOCAL_PROFILES += $(PROFILES_EMPTY) LOCAL_PROFILES += $(PROFILES_MINIATURE) @@ -21,3 +22,4 @@ LOCAL_PROFILES += $(PROFILES_LEGACY) LOCAL_PROFILES += $(PROFILES_SCALING) CLOUD_PROFILES += $(PROFILES_NOMAD_PERF) CLOUD_PROFILES += $(PROFILES_NOMAD_PERFSSD) +LOCAL_PROFILES += $(PROFILES_DEV)