diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 180e8864df0..a6aac1a835f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -12,7 +12,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Cardano.Benchmarking.Script.Core @@ -217,15 +216,12 @@ toMetadata sbe (Just payloadSize) = case mkMetadata sbe payloadSize of Left err -> error err submitAction :: ShelleyBasedEra sbe -> SubmitMode -> Generator -> TxGenTxParams -> ActionM () -submitAction sbe submitMode generator txParams = submitInEra sbe submitMode generator txParams - -submitInEra :: ShelleyBasedEra era -> SubmitMode -> Generator -> TxGenTxParams -> ActionM () -submitInEra sbe submitMode generator txParams = do +submitAction sbe submitMode generator txParams = do txStream <- evalGenerator sbe generator txParams case submitMode of NodeToNode _ -> error "NodeToNode deprecated: ToDo: remove" Benchmark nodes tpsRate txCount -> benchmarkTxStream sbe txStream nodes tpsRate txCount - LocalSocket -> shelleyBasedEraConstraints sbe $ submitAll (void . localSubmitTx . Utils.mkTxInModeCardano) txStream + LocalSocket -> shelleyBasedEraConstraints sbe $ submitAll (void . localSubmitTx . TxInMode sbe) txStream DumpToFile filePath -> liftIO $ Streaming.writeFile filePath $ Streaming.map showTx txStream DiscardTX -> liftIO $ Streaming.mapM_ forceTx txStream where @@ -400,16 +396,16 @@ interpretPayMode sbe payMode = do , Text.unpack $ serialiseAddress $ Utils.keyAddress sbe networkId fundKey) PayToScript scriptSpec destWallet -> do walletRef <- getEnvWallets destWallet - (witness, script, scriptData, _scriptFee) <- makePlutusContext scriptSpec + (witness, script, scriptData, _scriptFee) <- makePlutusContext sbe scriptSpec case script of ScriptInAnyLang _ script' -> - return ( createAndStore (mkUTxOScript networkId (script, scriptData) witness) (mkWalletFundStore walletRef) + return ( createAndStore (mkUTxOScript sbe networkId (script, scriptData) witness) (mkWalletFundStore walletRef) , Text.unpack $ serialiseAddress $ makeShelleyAddress networkId (PaymentCredentialByScript $ hashScript script') NoStakeAddress ) -makePlutusContext :: forall era. IsShelleyBasedEra era - => ScriptSpec +makePlutusContext :: ShelleyBasedEra era + -> ScriptSpec -> ActionM (Witness WitCtxTxIn era, ScriptInAnyLang, ScriptData, L.Coin) -makePlutusContext ScriptSpec{..} = do +makePlutusContext sbe ScriptSpec{..} = do protocolParameters <- getProtocolParameters script <- liftIOSafe $ Plutus.readPlutusScript scriptSpecFile @@ -483,9 +479,8 @@ makePlutusContext ScriptSpec{..} = do case script of ScriptInAnyLang lang (PlutusScript version script') -> let - scriptWitness :: ScriptWitness WitCtxTxIn era - scriptWitness = case scriptLanguageSupportedInEra (shelleyBasedEra @era) lang of - Nothing -> error $ "runPlutusBenchmark: " ++ show version ++ " not supported in era: " ++ show (cardanoEra @era) + scriptWitness = case scriptLanguageSupportedInEra sbe lang of + Nothing -> error $ "runPlutusBenchmark: " ++ show version ++ " not supported in era: " ++ show sbe Just scriptLang -> PlutusScriptWitness scriptLang version diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Fund.hs b/bench/tx-generator/src/Cardano/TxGenerator/Fund.hs index a2235ac3b5a..1d0e1eb7fe6 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Fund.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Fund.hs @@ -1,6 +1,5 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-| Module : Cardano.TxGenerator.Fund Description : A type for funds to build transactions with. @@ -76,15 +75,14 @@ getFundCoin (Fund (InAnyCardanoEra _ a)) = case _fundVal a of -- TODO: facilitate casting KeyWitnesses between eras -- Note [Era transitions] -- | The `Fund` alternative is checked against `cardanoEra`, but -- `getFundWitness` otherwise wraps `_fundWitness`. -getFundWitness :: forall era. IsShelleyBasedEra era => Fund -> Witness WitCtxTxIn era -getFundWitness fund = case (cardanoEra @era, fund) of - (ByronEra , Fund (InAnyCardanoEra ByronEra a)) -> _fundWitness a - (ShelleyEra , Fund (InAnyCardanoEra ShelleyEra a)) -> _fundWitness a - (AllegraEra , Fund (InAnyCardanoEra AllegraEra a)) -> _fundWitness a - (MaryEra , Fund (InAnyCardanoEra MaryEra a)) -> _fundWitness a - (AlonzoEra , Fund (InAnyCardanoEra AlonzoEra a)) -> _fundWitness a - (BabbageEra , Fund (InAnyCardanoEra BabbageEra a)) -> _fundWitness a - (ConwayEra , Fund (InAnyCardanoEra ConwayEra a)) -> _fundWitness a +getFundWitness :: ShelleyBasedEra era -> Fund -> Witness WitCtxTxIn era +getFundWitness sbe fund = case (sbe, fund) of + (ShelleyBasedEraShelley , Fund (InAnyCardanoEra ShelleyEra a)) -> _fundWitness a + (ShelleyBasedEraAllegra , Fund (InAnyCardanoEra AllegraEra a)) -> _fundWitness a + (ShelleyBasedEraMary , Fund (InAnyCardanoEra MaryEra a)) -> _fundWitness a + (ShelleyBasedEraAlonzo , Fund (InAnyCardanoEra AlonzoEra a)) -> _fundWitness a + (ShelleyBasedEraBabbage , Fund (InAnyCardanoEra BabbageEra a)) -> _fundWitness a + (ShelleyBasedEraConway , Fund (InAnyCardanoEra ConwayEra a)) -> _fundWitness a _ -> error "getFundWitness: era mismatch" {- diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs index 396f85b94e2..30b494056d1 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs @@ -172,7 +172,7 @@ genTx sbe ledgerParameters (collateral, collFunds) fee metadata inFunds outputs where allKeys = mapMaybe getFundKey $ inFunds ++ collFunds txBodyContent = shelleyBasedEraConstraints sbe $ defaultTxBodyContent sbe - & setTxIns (map (\f -> (getFundTxIn f, BuildTxWith $ getFundWitness f)) inFunds) + & setTxIns (map (\f -> (getFundTxIn f, BuildTxWith $ getFundWitness sbe f)) inFunds) & setTxInsCollateral collateral & setTxOuts outputs & setTxFee fee diff --git a/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs b/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs index b492ab9d1da..2d27a0cd36b 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs @@ -47,39 +47,39 @@ mkUTxOVariant sbe networkId key value } -- to be merged with mkUTxOVariant -mkUTxOScript :: forall era. - IsShelleyBasedEra era - => NetworkId +mkUTxOScript :: + ShelleyBasedEra era + -> NetworkId -> (ScriptInAnyLang, ScriptData) -> Witness WitCtxTxIn era -> ToUTxO era -mkUTxOScript networkId (script, txOutDatum) witness value +mkUTxOScript sbe networkId (script, txOutDatum) witness value = ( mkTxOut value , mkNewFund value ) where plutusScriptAddr = case script of ScriptInAnyLang lang script' -> - case scriptLanguageSupportedInEra (shelleyBasedEra @era) lang of + case scriptLanguageSupportedInEra sbe lang of Nothing -> error "mkUtxOScript: scriptLanguageSupportedInEra==Nothing" Just{} -> makeShelleyAddressInEra - (shelleyBasedEra @era) + sbe networkId (PaymentCredentialByScript $ hashScript script') NoStakeAddress - mkTxOut v = case forEraMaybeEon (cardanoEra @era) of + mkTxOut v = case forShelleyBasedEraMaybeEon sbe of Nothing -> error "mkUtxOScript: scriptDataSupportedInEra==Nothing" Just tag -> TxOut plutusScriptAddr - (lovelaceToTxOutValue (shelleyBasedEra @era) v) + (lovelaceToTxOutValue sbe v) (TxOutDatumHash tag $ hashScriptDataBytes $ unsafeHashableScriptData txOutDatum) ReferenceScriptNone mkNewFund :: L.Coin -> TxIx -> TxId -> Fund - mkNewFund val txIx txId = Fund $ InAnyCardanoEra (cardanoEra @era) $ FundInEra { + mkNewFund val txIx txId = shelleyBasedEraConstraints sbe $ Fund $ InAnyCardanoEra (toCardanoEra sbe) $ FundInEra { _fundTxIn = TxIn txId txIx , _fundWitness = witness - , _fundVal = lovelaceToTxOutValue (shelleyBasedEra @era) val + , _fundVal = lovelaceToTxOutValue sbe val , _fundSigningKey = Nothing } diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs index b99fea0d6cc..4fff8adc7c6 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {- Module : Cardano.TxGenerator.Utils @@ -74,8 +73,3 @@ mkTxFee = TxFeeExplicit mkTxValidityUpperBound :: ShelleyBasedEra era -> SlotNo -> TxValidityUpperBound era mkTxValidityUpperBound sbe slotNo = TxValidityUpperBound (fromJust $ forShelleyBasedEraMaybeEon sbe) (Just slotNo) - --- | `mkTxInModeCardano` never uses the `TxInByronSpecial` constructor --- because its type enforces it being a Shelley-based era. -mkTxInModeCardano :: IsShelleyBasedEra era => Tx era -> TxInMode -mkTxInModeCardano = TxInMode shelleyBasedEra