Skip to content

Commit fd7f5d5

Browse files
carbolymercarbolymer
committed
update
1 parent df38349 commit fd7f5d5

11 files changed

Lines changed: 203 additions & 217 deletions

File tree

‎bench/tx-generator/app/calibrate-script.hs‎

Lines changed: 90 additions & 70 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,10 @@
1111
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
1212

1313
import Cardano.Api
14+
import Cardano.Api.Experimental (SignedTx (..), Witnessable (..), legacyWitnessConversion,
15+
makeKeyWitness, makeUnsignedTx, obtainCommonConstraints, sbeToEra, signTx)
16+
import qualified Cardano.Api.Experimental as Exp (evaluateTransactionFee)
17+
import qualified Cardano.Api.Experimental.Tx as Exp
1418

1519
import Cardano.Benchmarking.Compiler (keyBenchmarkInputs)
1620
import Cardano.Benchmarking.GeneratorTx.SizedMetadata (mkMetadata)
@@ -19,8 +23,8 @@ import Cardano.Benchmarking.PlutusScripts (listPlutusScripts)
1923
#endif
2024
import Cardano.TxGenerator.Calibrate.Utils
2125
import Cardano.TxGenerator.PlutusContext
22-
import Cardano.TxGenerator.ProtocolParameters ( ProtocolParameters (..), convertToLedgerProtocolParameters,
23-
toLedgerPParams)
26+
import Cardano.TxGenerator.ProtocolParameters (ProtocolParameters (..),
27+
convertToLedgerProtocolParameters, toLedgerPParams)
2428
import Cardano.TxGenerator.Setup.Plutus
2529
import Cardano.TxGenerator.Tx (txSizeInBytes)
2630
import Cardano.TxGenerator.Types
@@ -33,7 +37,6 @@ import Data.Char
3337
import Data.Function (on, (&))
3438
import Data.List (nub, sort, transpose)
3539
import Data.List.Extra (split)
36-
3740
import Data.Map.Strict as Map (Map, empty, fromList, union)
3841
import Data.Maybe
3942
import qualified Data.Text as T
@@ -485,71 +488,88 @@ writeResultsJSON jsonName summaries = do
485488
approximateTxProperties :: ScriptInAnyLang -> ProtocolParameters -> (PlutusBudgetSummary, ScriptRedeemer) -> IO PlutusBudgetSummary
486489
approximateTxProperties script protocolParameters (summary, redeemer) = do
487490
putStrLn $ "--> approximating txn size and fee for: " ++ messageId summary
488-
evaluate $ summary
489-
{ projectedTxSize = Just $ txSizeInBytes dummyTx
490-
, projectedTxFee = Just $ evaluateTransactionFee era ledgerPParams2 (getTxBody dummyTx) 2 0 0 -- 1 (script witness) + 1 (collateral) = 2
491-
}
492-
493-
`catch` \(SomeException e) -> do
494-
putStrLn $ "approximation failed: " ++ show e
495-
++ "\n--> using unmodified summary"
496-
pure summary
497-
where
498-
era = ShelleyBasedEraConway
499-
500-
ledgerPParams1 :: LedgerProtocolParameters ConwayEra
501-
ledgerPParams1 =
502-
either (error . docToString . prettyError) id
503-
$ convertToLedgerProtocolParameters era protocolParameters
504-
505-
ledgerPParams2 =
506-
either (error . docToString . prettyError) id
507-
$ toLedgerPParams era protocolParameters
508-
509-
witness :: Witness WitCtxTxIn ConwayEra
510-
witness =
511-
fromMaybe (error "could not get PlutusScriptWitness")
512-
$ case script of
513-
ScriptInAnyLang lang (PlutusScript version script') -> do
514-
scriptLang <- scriptLanguageSupportedInEra era lang
515-
pure
516-
$ ScriptWitness ScriptWitnessForSpending
517-
$ PlutusScriptWitness
518-
scriptLang
519-
version
520-
(PScript script')
521-
(ScriptDatumForTxIn $ Just $ unsafeHashableScriptData $ ScriptDataNumber 0)
522-
redeemer
523-
(budgetUsedPerTxInput summary)
524-
_ -> Nothing
525-
526-
-- build a dummy tx akin to what we'd get in the tx-generator's benchmarking workload;
527-
-- it just needs to be sufficient to get our approximations.
528-
dummyTx :: Tx ConwayEra
529-
dummyTx
530-
= signShelleyTransaction era txbody [WitnessPaymentKey keyBenchmarkInputs]
531-
where
532-
txbody =
533-
either (error . docToString . prettyError) id
534-
$ createTransactionBody era content
535-
536-
content =
537-
defaultTxBodyContent era
538-
& setTxIns [(dummyTxIn 0, BuildTxWith witness)]
539-
& setTxInsCollateral (TxInsCollateral AlonzoEraOnwardsConway [dummyTxIn 1])
540-
& setTxOuts [dummyTxOut]
541-
& setTxValidityLowerBound TxValidityNoLowerBound
542-
& setTxValidityUpperBound (defaultTxValidityUpperBound era)
543-
& setTxMetadata dummyMetadata
544-
& setTxFee (TxFeeExplicit era 1_000_000)
545-
& setTxProtocolParams (BuildTxWith (Just ledgerPParams1))
546-
547-
-- Corresponds to the metadata inserted in benchmarking workloads, which is why it's needed for the estimate.
548-
-- default value taken from: `add_tx_size` in nix/nixos/tx-generator-service.nix
549-
dummyMetadata :: TxMetadataInEra ConwayEra
550-
dummyMetadata = either error id $ mkMetadata 100
551-
552-
-- just placeholders
553-
dummyTxIn ix = mkTxIn $ "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162#" <> textShow @Int ix
554-
dummyTxOut = TxOut (keyAddress (Testnet (NetworkMagic 42)) keyBenchmarkInputs) (lovelaceToTxOutValue era 1_000_000) TxOutDatumNone ReferenceScriptNone
491+
case sbeToEra shelleyBasedEra of
492+
Left _ -> do
493+
putStrLn "approximation failed: unsupported era\n--> using unmodified summary"
494+
pure summary
495+
Right expEra ->
496+
obtainCommonConstraints expEra $
497+
let
498+
ledgerPParams =
499+
either (error . docToString . prettyError) id
500+
$ toLedgerPParams shelleyBasedEra protocolParameters
501+
502+
ledgerProtocolParameters :: LedgerProtocolParameters ConwayEra
503+
ledgerProtocolParameters =
504+
either (error . docToString . prettyError) id
505+
$ convertToLedgerProtocolParameters shelleyBasedEra protocolParameters
506+
507+
witness :: Witness WitCtxTxIn ConwayEra
508+
witness =
509+
fromMaybe (error "could not get PlutusScriptWitness")
510+
$ case script of
511+
ScriptInAnyLang lang (PlutusScript version script') -> do
512+
scriptLang <- scriptLanguageSupportedInEra shelleyBasedEra lang
513+
pure
514+
$ ScriptWitness ScriptWitnessForSpending
515+
$ PlutusScriptWitness
516+
scriptLang
517+
version
518+
(PScript script')
519+
(ScriptDatumForTxIn $ Just $ unsafeHashableScriptData $ ScriptDataNumber 0)
520+
redeemer
521+
(budgetUsedPerTxInput summary)
522+
_ -> Nothing
523+
524+
anyWitness =
525+
case legacyWitnessConversion AlonzoEraOnwardsConway [(WitTxIn (dummyTxIn 0), BuildTxWith witness)] of
526+
Right [(_, w)] -> w
527+
Right _ -> error "approximateTxProperties: unexpected witness conversion result"
528+
Left err -> error $ "approximateTxProperties: witness conversion failed: " ++ show err
529+
530+
expMetadata = case dummyMetadata of
531+
TxMetadataNone -> mempty
532+
TxMetadataInEra _ m -> m
533+
534+
-- build a dummy tx akin to what we'd get in the tx-generator's benchmarking workload;
535+
-- it just needs to be sufficient to get our approximations.
536+
txBodyContent =
537+
Exp.defaultTxBodyContent
538+
& Exp.setTxIns [(dummyTxIn 0, anyWitness)]
539+
& Exp.setTxInsCollateral [dummyTxIn 1]
540+
& Exp.setTxOuts [Exp.TxOut $ toShelleyTxOutAny shelleyBasedEra dummyTxOut]
541+
& Exp.setTxFee (Coin 1_000_000)
542+
& Exp.setTxMetadata expMetadata
543+
& Exp.setTxProtocolParams (unLedgerProtocolParameters ledgerProtocolParameters)
544+
545+
unsignedTx =
546+
either (\err -> error $ "approximateTxProperties: " ++ show err) id
547+
$ makeUnsignedTx expEra txBodyContent
548+
549+
witVKey = makeKeyWitness expEra unsignedTx (WitnessPaymentKey keyBenchmarkInputs)
550+
551+
dummyTx :: Tx ConwayEra
552+
dummyTx =
553+
case signTx expEra [] [witVKey] unsignedTx of
554+
SignedTx signedLedgerTx -> ShelleyTx shelleyBasedEra signedLedgerTx
555+
556+
-- Corresponds to the metadata inserted in benchmarking workloads, which is why it's needed for the estimate.
557+
-- default value taken from: `add_tx_size` in nix/nixos/tx-generator-service.nix
558+
dummyMetadata :: TxMetadataInEra ConwayEra
559+
dummyMetadata = either error id $ mkMetadata 100
560+
561+
-- just placeholders
562+
dummyTxIn ix = mkTxIn $ "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162#" <> textShow @Int ix
563+
dummyTxOut = TxOut (keyAddress (Testnet (NetworkMagic 42)) keyBenchmarkInputs) (lovelaceToTxOutValue shelleyBasedEra 1_000_000) TxOutDatumNone ReferenceScriptNone
564+
in
565+
evaluate
566+
( summary
567+
{ projectedTxSize = Just $ txSizeInBytes dummyTx
568+
, projectedTxFee = Just $ Exp.evaluateTransactionFee ledgerPParams unsignedTx 2 0 0 -- 1 (script witness) + 1 (collateral) = 2
569+
}
570+
)
571+
`catch` \(SomeException e) -> do
572+
putStrLn $ "approximation failed: " ++ show e
573+
++ "\n--> using unmodified summary"
574+
pure summary
555575

‎bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs‎

Lines changed: 18 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -3,23 +3,23 @@
33
{-# LANGUAGE GADTs #-}
44
{-# LANGUAGE ScopedTypeVariables #-}
55
{-# LANGUAGE TypeApplications #-}
6-
76
module Cardano.Benchmarking.GeneratorTx.SizedMetadata
87
where
98

109
import Cardano.Api
10+
import Cardano.Api.Experimental (AnyWitness (..), SignedTx (..), makeUnsignedTx,
11+
obtainCommonConstraints, sbeToEra, signTx)
12+
import qualified Cardano.Api.Experimental.Tx as Exp
1113

12-
import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
13-
import qualified Cardano.Ledger.Core as L
1414
import Cardano.TxGenerator.Utils
1515

1616
import Prelude
1717

1818
import qualified Data.ByteString as BS
19+
import Data.Either (fromRight)
1920
import Data.Function ((&))
2021
import qualified Data.Map.Strict as Map
2122
import Data.Word (Word64)
22-
import Lens.Micro ((.~), (^.))
2323

2424

2525
maxMapSize :: Int
@@ -117,25 +117,23 @@ measureBSCosts era = map (metadataSize era . Just . bsMetadata) [0..maxBSSize]
117117
metadataSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
118118
metadataSize p m = dummyTxSize p m - dummyTxSize p Nothing
119119

120-
dummyTxSizeInEra :: forall era. IsShelleyBasedEra era => TxMetadataInEra era -> Int
121-
dummyTxSizeInEra metadata =
122-
BS.length $ serialiseToCBOR dummyTx
120+
dummyTxSizeInEra :: forall era . IsShelleyBasedEra era => TxMetadataInEra era -> Int
121+
dummyTxSizeInEra metadata = BS.length $ serialiseToCBOR dummyTx
123122
where
124123
sbe = shelleyBasedEra @era
125-
txInputs =
126-
[ ( mkTxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810#0"
127-
, BuildTxWith $ KeyWitness KeyWitnessForSpending
128-
)
129-
]
130-
txAuxData = toAuxiliaryData sbe metadata TxAuxScriptsNone
131-
ledgerTxBody =
132-
mkCommonTxBody sbe txInputs [] (mkTxFee 0) TxWithdrawalsNone txAuxData
133-
& invalidHereAfterTxBodyL sbe .~ convValidityUpperBound sbe (mkTxValidityUpperBound 0)
124+
era = fromRight (error "dummyTxSizeInEra: unsupported era") $ sbeToEra sbe
125+
expMetadata = case metadata of
126+
TxMetadataNone -> mempty
127+
TxMetadataInEra _ m -> m
128+
txBodyContent = Exp.defaultTxBodyContent
129+
& Exp.setTxIns [(mkTxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810#0", AnyKeyWitnessPlaceholder)]
130+
& Exp.setTxMetadata expMetadata
134131
dummyTx :: Tx era
135-
dummyTx = shelleyBasedEraConstraints sbe $
136-
ShelleyTx sbe $
137-
L.mkBasicTx (ledgerTxBody ^. txBodyL)
138-
& L.auxDataTxL .~ maybeToStrictMaybe txAuxData
132+
dummyTx = obtainCommonConstraints era $
133+
case signTx era [] [] unsignedTx of
134+
SignedTx signedLedgerTx -> ShelleyTx sbe signedLedgerTx
135+
where
136+
unsignedTx = fromRight (error "dummyTxSizeInEra: failed to create tx") $ makeUnsignedTx era txBodyContent
139137

140138
dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
141139
dummyTxSize _p m = (dummyTxSizeInEra @era) $ metadataInEra m

‎bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ import Cardano.Logging
3232
import Cardano.Prelude hiding (ByteString, atomically, retry, state, threadDelay)
3333
import qualified Ouroboros.Consensus.Cardano as Consensus (CardanoBlock)
3434
import qualified Ouroboros.Consensus.Cardano.Block as Block
35-
(TxId (GenTxIdAllegra, GenTxIdAlonzo, GenTxIdBabbage, GenTxIdConway, GenTxIdMary, GenTxIdShelley))
35+
(TxId (GenTxIdAllegra, GenTxIdAlonzo, GenTxIdBabbage, GenTxIdByron, GenTxIdConway, GenTxIdDijkstra, GenTxIdMary, GenTxIdShelley))
3636
import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
3737
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Mempool
3838
import Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
@@ -188,7 +188,8 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
188188
fromGenTxId (Block.GenTxIdAlonzo (Mempool.ShelleyTxId i)) = fromShelleyTxId i
189189
fromGenTxId (Block.GenTxIdBabbage (Mempool.ShelleyTxId i)) = fromShelleyTxId i
190190
fromGenTxId (Block.GenTxIdConway (Mempool.ShelleyTxId i)) = fromShelleyTxId i
191-
fromGenTxId _ = error "TODO: fix incomplete match"
191+
fromGenTxId (Block.GenTxIdDijkstra (Mempool.ShelleyTxId i)) = fromShelleyTxId i
192+
fromGenTxId (Block.GenTxIdByron _) = error "TODO: fix incomplete match"
192193

193194
txIdFromTx :: Tx era -> TxId
194195
txIdFromTx (ShelleyTx sbe tx) =

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

Lines changed: 8 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -317,7 +317,7 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do
317317
let
318318
fundSource = walletSource wallet 1
319319
inToOut = Utils.includeChange fee coins
320-
txGenerator = genTx shelleyBasedEra ledgerParameters (TxInsCollateralNone, []) feeInEra TxMetadataNone
320+
txGenerator = genTx shelleyBasedEra ledgerParameters ([], []) fee TxMetadataNone
321321
sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut $ mangleWithChange toUTxOChange toUTxO
322322
return $ Streaming.effect (Streaming.yield <$> sourceToStore)
323323

@@ -333,7 +333,7 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do
333333
let
334334
fundSource = walletSource wallet 1
335335
inToOut = Utils.inputsToOutputsWithFee fee count
336-
txGenerator = genTx shelleyBasedEra ledgerParameters (TxInsCollateralNone, []) feeInEra TxMetadataNone
336+
txGenerator = genTx shelleyBasedEra ledgerParameters ([], []) fee TxMetadataNone
337337
sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut (mangle $ repeat toUTxO)
338338
return $ Streaming.effect (Streaming.yield <$> sourceToStore)
339339

@@ -345,7 +345,7 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do
345345
let
346346
fundSource = walletSource wallet inputs
347347
inToOut = Utils.inputsToOutputsWithFee fee outputs
348-
txGenerator = genTx shelleyBasedEra ledgerParameters collaterals feeInEra (toMetadata metadataSize)
348+
txGenerator = genTx shelleyBasedEra ledgerParameters collaterals fee (toMetadata metadataSize)
349349
sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut (mangle $ repeat toUTxO)
350350

351351
fundPreview <- liftIO $ walletPreview wallet inputs
@@ -386,21 +386,16 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do
386386

387387
OneOf _l -> error "todo: implement Quickcheck style oneOf generator"
388388

389-
where
390-
feeInEra = Utils.mkTxFee fee
391-
392-
selectCollateralFunds :: forall era. IsShelleyBasedEra era
393-
=> Maybe String
394-
-> ActionM (TxInsCollateral era, [FundQueue.Fund])
395-
selectCollateralFunds Nothing = return (TxInsCollateralNone, [])
389+
selectCollateralFunds ::
390+
Maybe String
391+
-> ActionM ([TxIn], [FundQueue.Fund])
392+
selectCollateralFunds Nothing = return ([], [])
396393
selectCollateralFunds (Just walletName) = do
397394
cw <- getEnvWallets walletName
398395
collateralFunds <- liftIO ( askWalletRef cw FundQueue.toList ) >>= \case
399396
[] -> throwE $ WalletError "selectCollateralFunds: emptylist"
400397
l -> return l
401-
case forEraMaybeEon (cardanoEra @era) of
402-
Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show (cardanoEra @era)
403-
Just p -> return (TxInsCollateral p $ map getFundTxIn collateralFunds, collateralFunds)
398+
return (map getFundTxIn collateralFunds, collateralFunds)
404399

405400
dumpToFile :: FilePath -> TxInMode -> ActionM ()
406401
dumpToFile filePath tx = liftIO $ dumpToFileIO filePath tx

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ import Paths_tx_generator
4343
-- does 'show' and 'writeFile' on.
4444
runSelftest :: Env -> EnvConsts -> Maybe FilePath -> IO (Either Env.Error ())
4545
runSelftest env envConsts@EnvConsts { .. } outFile = do
46-
protocolFile <- getDataFileName "data/protocol-parameters.json"
46+
protocolFile <- getDataFileName "data/protocol-parameters-v10.json"
4747
let
4848
submitMode = maybe DiscardTX DumpToFile outFile
4949
fullScript = do
@@ -100,7 +100,7 @@ testScript protocolFile submitMode =
100100
, teDescription = fromString "Genesis Initial UTxO Signing Key"
101101
, teRawCBOR = "X \vl1~\182\201v(\152\250A\202\157h0\ETX\248h\153\171\SI/m\186\242D\228\NAK\182(&\162"
102102
}
103-
era = AnyCardanoEra AllegraEra
103+
era = AnyCardanoEra ConwayEra
104104
txParams = defaultTxGenTxParams {txParamFee = 1000000}
105105
genesisWallet = "genesisWallet"
106106
splitWallet1 = "SplitWallet-1"

‎bench/tx-generator/src/Cardano/TxGenerator/Fund.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -85,6 +85,7 @@ getFundWitness fund = case (cardanoEra @era, fund) of
8585
(AlonzoEra , Fund (InAnyCardanoEra AlonzoEra a)) -> _fundWitness a
8686
(BabbageEra , Fund (InAnyCardanoEra BabbageEra a)) -> _fundWitness a
8787
(ConwayEra , Fund (InAnyCardanoEra ConwayEra a)) -> _fundWitness a
88+
(DijkstraEra, Fund (InAnyCardanoEra DijkstraEra a)) -> _fundWitness a
8889
_ -> error "getFundWitness: era mismatch"
8990

9091
{-

0 commit comments

Comments
 (0)