Skip to content

Commit 24672d4

Browse files
carbolymercarbolymer
committed
Update tx-generator to not use deprecated cardano-api api
1 parent 4fa3e6c commit 24672d4

14 files changed

Lines changed: 333 additions & 374 deletions

File tree

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

Lines changed: 88 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,86 @@ 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+
let
492+
era = either (\deprecated -> error $ "unsupported era: " ++ show deprecated) id
493+
$ sbeToEra shelleyBasedEra
494+
evaluate
495+
( obtainCommonConstraints era $
496+
let
497+
ledgerPParams =
498+
either (error . docToString . prettyError) id
499+
$ toLedgerPParams shelleyBasedEra protocolParameters
500+
501+
ledgerProtocolParameters :: LedgerProtocolParameters ConwayEra
502+
ledgerProtocolParameters =
503+
either (error . docToString . prettyError) id
504+
$ convertToLedgerProtocolParameters shelleyBasedEra protocolParameters
505+
506+
witness :: Witness WitCtxTxIn ConwayEra
507+
witness =
508+
fromMaybe (error "could not get PlutusScriptWitness")
509+
$ case script of
510+
ScriptInAnyLang lang (PlutusScript version script') -> do
511+
scriptLang <- scriptLanguageSupportedInEra shelleyBasedEra lang
512+
pure
513+
$ ScriptWitness ScriptWitnessForSpending
514+
$ PlutusScriptWitness
515+
scriptLang
516+
version
517+
(PScript script')
518+
(ScriptDatumForTxIn $ Just $ unsafeHashableScriptData $ ScriptDataNumber 0)
519+
redeemer
520+
(budgetUsedPerTxInput summary)
521+
_ -> Nothing
522+
523+
anyWitness =
524+
case legacyWitnessConversion AlonzoEraOnwardsConway [(WitTxIn (dummyTxIn 0), BuildTxWith witness)] of
525+
Right [(_, w)] -> w
526+
Right _ -> error "approximateTxProperties: unexpected witness conversion result"
527+
Left err -> error $ "approximateTxProperties: witness conversion failed: " ++ show err
528+
529+
expMetadata = case dummyMetadata of
530+
TxMetadataNone -> mempty
531+
TxMetadataInEra _ m -> m
532+
533+
-- build a dummy tx akin to what we'd get in the tx-generator's benchmarking workload;
534+
-- it just needs to be sufficient to get our approximations.
535+
txBodyContent =
536+
Exp.defaultTxBodyContent
537+
& Exp.setTxIns [(dummyTxIn 0, anyWitness)]
538+
& Exp.setTxInsCollateral [dummyTxIn 1]
539+
& Exp.setTxOuts [Exp.TxOut $ toShelleyTxOutAny shelleyBasedEra dummyTxOut]
540+
& Exp.setTxFee (Coin 1_000_000)
541+
& Exp.setTxMetadata expMetadata
542+
& Exp.setTxProtocolParams (unLedgerProtocolParameters ledgerProtocolParameters)
543+
544+
unsignedTx =
545+
either (\err -> error $ "approximateTxProperties: " ++ show err) id
546+
$ makeUnsignedTx era txBodyContent
547+
548+
witVKey = makeKeyWitness era unsignedTx (WitnessPaymentKey keyBenchmarkInputs)
549+
550+
dummyTx :: Tx ConwayEra
551+
dummyTx =
552+
case signTx era [] [witVKey] unsignedTx of
553+
SignedTx signedLedgerTx -> ShelleyTx shelleyBasedEra signedLedgerTx
554+
555+
-- Corresponds to the metadata inserted in benchmarking workloads, which is why it's needed for the estimate.
556+
-- default value taken from: `add_tx_size` in nix/nixos/tx-generator-service.nix
557+
dummyMetadata :: TxMetadataInEra ConwayEra
558+
dummyMetadata = either error id $ mkMetadata 100
559+
560+
-- just placeholders
561+
dummyTxIn ix = mkTxIn $ "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162#" <> textShow @Int ix
562+
dummyTxOut = TxOut (keyAddress (Testnet (NetworkMagic 42)) keyBenchmarkInputs) (lovelaceToTxOutValue shelleyBasedEra 1_000_000) TxOutDatumNone ReferenceScriptNone
563+
in
564+
summary
565+
{ projectedTxSize = Just $ txSizeInBytes dummyTx
566+
, projectedTxFee = Just $ Exp.evaluateTransactionFee ledgerPParams unsignedTx 2 0 0 -- 1 (script witness) + 1 (collateral) = 2
567+
}
568+
)
569+
`catch` \(SomeException e) -> do
570+
putStrLn $ "approximation failed: " ++ show e
571+
++ "\n--> using unmodified summary"
572+
pure summary
555573

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

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
{-# LANGUAGE RankNTypes #-}
55
{-# LANGUAGE RecordWildCards #-}
66
{-# LANGUAGE ScopedTypeVariables #-}
7+
{-# LANGUAGE TypeApplications #-}
78
{-# LANGUAGE UndecidableInstances #-}
89

910
{-# OPTIONS_GHC -Wno-all-missed-specialisations #-}
@@ -19,7 +20,8 @@ module Cardano.Benchmarking.GeneratorTx
1920
, waitBenchmark
2021
) where
2122

22-
import Cardano.Api hiding (txFee, label)
23+
import Cardano.Api hiding (label, txFee)
24+
import Cardano.Api.Experimental (IsEra, obtainCommonConstraints, useEra)
2325

2426
import Cardano.Benchmarking.GeneratorTx.NodeToNode
2527
import Cardano.Benchmarking.GeneratorTx.Submission
@@ -110,7 +112,7 @@ handleTxSubmissionClientError
110112
LogErrors -> traceWith traceSubmit $
111113
TraceBenchTxSubError (pack errDesc)
112114

113-
walletBenchmark :: forall era. IsShelleyBasedEra era
115+
walletBenchmark :: forall era. IsEra era
114116
=> Trace IO (TraceBenchTxSubmit TxId)
115117
-> Trace IO NodeToNodeSubmissionTrace
116118
-> ConnectClient
@@ -137,7 +139,7 @@ walletBenchmark
137139
_era
138140
count
139141
txSource
140-
= liftIO $ do
142+
= obtainCommonConstraints (useEra @era) $ liftIO $ do
141143
traceDebug "******* Tx generator, phase 2: pay to recipients *******"
142144

143145
let numTargets :: Natural = fromIntegral $ NE.length targets

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

Lines changed: 30 additions & 62 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# OPTIONS_GHC -Wno-deprecations #-}
21
{- HLINT ignore "Use camelCase" -}
32
{- HLINT ignore "Use uncurry" -}
43
{-# LANGUAGE GADTs #-}
@@ -8,12 +7,16 @@ module Cardano.Benchmarking.GeneratorTx.SizedMetadata
87
where
98

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

1214
import Cardano.TxGenerator.Utils
1315

1416
import Prelude
1517

1618
import qualified Data.ByteString as BS
19+
import Data.Either (fromRight)
1720
import Data.Function ((&))
1821
import qualified Data.Map.Strict as Map
1922
import Data.Word (Word64)
@@ -27,67 +30,31 @@ maxBSSize = 64
2730
-- Properties of the underlying/opaque CBOR encoding.
2831
assume_cbor_properties :: Bool
2932
assume_cbor_properties
30-
= prop_mapCostsShelley
31-
&& prop_mapCostsAllegra
32-
&& prop_mapCostsMary
33-
&& prop_mapCostsAlonzo
34-
&& prop_mapCostsBabbage
35-
&& prop_bsCostsShelley
36-
&& prop_bsCostsAllegra
37-
&& prop_bsCostsMary
38-
&& prop_bsCostsAlonzo
39-
&& prop_bsCostsBabbage
33+
= prop_mapCostsConway
34+
&& prop_mapCostsDijkstra
4035
&& prop_bsCostsConway
36+
&& prop_bsCostsDijkstra
4137

4238
-- The cost of map entries in metadata follows a step function.
4339
-- This assumes the map indices are [0..n].
44-
prop_mapCostsShelley :: Bool
45-
prop_mapCostsAllegra :: Bool
46-
prop_mapCostsMary :: Bool
47-
prop_mapCostsAlonzo :: Bool
48-
prop_mapCostsBabbage :: Bool
4940
prop_mapCostsConway :: Bool
5041
prop_mapCostsDijkstra :: Bool
51-
prop_mapCostsShelley = measureMapCosts AsShelleyEra == assumeMapCosts AsShelleyEra
52-
prop_mapCostsAllegra = measureMapCosts AsAllegraEra == assumeMapCosts AsAllegraEra
53-
prop_mapCostsMary = measureMapCosts AsMaryEra == assumeMapCosts AsMaryEra
54-
prop_mapCostsAlonzo = measureMapCosts AsAlonzoEra == assumeMapCosts AsAlonzoEra
55-
prop_mapCostsBabbage = measureMapCosts AsBabbageEra == assumeMapCosts AsBabbageEra
5642
prop_mapCostsConway = measureMapCosts AsConwayEra == assumeMapCosts AsConwayEra
5743
prop_mapCostsDijkstra = measureMapCosts AsDijkstraEra == assumeMapCosts AsDijkstraEra
5844

59-
assumeMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int]
45+
assumeMapCosts :: AsType era -> [Int]
6046
assumeMapCosts _proxy = stepFunction [
6147
( 1 , 0) -- An empty map of metadata has the same cost as TxMetadataNone.
62-
, ( 1 , firstEntry) -- Using Metadata costs 37 or 39 bytes (first map entry).
48+
, ( 1 , 42) -- Using Metadata costs 42 bytes (first map entry).
6349
, ( 22 , 2) -- The next 22 entries cost 2 bytes each.
6450
, ( 233 , 3) -- 233 entries at 3 bytes.
6551
, ( 744 , 4) -- 744 entries at 4 bytes.
6652
]
67-
where
68-
firstEntry = case shelleyBasedEra @era of
69-
ShelleyBasedEraShelley -> 37
70-
ShelleyBasedEraAllegra -> 39
71-
ShelleyBasedEraMary -> 39
72-
ShelleyBasedEraAlonzo -> 42
73-
ShelleyBasedEraBabbage -> 42
74-
ShelleyBasedEraConway -> 42
75-
ShelleyBasedEraDijkstra -> 42
7653

7754
-- Bytestring costs are not LINEAR !!
7855
-- Costs are piecewise linear for payload sizes [0..23] and [24..64].
79-
prop_bsCostsShelley :: Bool
80-
prop_bsCostsAllegra :: Bool
81-
prop_bsCostsMary :: Bool
82-
prop_bsCostsAlonzo :: Bool
83-
prop_bsCostsBabbage :: Bool
8456
prop_bsCostsConway :: Bool
8557
prop_bsCostsDijkstra :: Bool
86-
prop_bsCostsShelley = measureBSCosts AsShelleyEra == [37..60] ++ [62..102]
87-
prop_bsCostsAllegra = measureBSCosts AsAllegraEra == [39..62] ++ [64..104]
88-
prop_bsCostsMary = measureBSCosts AsMaryEra == [39..62] ++ [64..104]
89-
prop_bsCostsAlonzo = measureBSCosts AsAlonzoEra == [42..65] ++ [67..107]
90-
prop_bsCostsBabbage = measureBSCosts AsBabbageEra == [42..65] ++ [67..107]
9158
prop_bsCostsConway = measureBSCosts AsConwayEra == [42..65] ++ [67..107]
9259
prop_bsCostsDijkstra = measureBSCosts AsDijkstraEra == [42..65] ++ [67..107]
9360

@@ -97,7 +64,7 @@ stepFunction f = scanl1 (+) steps
9764

9865
-- Measure the cost of metadata map entries.
9966
-- This is the cost of the index with an empty BS as payload.
100-
measureMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int]
67+
measureMapCosts :: forall era . IsEra era => AsType era -> [Int]
10168
measureMapCosts era = map (metadataSize era . Just . replicateEmptyBS) [0..maxMapSize]
10269
where
10370
replicateEmptyBS :: Int -> TxMetadata
@@ -107,31 +74,32 @@ listMetadata :: [TxMetadataValue] -> TxMetadata
10774
listMetadata l = makeTransactionMetadata $ Map.fromList $ zip [0..] l
10875

10976
-- Cost of metadata with a single BS of size [0..maxBSSize].
110-
measureBSCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int]
77+
measureBSCosts :: forall era . IsEra era => AsType era -> [Int]
11178
measureBSCosts era = map (metadataSize era . Just . bsMetadata) [0..maxBSSize]
11279
where bsMetadata s = listMetadata [TxMetaBytes $ BS.replicate s 0]
11380

114-
metadataSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
81+
metadataSize :: forall era . IsEra era => AsType era -> Maybe TxMetadata -> Int
11582
metadataSize p m = dummyTxSize p m - dummyTxSize p Nothing
11683

117-
dummyTxSizeInEra :: IsShelleyBasedEra era => TxMetadataInEra era -> Int
118-
dummyTxSizeInEra metadata = case createTransactionBody shelleyBasedEra dummyTx of
119-
Right b -> BS.length $ serialiseToCBOR b
120-
Left err -> error $ "metaDataSize " ++ show err
84+
dummyTxSizeInEra :: forall era . IsEra era => TxMetadataInEra era -> Int
85+
dummyTxSizeInEra metadata = obtainCommonConstraints era $ BS.length $ serialiseToCBOR dummyTx
12186
where
122-
dummyTx = defaultTxBodyContent shelleyBasedEra
123-
& setTxIns
124-
[ ( mkTxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810#0"
125-
, BuildTxWith $ KeyWitness KeyWitnessForSpending
126-
)
127-
]
128-
& setTxFee (mkTxFee 0)
129-
& setTxValidityLowerBound TxValidityNoLowerBound
130-
& setTxValidityUpperBound (mkTxValidityUpperBound 0)
131-
& setTxMetadata metadata
132-
133-
dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
134-
dummyTxSize _p m = (dummyTxSizeInEra @era) $ metadataInEra m
87+
era = useEra @era
88+
expMetadata = case metadata of
89+
TxMetadataNone -> mempty
90+
TxMetadataInEra _ m -> m
91+
txBodyContent = Exp.defaultTxBodyContent
92+
& Exp.setTxIns [(mkTxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810#0", AnyKeyWitnessPlaceholder)]
93+
& Exp.setTxMetadata expMetadata
94+
dummyTx :: Tx era
95+
dummyTx = obtainCommonConstraints era $
96+
case signTx era [] [] unsignedTx of
97+
SignedTx signedLedgerTx -> ShelleyTx shelleyBasedEra signedLedgerTx
98+
where
99+
unsignedTx = fromRight (error "dummyTxSizeInEra: failed to create tx") $ makeUnsignedTx era txBodyContent
100+
101+
dummyTxSize :: forall era . IsEra era => AsType era -> Maybe TxMetadata -> Int
102+
dummyTxSize _p m = obtainCommonConstraints (useEra @era) $ dummyTxSizeInEra @era (metadataInEra m)
135103

136104
metadataInEra :: forall era . IsShelleyBasedEra era => Maybe TxMetadata -> TxMetadataInEra era
137105
metadataInEra Nothing = TxMetadataNone

0 commit comments

Comments
 (0)