Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

tx-generator: Implement governance action / voting workload #5999

Draft
wants to merge 9 commits into
base: master
Choose a base branch
from
Prev Previous commit
Next Next commit
tx-generator: drop deprecated API function; various improvements
This also sweeps LANGUAGE pragmas for explicit enabling of extensions
now enabled via default-extensions.
NadiaYvette authored and mgmeier committed Nov 26, 2024
commit cd037ce3c4b671d4623252d847f7cdfa1ddb4d2e
2 changes: 0 additions & 2 deletions bench/tx-generator/src/Cardano/Benchmarking/Command.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,5 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
5 changes: 2 additions & 3 deletions bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
@@ -18,6 +17,7 @@ import Cardano.TxGenerator.Types
import Prelude

import Control.Monad
import Control.Monad.Extra
import Control.Monad.Trans.RWS.CPS
import Data.ByteString as BS (ByteString)
import Data.DList (DList)
@@ -63,8 +63,7 @@ compileToScript = do
tc <- askNixOption _nix_cardanoTracerSocket
emit $ StartProtocol nc tc

isDrepVoting <- fromMaybe False <$> askNixOption _nix_drep_voting
when isDrepVoting $ do
whenM (fromMaybe False <$> askNixOption _nix_drep_voting) do
emit $ ReadDRepKeys nc
logMsg "Importing DRep SigningKeys. Done."

Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
@@ -4,7 +4,6 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
Original file line number Diff line number Diff line change
@@ -5,10 +5,8 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
2 changes: 0 additions & 2 deletions bench/tx-generator/src/Cardano/Benchmarking/Script.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,3 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RecordWildCards #-}

25 changes: 11 additions & 14 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
Original file line number Diff line number Diff line change
@@ -5,7 +5,6 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE PackageImports #-}
@@ -93,25 +92,23 @@ setProtocolParameters s = case s of

readSigningKey :: String -> SigningKeyFile In -> ActionM ()
readSigningKey name filePath =
liftIO (readSigningKeyFile filePath) >>= \case
Left err -> liftTxGenError err
Right key -> setEnvKeys name key
setEnvKeys name =<< liftIOSafe (readSigningKeyFile filePath)

defineSigningKey :: String -> SigningKey PaymentKey -> ActionM ()
defineSigningKey = setEnvKeys

readDRepKeys :: FilePath -> ActionM ()
readDRepKeys ncFile = do
genesis <- liftIO (mkNodeConfig ncFile) >>= either liftTxGenError (pure . getGenesisDirectory)
case genesis of
Nothing -> liftTxGenError $ TxGenError "readDRepKeys: no genesisDirectory could be retrieved from the node config"
-- "cache-entry" is a link or copy of the actual genesis folder created by "create-testnet-data"
-- in the workbench's run directory structure, this link or copy is created for each run - by workbench
Just d -> liftIO (Genesis.genesisLoadDRepKeys (d </> "cache-entry")) >>= \case
Left err -> liftTxGenError err
Right ks -> do
setEnvDRepKeys ks
traceDebug $ "DRep SigningKeys loaded: " ++ show (length ks) ++ " from: " ++ d
genesis <- onNothing throwKeyErr $ getGenesisDirectory <$> liftIOSafe (mkNodeConfig ncFile)
-- "cache-entry" is a link or copy of the actual genesis folder created by "create-testnet-data"
-- in the workbench's run directory structure, this link or copy is created for each run - by workbench
ks <- liftIOSafe . Genesis.genesisLoadDRepKeys $ genesis </> "cache-entry"
setEnvDRepKeys ks
traceDebug $ "DRep SigningKeys loaded: " ++ show (length ks) ++ " from: " ++ genesis
where
throwKeyErr = liftTxGenError . TxGenError $
"readDRepKeys: no genesisDirectory could "
<> "be retrieved from the node config"

addFund :: AnyCardanoEra -> String -> TxIn -> L.Coin -> String -> ActionM ()
addFund era wallet txIn lovelace keyName = do
2 changes: 0 additions & 2 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,6 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
{-# LANGUAGE LambdaCase #-}
module Cardano.Benchmarking.TpsThrottle
where

1 change: 0 additions & 1 deletion bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs
Original file line number Diff line number Diff line change
@@ -5,7 +5,6 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
Original file line number Diff line number Diff line change
@@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-|
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}

{-# OPTIONS_GHC -fno-warn-partial-fields -fno-warn-orphans #-}
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module provides convenience functions when dealing with signing keys.
module Cardano.TxGenerator.Setup.SigningKey
4 changes: 2 additions & 2 deletions bench/tx-generator/src/Cardano/TxGenerator/Tx.hs
Original file line number Diff line number Diff line change
@@ -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
1 change: 0 additions & 1 deletion bench/tx-generator/src/Cardano/TxGenerator/Types.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# OPTIONS_GHC -fno-warn-partial-fields #-}

3 changes: 2 additions & 1 deletion bench/tx-generator/tx-generator.cabal
Original file line number Diff line number Diff line change
@@ -162,7 +162,8 @@ library
, yaml

default-language: Haskell2010
default-extensions: LambdaCase
default-extensions: BlockArguments
LambdaCase
OverloadedStrings

executable tx-generator