Skip to content

Commit ac6f315

Browse files
carbolymercarbolymer
committed
Update tx-generator to not use deprecated cardano-api api
1 parent 76848d4 commit ac6f315

6 files changed

Lines changed: 103 additions & 66 deletions

File tree

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

Lines changed: 23 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -3,11 +3,14 @@
33
{-# LANGUAGE GADTs #-}
44
{-# LANGUAGE ScopedTypeVariables #-}
55
{-# LANGUAGE TypeApplications #-}
6+
67
module Cardano.Benchmarking.GeneratorTx.SizedMetadata
78
where
89

910
import Cardano.Api
1011

12+
import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
13+
import qualified Cardano.Ledger.Core as L
1114
import Cardano.TxGenerator.Utils
1215

1316
import Prelude
@@ -16,6 +19,7 @@ import qualified Data.ByteString as BS
1619
import Data.Function ((&))
1720
import qualified Data.Map.Strict as Map
1821
import Data.Word (Word64)
22+
import Lens.Micro ((.~), (^.))
1923

2024

2125
maxMapSize :: Int
@@ -53,7 +57,7 @@ prop_mapCostsMary = measureMapCosts AsMaryEra == assumeMapCosts AsMaryE
5357
prop_mapCostsAlonzo = measureMapCosts AsAlonzoEra == assumeMapCosts AsAlonzoEra
5458
prop_mapCostsBabbage = measureMapCosts AsBabbageEra == assumeMapCosts AsBabbageEra
5559
prop_mapCostsConway = measureMapCosts AsConwayEra == assumeMapCosts AsConwayEra
56-
prop_mapCostsDijkstra = measureMapCosts AsDijkstraEra == assumeMapCosts AsDijkstraEra
60+
prop_mapCostsDijkstra = measureMapCosts AsDijkstraEra == assumeMapCosts AsDijkstraEra
5761

5862
assumeMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int]
5963
assumeMapCosts _proxy = stepFunction [
@@ -113,21 +117,25 @@ measureBSCosts era = map (metadataSize era . Just . bsMetadata) [0..maxBSSize]
113117
metadataSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
114118
metadataSize p m = dummyTxSize p m - dummyTxSize p Nothing
115119

116-
dummyTxSizeInEra :: IsShelleyBasedEra era => TxMetadataInEra era -> Int
117-
dummyTxSizeInEra metadata = case createTransactionBody shelleyBasedEra dummyTx of
118-
Right b -> BS.length $ serialiseToCBOR b
119-
Left err -> error $ "metaDataSize " ++ show err
120+
dummyTxSizeInEra :: forall era. IsShelleyBasedEra era => TxMetadataInEra era -> Int
121+
dummyTxSizeInEra metadata =
122+
BS.length $ serialiseToCBOR dummyTx
120123
where
121-
dummyTx = defaultTxBodyContent shelleyBasedEra
122-
& setTxIns
123-
[ ( mkTxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810#0"
124-
, BuildTxWith $ KeyWitness KeyWitnessForSpending
125-
)
126-
]
127-
& setTxFee (mkTxFee 0)
128-
& setTxValidityLowerBound TxValidityNoLowerBound
129-
& setTxValidityUpperBound (mkTxValidityUpperBound 0)
130-
& setTxMetadata metadata
124+
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)
134+
dummyTx :: Tx era
135+
dummyTx = shelleyBasedEraConstraints sbe $
136+
ShelleyTx sbe $
137+
L.mkBasicTx (ledgerTxBody ^. txBodyL)
138+
& L.auxDataTxL .~ maybeToStrictMaybe txAuxData
131139

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

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

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -106,7 +106,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
106106
fail (T.unpack err)
107107
let (stillUnacked, acked) = L.splitAtEnd ack unAcked
108108
let newStats = stats { stsAcked = stsAcked stats + Ack ack }
109-
traceWith bmtr $ SubmissionClientDiscardAcknowledged (getTxId . getTxBody <$> acked)
109+
traceWith bmtr $ SubmissionClientDiscardAcknowledged (txIdFromTx <$> acked)
110110
return (txSource, UnAcked stillUnacked, newStats)
111111

112112
queueNewTxs :: [Tx era] -> LocalState era -> LocalState era
@@ -135,8 +135,8 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
135135
let stateC@(_, UnAcked outs , stats) = queueNewTxs newTxs stateB
136136

137137
traceWith tr $ idListTrace (ToAnnce newTxs) blocking
138-
traceWith bmtr $ SubmissionClientReplyTxIds (getTxId . getTxBody <$> newTxs)
139-
traceWith bmtr $ SubmissionClientUnAcked (getTxId . getTxBody <$> outs)
138+
traceWith bmtr $ SubmissionClientReplyTxIds (txIdFromTx <$> newTxs)
139+
traceWith bmtr $ SubmissionClientUnAcked (txIdFromTx <$> outs)
140140

141141
case blocking of
142142
SingBlocking -> case NE.nonEmpty newTxs of
@@ -160,12 +160,12 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
160160
reqTxIds = fmap fromGenTxId txIds
161161
traceWith tr $ ReqTxs (length reqTxIds)
162162
let UnAcked ua = unAcked
163-
uaIds = getTxId . getTxBody <$> ua
164-
(toSend, _retained) = L.partition ((`L.elem` reqTxIds) . getTxId . getTxBody) ua
163+
uaIds = txIdFromTx <$> ua
164+
(toSend, _retained) = L.partition ((`L.elem` reqTxIds) . txIdFromTx) ua
165165
missIds = reqTxIds L.\\ uaIds
166166

167167
traceWith tr $ TxList (length toSend)
168-
traceWith bmtr $ SubmissionClientUnAcked (getTxId . getTxBody <$> ua)
168+
traceWith bmtr $ SubmissionClientUnAcked (txIdFromTx <$> ua)
169169
traceWith bmtr $ TraceBenchTxSubServReq reqTxIds
170170
unless (L.null missIds) $
171171
traceWith bmtr $ TraceBenchTxSubServUnav missIds
@@ -195,6 +195,10 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
195195
fromGenTxId (Block.GenTxIdConway (Mempool.ShelleyTxId i)) = fromShelleyTxId i
196196
fromGenTxId _ = error "TODO: fix incomplete match"
197197

198+
txIdFromTx :: Tx era -> TxId
199+
txIdFromTx (ShelleyTx sbe tx) =
200+
shelleyBasedEraConstraints sbe $ fromShelleyTxId $ Ledger.txIdTxBody (tx ^. Ledger.bodyTxL)
201+
198202
tokIsBlocking :: SingBlockingStyle a -> Bool
199203
tokIsBlocking = \case
200204
SingBlocking -> True

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

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ import Cardano.Benchmarking.Version as Version
3838
import Cardano.Benchmarking.Wallet as Wallet
3939
import qualified Cardano.Ledger.Coin as L
4040
import qualified Cardano.Ledger.Core as Ledger
41+
import Cardano.Ledger.Tools (estimateMinFeeTx)
4142
import Cardano.Logging hiding (LocalSocket)
4243
import Cardano.TxGenerator.Fund as Fund
4344
import qualified Cardano.TxGenerator.FundQueue as FundQueue
@@ -353,10 +354,12 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do
353354
Right tx -> do
354355
let
355356
txSize = txSizeInBytes tx
356-
txFeeEstimate = case toLedgerPParams shelleyBasedEra protocolParameters of
357-
Left{} -> Nothing
358-
Right ledgerPParams -> Just $
359-
evaluateTransactionFee shelleyBasedEra ledgerPParams (getTxBody tx) (fromIntegral $ inputs + 1) 0 0 -- 1 key witness per tx input + 1 collateral
357+
txFeeEstimate = case tx of
358+
ShelleyTx sbe ledgerTx -> shelleyBasedEraConstraints sbe $
359+
case toLedgerPParams sbe protocolParameters of
360+
Left{} -> Nothing
361+
Right ledgerPParams -> Just $
362+
estimateMinFeeTx ledgerPParams ledgerTx (inputs + 1) 0 0 -- 1 key witness per tx input + 1 collateral
360363
traceDebug $ "Projected Tx size in bytes: " ++ show txSize
361364
traceDebug $ "Projected Tx fee in Coin: " ++ show txFeeEstimate
362365
-- TODO: possibly emit a warning when (Just txFeeEstimate) is lower than specified by config in TxGenTxParams.txFee

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

Lines changed: 28 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
{-# LANGUAGE ScopedTypeVariables #-}
55
{-# LANGUAGE TypeApplications #-}
66

7+
78
{- HLINT ignore "Use map with tuple-section" -}
89

910
-- | This module provides means to secure funds that are given in genesis.
@@ -21,16 +22,20 @@ where
2122
import Cardano.Api hiding (ShelleyGenesis)
2223

2324
import qualified Cardano.Ledger.Coin as L
25+
import qualified Cardano.Ledger.Core as Ledger
26+
import Cardano.Ledger.Keys.WitVKey (WitVKey (WitVKey))
2427
import Cardano.Ledger.Shelley.API (Addr (..))
2528
import Cardano.TxGenerator.Fund
2629
import Cardano.TxGenerator.Types
2730
import Cardano.TxGenerator.Utils
2831
import Ouroboros.Consensus.Shelley.Node (validateGenesis)
2932

30-
import Data.Bifunctor (bimap, second)
33+
import Data.Bifunctor (second)
3134
import Data.Function ((&))
3235
import Data.List (find)
3336
import qualified Data.ListMap as ListMap (toList)
37+
import qualified Data.Set as Set
38+
import Lens.Micro ((.~), (^.))
3439

3540

3641
genesisValidate :: ShelleyGenesis -> Either String ()
@@ -105,12 +110,16 @@ genesisExpenditure networkId inputKey addr value fee ttl outputKey
105110
pseudoTxIn = genesisTxInput networkId inputKey
106111

107112
fund tx = FundInEra {
108-
_fundTxIn = TxIn (getTxId $ getTxBody tx) (TxIx 0)
113+
_fundTxIn = TxIn (txIdFromTx tx) (TxIx 0)
109114
, _fundWitness = KeyWitness KeyWitnessForSpending
110115
, _fundVal = value
111116
, _fundSigningKey = Just outputKey
112117
}
113118

119+
txIdFromTx :: Tx era -> TxId
120+
txIdFromTx (ShelleyTx sbe' tx') =
121+
shelleyBasedEraConstraints sbe' $ fromShelleyTxId $ Ledger.txIdTxBody (tx' ^. Ledger.bodyTxL)
122+
114123
mkGenesisTransaction :: forall era .
115124
IsShelleyBasedEra era
116125
=> SigningKey GenesisUTxOKey
@@ -119,18 +128,24 @@ mkGenesisTransaction :: forall era .
119128
-> [TxIn]
120129
-> [TxOut CtxTx era]
121130
-> Either TxGenError (Tx era)
122-
mkGenesisTransaction key ttl fee txins txouts
123-
= bimap
124-
ApiError
125-
(\b -> signShelleyTransaction (shelleyBasedEra @era) b [WitnessGenesisUTxOKey key])
126-
(createTransactionBody (shelleyBasedEra @era) txBodyContent)
131+
mkGenesisTransaction key ttl fee txins txouts =
132+
shelleyBasedEraConstraints sbe $
133+
let txInputs = zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending
134+
ledgerTxBody =
135+
mkCommonTxBody sbe txInputs txouts (mkTxFee fee) TxWithdrawalsNone Nothing
136+
& invalidHereAfterTxBodyL sbe .~ convValidityUpperBound sbe (mkTxValidityUpperBound ttl)
137+
rawBody = ledgerTxBody ^. txBodyL
138+
unsignedLedgerTx = Ledger.mkBasicTx rawBody
139+
txHash = Ledger.extractHash $ Ledger.hashAnnotated rawBody
140+
shelleySigningKey = toShelleySigningKey (WitnessGenesisUTxOKey key)
141+
witVKey = WitVKey
142+
(getShelleyKeyWitnessVerificationKey shelleySigningKey)
143+
(makeShelleySignature txHash shelleySigningKey)
144+
signedLedgerTx = unsignedLedgerTx
145+
& Ledger.witsTxL .~ (Ledger.mkBasicTxWits & Ledger.addrTxWitsL .~ Set.singleton witVKey)
146+
in Right $ ShelleyTx sbe signedLedgerTx
127147
where
128-
txBodyContent = defaultTxBodyContent shelleyBasedEra
129-
& setTxIns (zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending)
130-
& setTxOuts txouts
131-
& setTxFee (mkTxFee fee)
132-
& setTxValidityLowerBound TxValidityNoLowerBound
133-
& setTxValidityUpperBound (mkTxValidityUpperBound ttl)
148+
sbe = shelleyBasedEra @era
134149

135150
castKey :: SigningKey PaymentKey -> SigningKey GenesisUTxOKey
136151
castKey (PaymentSigningKey skey) = GenesisUTxOSigningKey skey

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

Lines changed: 34 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,23 +1,28 @@
11
{-# LANGUAGE GADTs #-}
22
{-# LANGUAGE RankNTypes #-}
33
{-# LANGUAGE ScopedTypeVariables #-}
4-
{-# LANGUAGE TypeApplications #-}
4+
55

66
module Cardano.TxGenerator.Tx
77
(module Cardano.TxGenerator.Tx)
88
where
99

1010
import Cardano.Api hiding (txId)
1111

12+
import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
1213
import qualified Cardano.Ledger.Coin as L
14+
import qualified Cardano.Ledger.Core as Ledger
15+
import Cardano.Ledger.Keys.WitVKey (WitVKey (WitVKey))
1316
import Cardano.TxGenerator.Fund
1417
import Cardano.TxGenerator.Types
1518
import Cardano.TxGenerator.UTxO (ToUTxOList)
1619

17-
import Data.Bifunctor (bimap, second)
20+
import Data.Bifunctor (second)
1821
import qualified Data.ByteString as BS (length)
1922
import Data.Function ((&))
2023
import Data.Maybe (mapMaybe)
24+
import qualified Data.Set as Set
25+
import Lens.Micro ((.~), (^.))
2126

2227

2328
-- | 'CreateAndStore' is meant to represent building a transaction
@@ -165,22 +170,33 @@ genTx :: forall era. ()
165170
-> TxFee era
166171
-> TxMetadataInEra era
167172
-> TxGenerator era
168-
genTx sbe ledgerParameters (collateral, collFunds) fee metadata inFunds outputs
169-
= bimap
170-
ApiError
171-
(\b -> (signShelleyTransaction (shelleyBasedEra @era) b $ map WitnessPaymentKey allKeys, getTxId b))
172-
(createTransactionBody (shelleyBasedEra @era) txBodyContent)
173-
where
174-
allKeys = mapMaybe getFundKey $ inFunds ++ collFunds
175-
txBodyContent = defaultTxBodyContent sbe
176-
& setTxIns (map (\f -> (getFundTxIn f, BuildTxWith $ getFundWitness f)) inFunds)
177-
& setTxInsCollateral collateral
178-
& setTxOuts outputs
179-
& setTxFee fee
180-
& setTxValidityLowerBound TxValidityNoLowerBound
181-
& setTxValidityUpperBound (defaultTxValidityUpperBound sbe)
182-
& setTxMetadata metadata
183-
& setTxProtocolParams (BuildTxWith (Just ledgerParameters))
173+
genTx sbe _ledgerParameters (collateral, collFunds) fee metadata inFunds outputs =
174+
shelleyBasedEraConstraints sbe $ do
175+
let allKeys = mapMaybe getFundKey $ inFunds ++ collFunds
176+
setCollateral = case collateral of
177+
TxInsCollateralNone -> id
178+
TxInsCollateral eon _ -> collateralInputsTxBodyL eon .~ convCollateralTxIns collateral
179+
txInputs = map (\f -> (getFundTxIn f, BuildTxWith $ getFundWitness f)) inFunds
180+
txAuxData = toAuxiliaryData sbe metadata TxAuxScriptsNone
181+
ledgerTxBody =
182+
mkCommonTxBody sbe txInputs outputs fee TxWithdrawalsNone txAuxData
183+
& invalidHereAfterTxBodyL sbe .~ convValidityUpperBound sbe (defaultTxValidityUpperBound sbe)
184+
& setCollateral
185+
rawBody = ledgerTxBody ^. txBodyL
186+
unsignedLedgerTx = Ledger.mkBasicTx rawBody
187+
txHash = Ledger.extractHash $ Ledger.hashAnnotated rawBody
188+
witVKeys = Set.fromList
189+
[ WitVKey
190+
(getShelleyKeyWitnessVerificationKey sk)
191+
(makeShelleySignature txHash sk)
192+
| sk <- map (toShelleySigningKey . WitnessPaymentKey) allKeys
193+
]
194+
signedLedgerTx = unsignedLedgerTx
195+
& Ledger.witsTxL .~ (Ledger.mkBasicTxWits & Ledger.addrTxWitsL .~ witVKeys)
196+
& Ledger.auxDataTxL .~ maybeToStrictMaybe txAuxData
197+
tx = ShelleyTx sbe signedLedgerTx
198+
txId = fromShelleyTxId $ Ledger.txIdTxBody rawBody
199+
Right (tx, txId)
184200

185201

186202
txSizeInBytes :: forall era. IsShelleyBasedEra era =>

‎bench/tx-generator/tx-generator.cabal‎

Lines changed: 1 addition & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -113,28 +113,20 @@ library
113113
, cardano-binary
114114
, cardano-cli ^>= 11.1
115115
, cardano-crypto-class
116-
, cardano-crypto-wrapper
117116
, cardano-data
118117
, cardano-diffusion ^>= 1.0
119118
, cardano-git-rev ^>= 0.2.2
120-
, cardano-ledger-alonzo
121119
, cardano-ledger-api
122-
, cardano-ledger-byron
123120
, cardano-ledger-core
124121
, cardano-node
125122
, cardano-prelude
126-
, cardano-strict-containers >=0.1
127123
, contra-tracer
128124
, cborg >= 0.2.2 && < 0.3
129125
, containers
130-
, constraints-extras
131126
, directory
132127
, dlist
133128
, extra
134129
, filepath
135-
, formatting
136-
, generic-monoid
137-
, ghc-prim
138130
, io-classes:{io-classes, strict-stm}
139131
, microlens
140132
, mtl
@@ -158,7 +150,6 @@ library
158150
, trace-forward
159151
, transformers
160152
, transformers-except
161-
, unordered-containers
162153
, yaml
163154
-- Needed by "Cardano.Api.Internal.ProtocolParameters" port.
164155
, either
@@ -195,12 +186,12 @@ executable calibrate-script
195186
, aeson
196187
, aeson-pretty
197188
, bytestring
189+
, cardano-api
198190
, containers
199191
, directory
200192
, extra
201193
, filepath
202194
, optparse-applicative
203-
, cardano-api
204195
, text
205196
, transformers
206197
, transformers-except

0 commit comments

Comments
 (0)