Skip to content

Commit f2c2a53

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

6 files changed

Lines changed: 102 additions & 70 deletions

File tree

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

Lines changed: 22 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,16 @@
1-
{-# OPTIONS_GHC -Wno-deprecations #-}
21
{- HLINT ignore "Use camelCase" -}
32
{- HLINT ignore "Use uncurry" -}
43
{-# LANGUAGE GADTs #-}
54
{-# LANGUAGE ScopedTypeVariables #-}
65
{-# LANGUAGE TypeApplications #-}
6+
77
module Cardano.Benchmarking.GeneratorTx.SizedMetadata
88
where
99

1010
import Cardano.Api
1111

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

1416
import Prelude
@@ -17,6 +19,7 @@ import qualified Data.ByteString as BS
1719
import Data.Function ((&))
1820
import qualified Data.Map.Strict as Map
1921
import Data.Word (Word64)
22+
import Lens.Micro ((.~), (^.))
2023

2124

2225
maxMapSize :: Int
@@ -114,21 +117,25 @@ measureBSCosts era = map (metadataSize era . Just . bsMetadata) [0..maxBSSize]
114117
metadataSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
115118
metadataSize p m = dummyTxSize p m - dummyTxSize p Nothing
116119

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
120+
dummyTxSizeInEra :: forall era. IsShelleyBasedEra era => TxMetadataInEra era -> Int
121+
dummyTxSizeInEra metadata =
122+
BS.length $ serialiseToCBOR dummyTx
121123
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
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
132139

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

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

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# OPTIONS_GHC -Wno-deprecations #-}
21
{-# LANGUAGE CPP #-}
32
{-# LANGUAGE ConstraintKinds #-}
43
{-# LANGUAGE DataKinds #-}
@@ -102,7 +101,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
102101
fail (T.unpack err)
103102
let (stillUnacked, acked) = L.splitAtEnd ack unAcked
104103
let newStats = stats { stsAcked = stsAcked stats + Ack ack }
105-
traceWith bmtr $ SubmissionClientDiscardAcknowledged (getTxId . getTxBody <$> acked)
104+
traceWith bmtr $ SubmissionClientDiscardAcknowledged (txIdFromTx <$> acked)
106105
return (txSource, UnAcked stillUnacked, newStats)
107106

108107
queueNewTxs :: [Tx era] -> LocalState era -> LocalState era
@@ -131,8 +130,8 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
131130
let stateC@(_, UnAcked outs , stats) = queueNewTxs newTxs stateB
132131

133132
traceWith tr $ idListTrace (ToAnnce newTxs) blocking
134-
traceWith bmtr $ SubmissionClientReplyTxIds (getTxId . getTxBody <$> newTxs)
135-
traceWith bmtr $ SubmissionClientUnAcked (getTxId . getTxBody <$> outs)
133+
traceWith bmtr $ SubmissionClientReplyTxIds (txIdFromTx <$> newTxs)
134+
traceWith bmtr $ SubmissionClientUnAcked (txIdFromTx <$> outs)
136135

137136
case blocking of
138137
SingBlocking -> case NE.nonEmpty newTxs of
@@ -156,12 +155,12 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
156155
reqTxIds = fmap fromGenTxId txIds
157156
traceWith tr $ ReqTxs (length reqTxIds)
158157
let UnAcked ua = unAcked
159-
uaIds = getTxId . getTxBody <$> ua
160-
(toSend, _retained) = L.partition ((`L.elem` reqTxIds) . getTxId . getTxBody) ua
158+
uaIds = txIdFromTx <$> ua
159+
(toSend, _retained) = L.partition ((`L.elem` reqTxIds) . txIdFromTx) ua
161160
missIds = reqTxIds L.\\ uaIds
162161

163162
traceWith tr $ TxList (length toSend)
164-
traceWith bmtr $ SubmissionClientUnAcked (getTxId . getTxBody <$> ua)
163+
traceWith bmtr $ SubmissionClientUnAcked (txIdFromTx <$> ua)
165164
traceWith bmtr $ TraceBenchTxSubServReq reqTxIds
166165
unless (L.null missIds) $
167166
traceWith bmtr $ TraceBenchTxSubServUnav missIds
@@ -191,6 +190,10 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
191190
fromGenTxId (Block.GenTxIdConway (Mempool.ShelleyTxId i)) = fromShelleyTxId i
192191
fromGenTxId _ = error "TODO: fix incomplete match"
193192

193+
txIdFromTx :: Tx era -> TxId
194+
txIdFromTx (ShelleyTx sbe tx) =
195+
shelleyBasedEraConstraints sbe $ fromShelleyTxId $ Ledger.txIdTxBody (tx ^. Ledger.bodyTxL)
196+
194197
tokIsBlocking :: SingBlockingStyle a -> Bool
195198
tokIsBlocking = \case
196199
SingBlocking -> True

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

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# OPTIONS_GHC -Wno-deprecations #-}
21
{- HLINT ignore "Reduce duplication" -}
32
{- HLINT ignore "Use uncurry" -}
43

@@ -39,6 +38,7 @@ import Cardano.Benchmarking.Version as Version
3938
import Cardano.Benchmarking.Wallet as Wallet
4039
import qualified Cardano.Ledger.Coin as L
4140
import qualified Cardano.Ledger.Core as Ledger
41+
import Cardano.Ledger.Tools (estimateMinFeeTx)
4242
import Cardano.Logging hiding (LocalSocket)
4343
import Cardano.TxGenerator.Fund as Fund
4444
import qualified Cardano.TxGenerator.FundQueue as FundQueue
@@ -354,10 +354,12 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do
354354
Right tx -> do
355355
let
356356
txSize = txSizeInBytes tx
357-
txFeeEstimate = case toLedgerPParams shelleyBasedEra protocolParameters of
358-
Left{} -> Nothing
359-
Right ledgerPParams -> Just $
360-
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
361363
traceDebug $ "Projected Tx size in bytes: " ++ show txSize
362364
traceDebug $ "Projected Tx fee in Coin: " ++ show txFeeEstimate
363365
-- 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 & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
1-
{-# OPTIONS_GHC -Wno-deprecations #-}
21
{-# LANGUAGE DerivingStrategies #-}
32
{-# LANGUAGE NamedFieldPuns #-}
43
{-# LANGUAGE RankNTypes #-}
54
{-# LANGUAGE ScopedTypeVariables #-}
65
{-# LANGUAGE TypeApplications #-}
76

7+
88
{- HLINT ignore "Use map with tuple-section" -}
99

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

2424
import qualified Cardano.Ledger.Coin as L
25+
import qualified Cardano.Ledger.Core as Ledger
26+
import Cardano.Ledger.Keys.WitVKey (WitVKey (WitVKey))
2527
import Cardano.Ledger.Shelley.API (Addr (..))
2628
import Cardano.TxGenerator.Fund
2729
import Cardano.TxGenerator.Types
2830
import Cardano.TxGenerator.Utils
2931
import Ouroboros.Consensus.Shelley.Node (validateGenesis)
3032

31-
import Data.Bifunctor (bimap, second)
33+
import Data.Bifunctor (second)
3234
import Data.Function ((&))
3335
import Data.List (find)
3436
import qualified Data.ListMap as ListMap (toList)
37+
import qualified Data.Set as Set
38+
import Lens.Micro ((.~), (^.))
3539

3640

3741
genesisValidate :: ShelleyGenesis -> Either String ()
@@ -106,12 +110,16 @@ genesisExpenditure networkId inputKey addr value fee ttl outputKey
106110
pseudoTxIn = genesisTxInput networkId inputKey
107111

108112
fund tx = FundInEra {
109-
_fundTxIn = TxIn (getTxId $ getTxBody tx) (TxIx 0)
113+
_fundTxIn = TxIn (txIdFromTx tx) (TxIx 0)
110114
, _fundWitness = KeyWitness KeyWitnessForSpending
111115
, _fundVal = value
112116
, _fundSigningKey = Just outputKey
113117
}
114118

119+
txIdFromTx :: Tx era -> TxId
120+
txIdFromTx (ShelleyTx sbe' tx') =
121+
shelleyBasedEraConstraints sbe' $ fromShelleyTxId $ Ledger.txIdTxBody (tx' ^. Ledger.bodyTxL)
122+
115123
mkGenesisTransaction :: forall era .
116124
IsShelleyBasedEra era
117125
=> SigningKey GenesisUTxOKey
@@ -120,18 +128,24 @@ mkGenesisTransaction :: forall era .
120128
-> [TxIn]
121129
-> [TxOut CtxTx era]
122130
-> Either TxGenError (Tx era)
123-
mkGenesisTransaction key ttl fee txins txouts
124-
= bimap
125-
ApiError
126-
(\b -> signShelleyTransaction (shelleyBasedEra @era) b [WitnessGenesisUTxOKey key])
127-
(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
128147
where
129-
txBodyContent = defaultTxBodyContent shelleyBasedEra
130-
& setTxIns (zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending)
131-
& setTxOuts txouts
132-
& setTxFee (mkTxFee fee)
133-
& setTxValidityLowerBound TxValidityNoLowerBound
134-
& setTxValidityUpperBound (mkTxValidityUpperBound ttl)
148+
sbe = shelleyBasedEra @era
135149

136150
castKey :: SigningKey PaymentKey -> SigningKey GenesisUTxOKey
137151
castKey (PaymentSigningKey skey) = GenesisUTxOSigningKey skey

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

Lines changed: 34 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,28 @@
1-
{-# OPTIONS_GHC -Wno-deprecations #-}
21
{-# LANGUAGE GADTs #-}
32
{-# LANGUAGE RankNTypes #-}
43
{-# LANGUAGE ScopedTypeVariables #-}
5-
{-# LANGUAGE TypeApplications #-}
4+
65

76
module Cardano.TxGenerator.Tx
87
(module Cardano.TxGenerator.Tx)
98
where
109

1110
import Cardano.Api hiding (txId)
1211

12+
import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
1313
import qualified Cardano.Ledger.Coin as L
14+
import qualified Cardano.Ledger.Core as Ledger
15+
import Cardano.Ledger.Keys.WitVKey (WitVKey (WitVKey))
1416
import Cardano.TxGenerator.Fund
1517
import Cardano.TxGenerator.Types
1618
import Cardano.TxGenerator.UTxO (ToUTxOList)
1719

18-
import Data.Bifunctor (bimap, second)
20+
import Data.Bifunctor (second)
1921
import qualified Data.ByteString as BS (length)
2022
import Data.Function ((&))
2123
import Data.Maybe (mapMaybe)
24+
import qualified Data.Set as Set
25+
import Lens.Micro ((.~), (^.))
2226

2327

2428
-- | 'CreateAndStore' is meant to represent building a transaction
@@ -166,22 +170,33 @@ genTx :: forall era. ()
166170
-> TxFee era
167171
-> TxMetadataInEra era
168172
-> TxGenerator era
169-
genTx sbe ledgerParameters (collateral, collFunds) fee metadata inFunds outputs
170-
= bimap
171-
ApiError
172-
(\b -> (signShelleyTransaction (shelleyBasedEra @era) b $ map WitnessPaymentKey allKeys, getTxId b))
173-
(createTransactionBody (shelleyBasedEra @era) txBodyContent)
174-
where
175-
allKeys = mapMaybe getFundKey $ inFunds ++ collFunds
176-
txBodyContent = defaultTxBodyContent sbe
177-
& setTxIns (map (\f -> (getFundTxIn f, BuildTxWith $ getFundWitness f)) inFunds)
178-
& setTxInsCollateral collateral
179-
& setTxOuts outputs
180-
& setTxFee fee
181-
& setTxValidityLowerBound TxValidityNoLowerBound
182-
& setTxValidityUpperBound (defaultTxValidityUpperBound sbe)
183-
& setTxMetadata metadata
184-
& 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)
185200

186201

187202
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)