Skip to content

Commit 9c60805

Browse files
MarcFontaineMarcFontaine
committed
breakup ToUTxO add ToUTxOList 
1 parent 4146fee commit 9c60805

File tree

3 files changed

+54
-31
lines changed

3 files changed

+54
-31
lines changed

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

+15-8
Original file line numberDiff line numberDiff line change
@@ -22,15 +22,24 @@ import Cardano.Benchmarking.Wallet
2222
import qualified Plutus.V1.Ledger.Api as Plutus
2323
import Plutus.V1.Ledger.Contexts (ScriptContext(..), ScriptPurpose(..), TxInfo(..), TxOutRef(..))
2424

25+
mkUTxOScriptList :: forall era.
26+
IsShelleyBasedEra era
27+
=> NetworkId
28+
-> (FilePath, Script PlutusScriptV1, ScriptData)
29+
-> Validity
30+
-> ToUTxOList era
31+
mkUTxOScriptList networkId (scriptFile, script, txOutDatum) validity
32+
= mapToUTxO $ repeat $ mkUTxOScript networkId (scriptFile, script, txOutDatum) validity
33+
2534
mkUTxOScript :: forall era.
26-
(IsCardanoEra era, IsShelleyBasedEra era)
35+
IsShelleyBasedEra era
2736
=> NetworkId
2837
-> (FilePath, Script PlutusScriptV1, ScriptData)
2938
-> Validity
3039
-> ToUTxO era
31-
mkUTxOScript networkId (scriptFile, script, txOutDatum) validity values
32-
= ( map mkTxOut values
33-
, newFunds
40+
mkUTxOScript networkId (scriptFile, script, txOutDatum) validity value
41+
= ( mkTxOut value
42+
, mkNewFund value
3443
)
3544
where
3645
plutusScriptAddr = makeShelleyAddressInEra
@@ -46,10 +55,8 @@ mkUTxOScript networkId (scriptFile, script, txOutDatum) validity values
4655
(TxOutDatumHash tag $ hashScriptData txOutDatum)
4756
ReferenceScriptNone
4857

49-
newFunds txId = zipWith (mkNewFund txId) [TxIx 0 ..] values
50-
51-
mkNewFund :: TxId -> TxIx -> Lovelace -> Fund
52-
mkNewFund txId txIx val = Fund $ InAnyCardanoEra (cardanoEra @ era) $ FundInEra {
58+
mkNewFund :: Lovelace -> TxIx -> TxId -> Fund
59+
mkNewFund val txIx txId = Fund $ InAnyCardanoEra (cardanoEra @ era) $ FundInEra {
5360
_fundTxIn = TxIn txId txIx
5461
, _fundVal = lovelaceToTxOutValue val
5562
, _fundSigningKey = Nothing

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

+8-8
Original file line numberDiff line numberDiff line change
@@ -281,8 +281,8 @@ runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) shape tps era
281281

282282
txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (mkFee (auxFee shape)) metadata (KeyWitness KeyWitnessForSpending)
283283

284-
toUTxO :: FundSet.Target -> FundSet.SeqNumber -> ToUTxO era
285-
toUTxO target seqNumber = Wallet.mkUTxO networkId fundKey (InFlight target seqNumber)
284+
toUTxO :: FundSet.Target -> FundSet.SeqNumber -> ToUTxOList era
285+
toUTxO target seqNumber = Wallet.mkUTxOList networkId fundKey (InFlight target seqNumber)
286286

287287
fundToStore = mkWalletFundStore walletRefDst
288288

@@ -409,8 +409,8 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc
409409

410410
fundToStore = mkWalletFundStore walletRefDst
411411

412-
toUTxO :: FundSet.Target -> FundSet.SeqNumber -> ToUTxO era
413-
toUTxO target seqNumber = Wallet.mkUTxO networkId fundKey (InFlight target seqNumber)
412+
toUTxO :: FundSet.Target -> FundSet.SeqNumber -> ToUTxOList era
413+
toUTxO target seqNumber = Wallet.mkUTxOList networkId fundKey (InFlight target seqNumber)
414414

415415
walletScript :: FundSet.Target -> WalletScript era
416416
walletScript = benchmarkWalletScript walletRefSrc txGenerator (NumberOfTxs $ auxTxCount extraArgs) (const fundSource) inToOut toUTxO fundToStore
@@ -478,23 +478,23 @@ createChangeInEra :: forall era. IsShelleyBasedEra era
478478
-> Int
479479
-> AsType era
480480
-> ActionM ()
481-
createChangeInEra sourceWallet dstWallet submitMode payMode value count era = do
481+
createChangeInEra sourceWallet dstWallet submitMode payMode value count _era = do
482482
networkId <- getUser TNetworkId
483483
walletRef <- getName dstWallet
484484
fee <- getUser TFee
485485
protocolParameters <- getProtocolParameters
486486
(toUTxO, addressMsg) <- case payMode of
487487
PayToAddr keyName -> do
488488
fundKey <- getName keyName
489-
return ( Wallet.mkUTxOVariant PlainOldFund networkId fundKey Confirmed
489+
return ( Wallet.mkUTxOVariantList PlainOldFund networkId fundKey Confirmed
490490
, Text.unpack $ serialiseAddress $ keyAddress @ era networkId fundKey)
491491
PayToCollateral keyName -> do
492492
fundKey <- getName keyName
493-
return ( Wallet.mkUTxOVariant CollateralFund networkId fundKey Confirmed
493+
return ( Wallet.mkUTxOVariantList CollateralFund networkId fundKey Confirmed
494494
, Text.unpack $ serialiseAddress $ keyAddress @ era networkId fundKey)
495495
PayToScript scriptFile scriptData -> do
496496
script <- liftIO $ PlutusExample.readScript scriptFile --TODO: this should throw a file-not-found-error !
497-
return ( PlutusExample.mkUTxOScript networkId (scriptFile, script, scriptData) Confirmed
497+
return ( PlutusExample.mkUTxOScriptList networkId (scriptFile, script, scriptData) Confirmed
498498
, Text.unpack $ serialiseAddress $ makeShelleyAddress networkId (PaymentCredentialByScript $ hashScript script) NoStakeAddress )
499499
let
500500
createCoins :: FundSet.FundSource -> [Lovelace] -> ActionM (Either String (TxInMode CardanoMode))

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

+31-15
Original file line numberDiff line numberDiff line change
@@ -18,9 +18,9 @@ import Cardano.Api.Shelley (ProtocolParameters, ReferenceScript(..))
1818
type WalletRef = MVar Wallet
1919

2020
type TxGenerator era = [Fund] -> [TxOut CtxTx era] -> Either String (Tx era, TxId)
21-
-- Todo: ToUTxO implicitly assumes that all outputs are of the same type (Plutus. normal, collateral).
22-
-- This is too special
23-
type ToUTxO era = [Lovelace] -> ([TxOut CtxTx era], TxId -> [Fund])
21+
type ToUTxOList era = [Lovelace] -> ([TxOut CtxTx era], TxId -> [Fund])
22+
23+
type ToUTxO era = Lovelace -> (TxOut CtxTx era, TxIx -> TxId -> Fund)
2424

2525
data Wallet = Wallet {
2626
walletSeqNumber :: !SeqNumber
@@ -80,7 +80,7 @@ sourceToStoreTransaction ::
8080
TxGenerator era
8181
-> FundSource
8282
-> ([Lovelace] -> [Lovelace])
83-
-> ToUTxO era
83+
-> ToUTxOList era
8484
-> FundToStore
8585
-> IO (Either String (Tx era))
8686
sourceToStoreTransaction txGenerator fundSource inToOut mkTxOut fundToStore = do
@@ -105,30 +105,46 @@ includeChange fee spend have = case compare changeValue 0 of
105105
LT -> error "genTX: Bad transaction: insufficient funds"
106106
where changeValue = sum have - sum spend - fee
107107

108-
mkUTxO :: forall era. IsShelleyBasedEra era
108+
mkUTxOList :: forall era. IsShelleyBasedEra era
109109
=> NetworkId
110110
-> SigningKey PaymentKey
111111
-> Validity
112-
-> ToUTxO era
113-
mkUTxO = mkUTxOVariant PlainOldFund
112+
-> ToUTxOList era
113+
mkUTxOList = mkUTxOVariantList PlainOldFund
114+
115+
mkUTxOVariantList :: forall era. IsShelleyBasedEra era
116+
=> Variant
117+
-> NetworkId
118+
-> SigningKey PaymentKey
119+
-> Validity
120+
-> ToUTxOList era
121+
mkUTxOVariantList variant networkId key validity
122+
= mapToUTxO $ repeat $ mkUTxOVariant variant networkId key validity
123+
124+
mapToUTxO :: [ ToUTxO era ]-> ToUTxOList era
125+
mapToUTxO fkts values
126+
= (outs, \txId -> map (\f -> f txId) fs)
127+
where
128+
(outs, fs) =unzip $ map worker $ zip3 fkts values [TxIx 0 ..]
129+
worker (toUTxO, value, idx)
130+
= let (o, f ) = toUTxO value
131+
in (o, f idx)
114132

115133
mkUTxOVariant :: forall era. IsShelleyBasedEra era
116134
=> Variant
117135
-> NetworkId
118136
-> SigningKey PaymentKey
119137
-> Validity
120138
-> ToUTxO era
121-
mkUTxOVariant variant networkId key validity values
122-
= ( map mkTxOut values
123-
, newFunds
139+
mkUTxOVariant variant networkId key validity value
140+
= ( mkTxOut value
141+
, mkNewFund value
124142
)
125143
where
126144
mkTxOut v = TxOut (keyAddress @ era networkId key) (lovelaceToTxOutValue v) TxOutDatumNone ReferenceScriptNone
127145

128-
newFunds txId = zipWith (mkNewFund txId) [TxIx 0 ..] values
129-
130-
mkNewFund :: TxId -> TxIx -> Lovelace -> Fund
131-
mkNewFund txId txIx val = Fund $ InAnyCardanoEra (cardanoEra @ era) $ FundInEra {
146+
mkNewFund :: Lovelace -> TxIx -> TxId -> Fund
147+
mkNewFund val txIx txId = Fund $ InAnyCardanoEra (cardanoEra @ era) $ FundInEra {
132148
_fundTxIn = TxIn txId txIx
133149
, _fundVal = lovelaceToTxOutValue val
134150
, _fundSigningKey = Just key
@@ -196,7 +212,7 @@ benchmarkWalletScript :: forall era .
196212
-> NumberOfTxs
197213
-> (Target -> FundSource)
198214
-> ([Lovelace] -> [Lovelace])
199-
-> (Target -> SeqNumber -> ToUTxO era)
215+
-> (Target -> SeqNumber -> ToUTxOList era)
200216
-> FundToStore
201217
-> Target
202218
-> WalletScript era

0 commit comments

Comments
 (0)