tx-generator: Implement governance action / voting workload

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,

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
@@ -72,7 +71,7 @@ data Command
   = Json FilePath
   | JsonHL FilePath (Maybe FilePath) (Maybe FilePath)
   | Compile FilePath
-  | Selftest (Maybe FilePath)
+  | Selftest Bool (Maybe FilePath)          -- True for selftesting the voting workload; specifying an optional file for dumping txns via Show
   | VersionCmd
 
 runCommand :: IO ()
@@ -83,7 +82,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
@@ -99,6 +98,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
@@ -107,7 +108,7 @@ runCommand' iocp = do
       case compileOptions o of
         Right script -> BSL.putStr $ prettyPrint script
         Left err -> die $ "tx-generator:Cardano.Command.runCommand Compile: " ++ show err
-    Selftest outFile -> runSelftest emptyEnv envConsts outFile >>= handleError
+    Selftest doVoting outFile -> runSelftest emptyEnv envConsts doVoting outFile >>= handleError
     VersionCmd -> runVersionCommand
   where
   handleError :: Show a => Either a b -> IO ()
@@ -212,14 +213,14 @@ commandParser
        cmdParser "json" jsonCmd "Run a generic benchmarking script."
     <> cmdParser "json_highlevel" jsonHLCmd "Run the tx-generator using a flat config."
     <> cmdParser "compile" compileCmd "Compile flat-options to benchmarking script."
-    <> cmdParser "selftest" selfTestCmd "Run a build-in selftest."
+    <> cmdParser "selftest" selfTestCmd "Run a built-in selftest."
     <> cmdParser "version" versionCmd "Show the tx-generator version"
        )
  where
-  cmdParser cmd parser description = command cmd $ info parser $ progDesc description
+  cmdParser cmd parser description = command cmd $ info (parser <**> helper) $ progDesc description
 
   filePath :: String -> Parser String
-  filePath helpMsg = strArgument (metavar "FILEPATH" <> help helpMsg)
+  filePath helpMsg = strArgument (metavar "FILE" <> completer (bashCompleter "file") <> help helpMsg)
 
   jsonCmd :: Parser Command
   jsonCmd = Json <$> filePath "low-level benchmarking script"
@@ -231,13 +232,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"
     )

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"

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

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 #-}

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 #-}

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
 

bench/tx-generator/src/Cardano/Benchmarking/Script.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RecordWildCards #-}
 

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

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