Skip to content

Commit

Permalink
Merge pull request #1447 from input-output-hk/lc/remove-benchmark-fees
Browse files Browse the repository at this point in the history
Remove redundant fee calculation.
  • Loading branch information
locallycompact authored May 22, 2024
2 parents d82a44f + 6f0600d commit 13e596f
Show file tree
Hide file tree
Showing 4 changed files with 11 additions and 47 deletions.
12 changes: 1 addition & 11 deletions hydra-cluster/bench/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,11 +9,6 @@ import Bench.EndToEnd (bench)
import Bench.Options (Options (..), benchOptionsParser)
import Bench.Summary (Summary (..), markdownReport, textReport)
import Data.Aeson (eitherDecodeFileStrict', encodeFile)
import Hydra.Cardano.Api (
ShelleyBasedEra (..),
ShelleyGenesis (..),
fromLedgerPParams,
)
import Hydra.Generator (Dataset (..), generateConstantUTxODataset)
import Options.Applicative (execParser)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
Expand Down Expand Up @@ -42,12 +37,7 @@ main =
play outputDirectory timeoutSeconds scalingFactor clusterSize startingNodeId workDir = do
putStrLn $ "Generating single dataset in work directory: " <> workDir
numberOfTxs <- generate $ scale (* scalingFactor) getSize
pparams <-
eitherDecodeFileStrict' ("config" </> "devnet" </> "genesis-shelley.json") >>= \case
Left err -> fail $ show err
Right shelleyGenesis ->
pure $ fromLedgerPParams ShelleyBasedEraShelley (sgProtocolParams shelleyGenesis)
dataset <- generateConstantUTxODataset pparams (fromIntegral clusterSize) numberOfTxs
dataset <- generateConstantUTxODataset (fromIntegral clusterSize) numberOfTxs
let datasetPath = workDir </> "dataset.json"
saveDataset datasetPath dataset
run outputDirectory timeoutSeconds startingNodeId [datasetPath]
Expand Down
32 changes: 5 additions & 27 deletions hydra-cluster/src/CardanoClient.hs
Original file line number Diff line number Diff line change
Expand Up @@ -34,28 +34,12 @@ buildScriptAddress script networkId =
in makeShelleyAddress networkId (PaymentCredentialByScript hashed) NoStakeAddress

-- | Build a "raw" transaction from a bunch of inputs, outputs and fees.
buildRaw :: [TxIn] -> [TxOut CtxTx] -> Coin -> Either TxBodyError TxBody
buildRaw ins outs fee =
buildRaw :: [TxIn] -> [TxOut CtxTx] -> Either TxBodyError TxBody
buildRaw ins outs =
createAndValidateTransactionBody $
defaultTxBodyContent
& setTxIns (map (,BuildTxWith $ KeyWitness KeyWitnessForSpending) ins)
& setTxOuts outs
& setTxFee (TxFeeExplicit fee)

calculateMinFee :: NetworkId -> TxBody -> Sizes -> ProtocolParameters -> Coin
calculateMinFee networkId body Sizes{inputs, outputs, witnesses} pparams =
let tx = makeSignedTransaction [] body
noByronWitnesses = 0
in estimateTransactionFee
shelleyBasedEra
networkId
(protocolParamTxFeeFixed pparams)
(protocolParamTxFeePerByte pparams)
tx
inputs
outputs
noByronWitnesses
witnesses

data Sizes = Sizes
{ inputs :: Int
Expand Down Expand Up @@ -126,16 +110,15 @@ waitForUTxO networkId nodeSocket utxo =

mkGenesisTx ::
NetworkId ->
ProtocolParameters ->
-- | Owner of the 'initialFund'.
SigningKey PaymentKey ->
-- | Amount of initialFunds
Coin ->
-- | Recipients and amounts to pay in this transaction.
[(VerificationKey PaymentKey, Coin)] ->
Tx
mkGenesisTx networkId pparams signingKey initialAmount recipients =
case buildRaw [initialInput] (recipientOutputs <> [changeOutput]) fee of
mkGenesisTx networkId signingKey initialAmount recipients =
case buildRaw [initialInput] (recipientOutputs <> [changeOutput]) of
Left err -> error $ "Fail to build genesis transations: " <> show err
Right tx -> sign signingKey tx
where
Expand All @@ -144,18 +127,13 @@ mkGenesisTx networkId pparams signingKey initialAmount recipients =
networkId
(unsafeCastHash $ verificationKeyHash $ getVerificationKey signingKey)

fee = calculateMinFee networkId rawTx Sizes{inputs = 1, outputs = length recipients + 1, witnesses = 1} pparams
rawTx = case buildRaw [initialInput] [] 0 of
Left err -> error $ "Fail to build genesis transactions: " <> show err
Right tx -> tx

totalSent = foldMap snd recipients

changeAddr = mkVkAddress networkId (getVerificationKey signingKey)
changeOutput =
TxOut
changeAddr
(lovelaceToValue $ initialAmount - totalSent - fee)
(lovelaceToValue $ initialAmount - totalSent)
TxOutDatumNone
ReferenceScriptNone

Expand Down
11 changes: 4 additions & 7 deletions hydra-cluster/src/Hydra/Generator.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,7 @@ data Dataset = Dataset
instance Arbitrary Dataset where
arbitrary = sized $ \n -> do
sk <- genSigningKey
genDatasetConstantUTxO sk defaultProtocolParameters (n `div` 10) n
genDatasetConstantUTxO sk (n `div` 10) n

data ClientKeys = ClientKeys
{ signingKey :: SigningKey PaymentKey
Expand Down Expand Up @@ -79,26 +79,24 @@ defaultProtocolParameters = fromLedgerPParams ShelleyBasedEraShelley def
-- The sequence of transactions generated consist only of simple payments from
-- and to arbitrary keys controlled by the individual clients.
generateConstantUTxODataset ::
ProtocolParameters ->
-- | Number of clients
Int ->
-- | Number of transactions
Int ->
IO Dataset
generateConstantUTxODataset pparams nClients nTxs = do
generateConstantUTxODataset nClients nTxs = do
(_, faucetSk) <- keysFor Faucet
generate $ genDatasetConstantUTxO faucetSk pparams nClients nTxs
generate $ genDatasetConstantUTxO faucetSk nClients nTxs

genDatasetConstantUTxO ::
-- | The faucet signing key
SigningKey PaymentKey ->
ProtocolParameters ->
-- | Number of clients
Int ->
-- | Number of transactions
Int ->
Gen Dataset
genDatasetConstantUTxO faucetSk pparams nClients nTxs = do
genDatasetConstantUTxO faucetSk nClients nTxs = do
clientKeys <- replicateM nClients arbitrary
-- Prepare funding transaction which will give every client's
-- 'externalSigningKey' "some" lovelace. The internal 'signingKey' will get
Expand All @@ -109,7 +107,6 @@ genDatasetConstantUTxO faucetSk pparams nClients nTxs = do
let fundingTransaction =
mkGenesisTx
networkId
pparams
faucetSk
(Coin availableInitialFunds)
clientFunds
Expand Down
3 changes: 1 addition & 2 deletions hydra-cluster/test/Test/GeneratorSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@ import Hydra.Cluster.Util (keysFor)
import Hydra.Generator (
ClientDataset (..),
Dataset (..),
defaultProtocolParameters,
genDatasetConstantUTxO,
)
import Hydra.Ledger (ChainSlot (ChainSlot), applyTransactions)
Expand Down Expand Up @@ -46,7 +45,7 @@ prop_keepsUTxOConstant =
let ledgerEnv = newLedgerEnv defaultPParams
-- XXX: non-exhaustive pattern match
pure $
forAll (genDatasetConstantUTxO faucetSk defaultProtocolParameters 1 n) $
forAll (genDatasetConstantUTxO faucetSk 1 n) $
\Dataset{fundingTransaction, clientDatasets = [ClientDataset{txSequence}]} ->
let initialUTxO = utxoFromTx fundingTransaction
finalUTxO = foldl' (apply defaultGlobals ledgerEnv) initialUTxO txSequence
Expand Down

0 comments on commit 13e596f

Please sign in to comment.