Fmaste/voting 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,

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 #-}
@@ -72,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 ()
@@ -83,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
@@ -107,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 ()
@@ -212,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"
@@ -231,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"
     )

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,11 @@ compileToScript = do
         pure
   tc <- askNixOption _nix_cardanoTracerSocket
   emit $ StartProtocol nc tc
+
+  whenM (fromMaybe False <$> askNixOption _nix_drep_voting) do
+    emit $ ReadDRepKeys nc
+    logMsg "Importing DRep SigningKeys. Done."
+
   genesisWallet <- importGenesisFunds
   collateralWallet <- addCollaterals genesisWallet
   splitWallet <- splittingPhase genesisWallet

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/Script.hs

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

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

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 #-}
@@ -46,6 +45,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 +63,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 +92,24 @@ 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 <- 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
   fundKey  <- getEnvKeys keyName
@@ -384,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
 

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,6 +41,8 @@ module Cardano.Benchmarking.Script.Env (
         , traceBenchTxSubmit
         , getBenchTracers
         , setBenchTracers
+        , getEnvDRepKeys
+        , setEnvDRepKeys
         , getEnvGenesis
         , setEnvGenesis
         , getEnvKeys
@@ -63,7 +63,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 +108,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 +122,7 @@ emptyEnv = Env { protoParams = Nothing
                , envSocketPath = Nothing
                , envWallets = Map.empty
                , envSummary = Nothing
+               , envDRepKeys = []
                }
 
 newEnvConsts :: IOManager -> Maybe Nix.NixServiceOptions -> STM Tracer.EnvConsts
@@ -197,6 +199,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 +278,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"

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 $ <Proposal constructor>
+
+  , Submit era submitMode txParams
+      EmptyStream
+      -- TODO: instead, create 8(?) vote transactions using the new constructor for Generator
+      -- $ Take 8 $ Cycle $ <Vote constructor>
+
+  ]
+  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"

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)
@@ -90,6 +89,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
@@ -169,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
 

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

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 module Cardano.Benchmarking.TpsThrottle
 where