From 221a805ff9e86f5d06ecedd7fd8738eaefa79a49 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Thu, 23 Jan 2025 17:09:06 +0100 Subject: [PATCH] tx-generator: stop supporting Byron and use more recent API way to handle era --- .../src/Cardano/Benchmarking/Compiler.hs | 29 ++-- .../src/Cardano/Benchmarking/GeneratorTx.hs | 9 +- .../Benchmarking/GeneratorTx/SizedMetadata.hs | 80 ++++++----- .../GeneratorTx/SubmissionClient.hs | 14 +- .../src/Cardano/Benchmarking/Script/Action.hs | 8 +- .../src/Cardano/Benchmarking/Script/Core.hs | 125 ++++++++---------- .../Cardano/Benchmarking/Script/Selftest.hs | 8 +- .../src/Cardano/Benchmarking/Script/Types.hs | 4 +- .../src/Cardano/TxGenerator/Genesis.hs | 69 +++++----- .../src/Cardano/TxGenerator/PureExample.hs | 14 +- .../src/Cardano/TxGenerator/Tx.hs | 19 ++- .../src/Cardano/TxGenerator/UTxO.hs | 13 +- .../src/Cardano/TxGenerator/Utils.hs | 18 +-- 13 files changed, 203 insertions(+), 207 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index 6881f9ab428..f47d6db7a54 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs @@ -77,14 +77,24 @@ initConstants = do emit $ DefineSigningKey keyNameBenchmarkInputs keyBenchmarkInputs emit $ DefineSigningKey keyNameBenchmarkDone keyBenchmarkDone +-- TODO delete this function and replace 'AnyCardanoEra' by +-- 'AnyShelleyBasedEra' in 'NixServiceOption' +requireAnyShelleyBasedEra :: AnyCardanoEra -> Compiler AnyShelleyBasedEra +requireAnyShelleyBasedEra (AnyCardanoEra era) = + caseByronOrShelleyBasedEra + (throwCompileError $ SomeCompilerError "Byron era not supported") + (return . AnyShelleyBasedEra) + era + importGenesisFunds :: Compiler String importGenesisFunds = do logMsg "Importing Genesis Fund." wallet <- newWallet "genesis_wallet" era <- askNixOption _nix_era + sbe <- requireAnyShelleyBasedEra era txParams <- askNixOption txGenTxParams cmd1 (ReadSigningKey keyNameGenesisInputFund) _nix_sigKey - emit $ Submit era LocalSocket txParams $ SecureGenesis wallet keyNameGenesisInputFund keyNameTxGenFunds + emit $ Submit sbe LocalSocket txParams $ SecureGenesis wallet keyNameGenesisInputFund keyNameTxGenFunds delay logMsg "Importing Genesis Fund. Done." return wallet @@ -92,6 +102,7 @@ importGenesisFunds = do addCollaterals :: SrcWallet -> Compiler (Maybe String) addCollaterals src = do era <- askNixOption _nix_era + sbe <- requireAnyShelleyBasedEra era txParams <- askNixOption txGenTxParams isAnyPlutusMode >>= \case False -> return Nothing @@ -103,7 +114,7 @@ addCollaterals src = do (PayToAddr keyNameCollaterals collateralWallet) (PayToAddr keyNameTxGenFunds src) [ safeCollateral ] - emit $ Submit era LocalSocket txParams generator + emit $ Submit sbe LocalSocket txParams generator logMsg "Create collaterals. Done." return $ Just collateralWallet @@ -112,25 +123,26 @@ splittingPhase srcWallet = do tx_count <- askNixOption _nix_tx_count inputs_per_tx <- askNixOption _nix_inputs_per_tx era <- askNixOption _nix_era + sbe <- requireAnyShelleyBasedEra era txParams <- askNixOption txGenTxParams minValuePerInput <- _minValuePerInput <$> evilFeeMagic finalDest <- newWallet "final_split_wallet" splitSteps <- splitSequenceWalletNames srcWallet finalDest $ unfoldSplitSequence (txParamFee txParams) minValuePerInput (tx_count * inputs_per_tx) isPlutus <- isAnyPlutusMode - forM_ (init splitSteps) $ createChange txParams False False era - createChange txParams True isPlutus era $ last splitSteps + forM_ (init splitSteps) $ createChange sbe txParams False False + createChange sbe txParams True isPlutus $ last splitSteps return finalDest where - createChange :: TxGenTxParams -> Bool -> Bool -> AnyCardanoEra -> (SrcWallet, DstWallet, Split) -> Compiler () - createChange txParams isLastStep isPlutus era (src, dst, split) = do + createChange :: AnyShelleyBasedEra -> TxGenTxParams -> Bool -> Bool -> (SrcWallet, DstWallet, Split) -> Compiler () + createChange sbe txParams isLastStep isPlutus (src, dst, split) = do logMsg $ Text.pack $ "Splitting step: " ++ show split let valuePayMode = PayToAddr (if isLastStep then keyNameSplitPhase else keyNameBenchmarkInputs) dst payMode <- if isPlutus then plutusPayMode dst else return valuePayMode let generator = case split of SplitWithChange lovelace count -> Split src payMode (PayToAddr keyNameTxGenFunds src) $ replicate count lovelace FullSplits txCount -> Take txCount $ Cycle $ SplitN src payMode maxOutputsPerTx - emit $ Submit era LocalSocket txParams generator + emit $ Submit sbe LocalSocket txParams generator delay logMsg "Splitting step: Done" @@ -192,6 +204,7 @@ benchmarkingPhase wallet collateralWallet = do targetNodes <- askNixOption _nix_targetNodes tps <- askNixOption _nix_tps era <- askNixOption _nix_era + sbe <- requireAnyShelleyBasedEra era txCount <- askNixOption _nix_tx_count inputs <- askNixOption _nix_inputs_per_tx outputs <- askNixOption _nix_outputs_per_tx @@ -203,7 +216,7 @@ benchmarkingPhase wallet collateralWallet = do then LocalSocket else Benchmark targetNodes tps txCount generator = Take txCount $ Cycle $ NtoM wallet payMode inputs outputs (Just $ txParamAddTxSize txParams) collateralWallet - emit $ Submit era submitMode txParams generator + emit $ Submit sbe submitMode txParams generator unless debugMode $ do emit WaitBenchmark return doneWallet diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs index f87af0bfdfa..0c1ad23d9ed 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs @@ -110,14 +110,14 @@ handleTxSubmissionClientError LogErrors -> traceWith traceSubmit $ TraceBenchTxSubError (pack errDesc) -walletBenchmark :: forall era. IsShelleyBasedEra era - => Trace IO (TraceBenchTxSubmit TxId) +walletBenchmark :: () + => ShelleyBasedEra era + -> Trace IO (TraceBenchTxSubmit TxId) -> Trace IO NodeToNodeSubmissionTrace -> ConnectClient -> NonEmpty NodeDescription -> TPSRate -> SubmissionErrorPolicy - -> AsType era -- this is used in newTpsThrottle to limit the tx-count ! -- This should not be needed, the stream should do it itself (but it does not!) -> NumberOfTxs @@ -128,13 +128,13 @@ walletBenchmark :: forall era. IsShelleyBasedEra era -> TxStream IO era -> ExceptT TxGenError IO AsyncBenchmarkControl walletBenchmark + sbe traceSubmit traceN2N connectClient targets tpsRate errorPolicy - _era count txSource = liftIO $ do @@ -157,6 +157,7 @@ walletBenchmark abcWorkers <- forM asyncList \(reportRef, remoteInfo@(remoteName, remoteAddrInfo)) -> do let errorHandler = handleTxSubmissionClientError traceSubmit remoteInfo reportRef errorPolicy client = txSubmissionClient + sbe traceN2N traceSubmit (txStreamSource txStreamRef tpsThrottle) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs index e5a983f9ecd..a9912837e1f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs @@ -1,8 +1,6 @@ {- HLINT ignore "Use camelCase" -} {- HLINT ignore "Use uncurry" -} {-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} module Cardano.Benchmarking.GeneratorTx.SizedMetadata where @@ -46,15 +44,15 @@ prop_mapCostsMary :: Bool prop_mapCostsAlonzo :: Bool prop_mapCostsBabbage :: Bool prop_mapCostsConway :: Bool -prop_mapCostsShelley = measureMapCosts AsShelleyEra == assumeMapCosts AsShelleyEra -prop_mapCostsAllegra = measureMapCosts AsAllegraEra == assumeMapCosts AsAllegraEra -prop_mapCostsMary = measureMapCosts AsMaryEra == assumeMapCosts AsMaryEra -prop_mapCostsAlonzo = measureMapCosts AsAlonzoEra == assumeMapCosts AsAlonzoEra -prop_mapCostsBabbage = measureMapCosts AsBabbageEra == assumeMapCosts AsBabbageEra -prop_mapCostsConway = measureMapCosts AsConwayEra == assumeMapCosts AsConwayEra - -assumeMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int] -assumeMapCosts _proxy = stepFunction [ +prop_mapCostsShelley = measureMapCosts ShelleyBasedEraShelley == assumeMapCosts ShelleyBasedEraShelley +prop_mapCostsAllegra = measureMapCosts ShelleyBasedEraAllegra == assumeMapCosts ShelleyBasedEraAllegra +prop_mapCostsMary = measureMapCosts ShelleyBasedEraMary == assumeMapCosts ShelleyBasedEraMary +prop_mapCostsAlonzo = measureMapCosts ShelleyBasedEraAlonzo == assumeMapCosts ShelleyBasedEraAlonzo +prop_mapCostsBabbage = measureMapCosts ShelleyBasedEraBabbage == assumeMapCosts ShelleyBasedEraBabbage +prop_mapCostsConway = measureMapCosts ShelleyBasedEraConway == assumeMapCosts ShelleyBasedEraConway + +assumeMapCosts :: ShelleyBasedEra era -> [Int] +assumeMapCosts sbe = stepFunction [ ( 1 , 0) -- An empty map of metadata has the same cost as TxMetadataNone. , ( 1 , firstEntry) -- Using Metadata costs 37 or 39 bytes (first map entry). , ( 22 , 2) -- The next 22 entries cost 2 bytes each. @@ -62,7 +60,7 @@ assumeMapCosts _proxy = stepFunction [ , ( 744 , 4) -- 744 entries at 4 bytes. ] where - firstEntry = case shelleyBasedEra @era of + firstEntry = case sbe of ShelleyBasedEraShelley -> 37 ShelleyBasedEraAllegra -> 39 ShelleyBasedEraMary -> 39 @@ -78,12 +76,12 @@ prop_bsCostsMary :: Bool prop_bsCostsAlonzo :: Bool prop_bsCostsBabbage :: Bool prop_bsCostsConway :: Bool -prop_bsCostsShelley = measureBSCosts AsShelleyEra == [37..60] ++ [62..102] -prop_bsCostsAllegra = measureBSCosts AsAllegraEra == [39..62] ++ [64..104] -prop_bsCostsMary = measureBSCosts AsMaryEra == [39..62] ++ [64..104] -prop_bsCostsAlonzo = measureBSCosts AsAlonzoEra == [42..65] ++ [67..107] -prop_bsCostsBabbage = measureBSCosts AsBabbageEra == [42..65] ++ [67..107] -prop_bsCostsConway = measureBSCosts AsConwayEra == [42..65] ++ [67..107] +prop_bsCostsShelley = measureBSCosts ShelleyBasedEraShelley == [37..60] ++ [62..102] +prop_bsCostsAllegra = measureBSCosts ShelleyBasedEraAllegra == [39..62] ++ [64..104] +prop_bsCostsMary = measureBSCosts ShelleyBasedEraMary == [39..62] ++ [64..104] +prop_bsCostsAlonzo = measureBSCosts ShelleyBasedEraAlonzo == [42..65] ++ [67..107] +prop_bsCostsBabbage = measureBSCosts ShelleyBasedEraBabbage == [42..65] ++ [67..107] +prop_bsCostsConway = measureBSCosts ShelleyBasedEraConway == [42..65] ++ [67..107] stepFunction :: [(Int, Int)] -> [Int] stepFunction f = scanl1 (+) steps @@ -91,8 +89,8 @@ stepFunction f = scanl1 (+) steps -- Measure the cost of metadata map entries. -- This is the cost of the index with an empty BS as payload. -measureMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int] -measureMapCosts era = map (metadataSize era . Just . replicateEmptyBS) [0..maxMapSize] +measureMapCosts :: ShelleyBasedEra era -> [Int] +measureMapCosts sbe = map (metadataSize sbe . Just . replicateEmptyBS) [0..maxMapSize] where replicateEmptyBS :: Int -> TxMetadata replicateEmptyBS n = listMetadata $ replicate n $ TxMetaBytes BS.empty @@ -101,46 +99,44 @@ listMetadata :: [TxMetadataValue] -> TxMetadata listMetadata l = makeTransactionMetadata $ Map.fromList $ zip [0..] l -- Cost of metadata with a single BS of size [0..maxBSSize]. -measureBSCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int] -measureBSCosts era = map (metadataSize era . Just . bsMetadata) [0..maxBSSize] +measureBSCosts :: ShelleyBasedEra era -> [Int] +measureBSCosts sbe = map (metadataSize sbe . Just . bsMetadata) [0..maxBSSize] where bsMetadata s = listMetadata [TxMetaBytes $ BS.replicate s 0] -metadataSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int -metadataSize p m = dummyTxSize p m - dummyTxSize p Nothing +metadataSize :: ShelleyBasedEra era -> Maybe TxMetadata -> Int +metadataSize sbe m = dummyTxSize sbe m - dummyTxSize sbe Nothing -dummyTxSizeInEra :: IsShelleyBasedEra era => TxMetadataInEra era -> Int -dummyTxSizeInEra metadata = case createAndValidateTransactionBody shelleyBasedEra dummyTx of - Right b -> BS.length $ serialiseToCBOR b +dummyTxSizeInEra :: ShelleyBasedEra era -> TxMetadataInEra era -> Int +dummyTxSizeInEra sbe metadata = case createAndValidateTransactionBody sbe dummyTx of + Right b -> shelleyBasedEraConstraints sbe $ BS.length $ serialiseToCBOR b Left err -> error $ "metaDataSize " ++ show err where - dummyTx = defaultTxBodyContent shelleyBasedEra + dummyTx = defaultTxBodyContent sbe & setTxIns [ ( TxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810" (TxIx 0) , BuildTxWith $ KeyWitness KeyWitnessForSpending ) ] - & setTxFee (mkTxFee 0) + & setTxFee (mkTxFee sbe 0) & setTxValidityLowerBound TxValidityNoLowerBound - & setTxValidityUpperBound (mkTxValidityUpperBound 0) + & setTxValidityUpperBound (mkTxValidityUpperBound sbe 0) & setTxMetadata metadata -dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int -dummyTxSize _p m = (dummyTxSizeInEra @era) $ metadataInEra m +dummyTxSize :: ShelleyBasedEra era -> Maybe TxMetadata -> Int +dummyTxSize sbe m = dummyTxSizeInEra sbe $ metadataInEra sbe m -metadataInEra :: forall era . IsShelleyBasedEra era => Maybe TxMetadata -> TxMetadataInEra era -metadataInEra Nothing = TxMetadataNone -metadataInEra (Just m) = case forEraMaybeEon (cardanoEra @era) of - Nothing -> error "unreachable" - Just e -> TxMetadataInEra e m +metadataInEra :: ShelleyBasedEra era -> Maybe TxMetadata -> TxMetadataInEra era +metadataInEra _ Nothing = TxMetadataNone +metadataInEra sbe (Just m) = TxMetadataInEra sbe m -mkMetadata :: forall era . IsShelleyBasedEra era => Int -> Either String (TxMetadataInEra era) -mkMetadata 0 = Right $ metadataInEra Nothing -mkMetadata size +mkMetadata :: ShelleyBasedEra era -> Int -> Either String (TxMetadataInEra era) +mkMetadata sbe 0 = Right $ metadataInEra sbe Nothing +mkMetadata sbe size = if size < minSize then Left $ "Error : metadata must be 0 or at least " ++ show minSize ++ " bytes in this era." - else Right $ metadataInEra $ Just metadata + else Right $ metadataInEra sbe $ Just metadata where - minSize = case shelleyBasedEra @era of + minSize = case sbe of ShelleyBasedEraShelley -> 37 ShelleyBasedEraAllegra -> 39 ShelleyBasedEraMary -> 39 diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs index ef33626b5a0..7451b0a687e 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs @@ -86,16 +86,14 @@ type LocalState era = (TxSource era, UnAcked (Tx era), SubmissionThreadStats) type EndOfProtocolCallback m = SubmissionThreadStats -> m () txSubmissionClient - :: forall m era. - ( MonadIO m, MonadFail m - , IsShelleyBasedEra era - ) - => Trace m NodeToNodeSubmissionTrace + :: forall m era. ( MonadIO m, MonadFail m ) + => ShelleyBasedEra era + -> Trace m NodeToNodeSubmissionTrace -> Trace m (TraceBenchTxSubmit TxId) -> TxSource era -> EndOfProtocolCallback m -> TxSubmissionClient (GenTxId CardanoBlock) (GenTx CardanoBlock) m () -txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = +txSubmissionClient sbe tr bmtr initialTxSource endOfProtocolCallback = TxSubmissionClient $ pure $ client (initialTxSource, UnAcked [], SubmissionThreadStats 0 0 0) where @@ -181,11 +179,11 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = txToIdSize = (Mempool.txId . toGenTx) &&& (SizeInBytes . fromInteger . getTxSize) where getTxSize :: Tx era -> Integer - getTxSize (ShelleyTx sbe tx) = + getTxSize (ShelleyTx _ tx) = shelleyBasedEraConstraints sbe $ tx ^. Ledger.sizeTxF toGenTx :: Tx era -> GenTx CardanoBlock - toGenTx tx = toConsensusGenTx $ TxInMode shelleyBasedEra tx + toGenTx tx = toConsensusGenTx $ TxInMode sbe tx fromGenTxId :: GenTxId CardanoBlock -> TxId fromGenTxId (Block.GenTxIdShelley (Mempool.ShelleyTxId i)) = fromShelleyTxId i diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs index 3435fbddeb9..4e1e940d503 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs @@ -13,6 +13,8 @@ module Cardano.Benchmarking.Script.Action ) where +import Cardano.Api + import Cardano.Benchmarking.OuroborosImports as Core (protocolToNetworkId) import Cardano.Benchmarking.Script.Core import Cardano.Benchmarking.Script.Env @@ -21,8 +23,6 @@ import Cardano.Benchmarking.Tracer import Cardano.TxGenerator.Setup.NodeConfig import Cardano.TxGenerator.Types (TxGenError) -import Control.Monad.IO.Class -import Control.Monad.Trans.Except.Extra import qualified Data.Text as Text (unpack) @@ -43,9 +43,9 @@ action a = case a of StartProtocol configFile cardanoTracerSocket -> startProtocol configFile cardanoTracerSocket ReadSigningKey name filePath -> readSigningKey name filePath DefineSigningKey name descr -> defineSigningKey name descr - AddFund era wallet txIn lovelace keyName -> addFund era wallet txIn lovelace keyName + AddFund (AnyShelleyBasedEra sbe) wallet txIn lovelace keyName -> addFund sbe wallet txIn lovelace keyName Delay t -> delay t - Submit era submitMode txParams generator -> submitAction era submitMode generator txParams + Submit (AnyShelleyBasedEra sbe) submitMode txParams generator -> submitAction sbe submitMode generator txParams WaitBenchmark -> waitBenchmark CancelBenchmark -> cancelBenchmark WaitForEra era -> waitForEra era diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 90d0898cf22..180e8864df0 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -67,20 +67,6 @@ import qualified Data.Text as Text (unpack) import Streaming import qualified Streaming.Prelude as Streaming -liftCoreWithEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ExceptT TxGenError IO x) -> ActionM (Either TxGenError x) -liftCoreWithEra era coreCall = withEra era ( liftIO . runExceptT . coreCall) - -withEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ActionM x) -> ActionM x -withEra era action = do - case era of - AnyCardanoEra ConwayEra -> action AsConwayEra - AnyCardanoEra BabbageEra -> action AsBabbageEra - AnyCardanoEra AlonzoEra -> action AsAlonzoEra - AnyCardanoEra MaryEra -> action AsMaryEra - AnyCardanoEra AllegraEra -> action AsAllegraEra - AnyCardanoEra ShelleyEra -> action AsShelleyEra - AnyCardanoEra ByronEra -> error "byron not supported" - setProtocolParameters :: ProtocolParametersSource -> ActionM () setProtocolParameters s = case s of QueryLocalNode -> do @@ -98,14 +84,12 @@ readSigningKey name filePath = defineSigningKey :: String -> SigningKey PaymentKey -> ActionM () defineSigningKey = setEnvKeys -addFund :: AnyCardanoEra -> String -> TxIn -> L.Coin -> String -> ActionM () -addFund era wallet txIn lovelace keyName = do +addFund :: ShelleyBasedEra era -> String -> TxIn -> L.Coin -> String -> ActionM () +addFund sbe wallet txIn lovelace keyName = do fundKey <- getEnvKeys keyName - let - mkOutValue :: forall era. IsShelleyBasedEra era => AsType era -> ActionM (InAnyCardanoEra TxOutValue) - mkOutValue _ = return $ InAnyCardanoEra (cardanoEra @era) (lovelaceToTxOutValue (shelleyBasedEra @era) lovelace) - outValue <- withEra era mkOutValue - addFundToWallet wallet txIn outValue fundKey + let era = toCardanoEra sbe + outValue = inAnyCardanoEra era $ lovelaceToTxOutValue sbe lovelace + shelleyBasedEraConstraints sbe $ addFundToWallet wallet txIn outValue fundKey addFundToWallet :: String -> TxIn -> InAnyCardanoEra TxOutValue -> SigningKey PaymentKey -> ActionM () addFundToWallet wallet txIn outVal skey = do @@ -226,22 +210,22 @@ localSubmitTx tx = do -- Problem 1: When doing throwE $ ApiError msg logmessages get lost ! -- Problem 2: Workbench restarts the tx-generator -> this may be the reason for loss of messages -toMetadata :: forall era. IsShelleyBasedEra era => Maybe Int -> TxMetadataInEra era -toMetadata Nothing = TxMetadataNone -toMetadata (Just payloadSize) = case mkMetadata payloadSize of +toMetadata :: ShelleyBasedEra era -> Maybe Int -> TxMetadataInEra era +toMetadata _ Nothing = TxMetadataNone +toMetadata sbe (Just payloadSize) = case mkMetadata sbe payloadSize of Right m -> m Left err -> error err -submitAction :: AnyCardanoEra -> SubmitMode -> Generator -> TxGenTxParams -> ActionM () -submitAction era submitMode generator txParams = withEra era $ submitInEra submitMode generator txParams +submitAction :: ShelleyBasedEra sbe -> SubmitMode -> Generator -> TxGenTxParams -> ActionM () +submitAction sbe submitMode generator txParams = submitInEra sbe submitMode generator txParams -submitInEra :: forall era. IsShelleyBasedEra era => SubmitMode -> Generator -> TxGenTxParams -> AsType era -> ActionM () -submitInEra submitMode generator txParams era = do - txStream <- evalGenerator generator txParams era +submitInEra :: ShelleyBasedEra era -> SubmitMode -> Generator -> TxGenTxParams -> ActionM () +submitInEra sbe submitMode generator txParams = do + txStream <- evalGenerator sbe generator txParams case submitMode of NodeToNode _ -> error "NodeToNode deprecated: ToDo: remove" - Benchmark nodes tpsRate txCount -> benchmarkTxStream txStream nodes tpsRate txCount era - LocalSocket -> submitAll (void . localSubmitTx . Utils.mkTxInModeCardano) txStream + Benchmark nodes tpsRate txCount -> benchmarkTxStream sbe txStream nodes tpsRate txCount + LocalSocket -> shelleyBasedEraConstraints sbe $ submitAll (void . localSubmitTx . Utils.mkTxInModeCardano) txStream DumpToFile filePath -> liftIO $ Streaming.writeFile filePath $ Streaming.map showTx txStream DiscardTX -> liftIO $ Streaming.mapM_ forceTx txStream where @@ -260,30 +244,27 @@ submitInEra submitMode generator txParams era = do callback tx submitAll callback rest -benchmarkTxStream :: forall era. IsShelleyBasedEra era - => TxStream IO era +benchmarkTxStream :: () + => ShelleyBasedEra era + -> TxStream IO era -> TargetNodes -> TPSRate -> NumberOfTxs - -> AsType era -> ActionM () -benchmarkTxStream txStream targetNodes tps txCount era = do +benchmarkTxStream sbe txStream targetNodes tps txCount = do tracers <- getBenchTracers connectClient <- getConnectClient - let - coreCall :: AsType era -> ExceptT TxGenError IO AsyncBenchmarkControl - coreCall eraProxy = GeneratorTx.walletBenchmark (btTxSubmit_ tracers) (btN2N_ tracers) connectClient - targetNodes tps LogErrors eraProxy txCount txStream - ret <- liftIO $ runExceptT $ coreCall era + ret <- liftIO $ runExceptT $ GeneratorTx.walletBenchmark sbe (btTxSubmit_ tracers) (btN2N_ tracers) connectClient + targetNodes tps LogErrors txCount txStream case ret of Left err -> liftTxGenError err Right ctl -> setEnvThreads ctl -evalGenerator :: IsShelleyBasedEra era => Generator -> TxGenTxParams -> AsType era -> ActionM (TxStream IO era) -evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do +evalGenerator :: ShelleyBasedEra era -> Generator -> TxGenTxParams -> ActionM (TxStream IO era) +evalGenerator sbe generator txParams@TxGenTxParams{txParamFee = fee} = do networkId <- getEnvNetworkId protocolParameters <- getProtocolParameters - case convertToLedgerProtocolParameters shelleyBasedEra protocolParameters of + case convertToLedgerProtocolParameters sbe protocolParameters of Left err -> throwE (Env.TxGenError (ApiError err)) Right ledgerParameters -> case generator of @@ -293,7 +274,8 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do destWallet <- getEnvWallets wallet genesisKey <- getEnvKeys genesisKeyName (tx, fund) <- firstExceptT Env.TxGenError $ hoistEither $ - Genesis.genesisSecureInitialFund networkId genesis genesisKey destKey txParams + shelleyBasedEraConstraints sbe $ + Genesis.genesisSecureInitialFund sbe networkId genesis genesisKey destKey txParams let gen = do walletRefInsertFund destWallet fund @@ -307,14 +289,14 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do -- in 'sourceToStoreTransactionNew'. Split walletName payMode payModeChange coins -> do wallet <- getEnvWallets walletName - (toUTxO, addressOut) <- interpretPayMode payMode + (toUTxO, addressOut) <- interpretPayMode sbe payMode traceDebug $ "split output address : " ++ addressOut - (toUTxOChange, addressChange) <- interpretPayMode payModeChange + (toUTxOChange, addressChange) <- interpretPayMode sbe payModeChange traceDebug $ "split change address : " ++ addressChange let fundSource = walletSource wallet 1 inToOut = Utils.includeChange fee coins - txGenerator = genTx shelleyBasedEra ledgerParameters (TxInsCollateralNone, []) feeInEra TxMetadataNone + txGenerator = genTx sbe ledgerParameters (TxInsCollateralNone, []) feeInEra TxMetadataNone sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut $ mangleWithChange toUTxOChange toUTxO return $ Streaming.effect (Streaming.yield <$> sourceToStore) @@ -325,24 +307,24 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do -- the transaction assembled by 'sourceToStoreTransactionNew'. SplitN walletName payMode count -> do wallet <- getEnvWallets walletName - (toUTxO, addressOut) <- interpretPayMode payMode + (toUTxO, addressOut) <- interpretPayMode sbe payMode traceDebug $ "SplitN output address : " ++ addressOut let fundSource = walletSource wallet 1 inToOut = Utils.inputsToOutputsWithFee fee count - txGenerator = genTx shelleyBasedEra ledgerParameters (TxInsCollateralNone, []) feeInEra TxMetadataNone + txGenerator = genTx sbe ledgerParameters (TxInsCollateralNone, []) feeInEra TxMetadataNone sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut (mangle $ repeat toUTxO) return $ Streaming.effect (Streaming.yield <$> sourceToStore) NtoM walletName payMode inputs outputs metadataSize collateralWallet -> do wallet <- getEnvWallets walletName - collaterals <- selectCollateralFunds collateralWallet - (toUTxO, addressOut) <- interpretPayMode payMode + collaterals <- selectCollateralFunds sbe collateralWallet + (toUTxO, addressOut) <- interpretPayMode sbe payMode traceDebug $ "NtoM output address : " ++ addressOut let fundSource = walletSource wallet inputs inToOut = Utils.inputsToOutputsWithFee fee outputs - txGenerator = genTx shelleyBasedEra ledgerParameters collaterals feeInEra (toMetadata metadataSize) + txGenerator = genTx sbe ledgerParameters collaterals feeInEra (toMetadata sbe metadataSize) sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut (mangle $ repeat toUTxO) fundPreview <- liftIO $ walletPreview wallet inputs @@ -350,11 +332,11 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do Left err -> traceDebug $ "Error creating Tx preview: " ++ show err Right tx -> do let - txSize = txSizeInBytes tx - txFeeEstimate = case toLedgerPParams shelleyBasedEra protocolParameters of + txSize = txSizeInBytes sbe tx + txFeeEstimate = case toLedgerPParams sbe protocolParameters of Left{} -> Nothing Right ledgerPParams -> Just $ - evaluateTransactionFee shelleyBasedEra ledgerPParams (getTxBody tx) (fromIntegral $ inputs + 1) 0 0 -- 1 key witness per tx input + 1 collateral + evaluateTransactionFee sbe ledgerPParams (getTxBody tx) (fromIntegral $ inputs + 1) 0 0 -- 1 key witness per tx input + 1 collateral traceDebug $ "Projected Tx size in bytes: " ++ show txSize traceDebug $ "Projected Tx fee in Coin: " ++ show txFeeEstimate -- TODO: possibly emit a warning when (Just txFeeEstimate) is lower than specified by config in TxGenTxParams.txFee @@ -368,33 +350,34 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do return $ Streaming.effect (Streaming.yield <$> sourceToStore) Sequence l -> do - gList <- forM l $ \g -> evalGenerator g txParams era + gList <- forM l $ \g -> evalGenerator sbe g txParams return $ Streaming.for (Streaming.each gList) id - Cycle g -> Streaming.cycle <$> evalGenerator g txParams era + Cycle g -> Streaming.cycle <$> evalGenerator sbe g txParams - Take count g -> Streaming.take count <$> evalGenerator g txParams era + Take count g -> Streaming.take count <$> evalGenerator sbe g txParams RoundRobin l -> do - _gList <- forM l $ \g -> evalGenerator g txParams era + _gList <- forM l $ \g -> evalGenerator sbe g txParams error "return $ foldr1 Streaming.interleaves gList" OneOf _l -> error "todo: implement Quickcheck style oneOf generator" where - feeInEra = Utils.mkTxFee fee + feeInEra = Utils.mkTxFee sbe fee -selectCollateralFunds :: forall era. IsShelleyBasedEra era - => Maybe String +selectCollateralFunds :: () + => ShelleyBasedEra era + -> Maybe String -> ActionM (TxInsCollateral era, [FundQueue.Fund]) -selectCollateralFunds Nothing = return (TxInsCollateralNone, []) -selectCollateralFunds (Just walletName) = do +selectCollateralFunds _ Nothing = return (TxInsCollateralNone, []) +selectCollateralFunds sbe (Just walletName) = do cw <- getEnvWallets walletName collateralFunds <- liftIO ( askWalletRef cw FundQueue.toList ) >>= \case [] -> throwE $ WalletError "selectCollateralFunds: emptylist" l -> return l - case forEraMaybeEon (cardanoEra @era) of - Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show (cardanoEra @era) + case forShelleyBasedEraMaybeEon sbe of + Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show sbe Just p -> return (TxInsCollateral p $ map getFundTxIn collateralFunds, collateralFunds) dumpToFile :: FilePath -> TxInMode -> ActionM () @@ -406,15 +389,15 @@ dumpToFileIO filePath tx = appendFile filePath ('\n' : show tx) initWallet :: String -> ActionM () initWallet name = liftIO Wallet.initWallet >>= setEnvWallets name -interpretPayMode :: forall era. IsShelleyBasedEra era => PayMode -> ActionM (CreateAndStore IO era, String) -interpretPayMode payMode = do +interpretPayMode :: ShelleyBasedEra era -> PayMode -> ActionM (CreateAndStore IO era, String) +interpretPayMode sbe payMode = do networkId <- getEnvNetworkId - case payMode of + shelleyBasedEraConstraints sbe $ case payMode of PayToAddr keyName destWallet -> do fundKey <- getEnvKeys keyName walletRef <- getEnvWallets destWallet - return ( createAndStore (mkUTxOVariant networkId fundKey) (mkWalletFundStore walletRef) - , Text.unpack $ serialiseAddress $ Utils.keyAddress @era networkId fundKey) + return ( createAndStore (mkUTxOVariant sbe networkId fundKey) (mkWalletFundStore walletRef) + , Text.unpack $ serialiseAddress $ Utils.keyAddress sbe networkId fundKey) PayToScript scriptSpec destWallet -> do walletRef <- getEnvWallets destWallet (witness, script, scriptData, _scriptFee) <- makePlutusContext scriptSpec diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index 03677bbc69b..c4c10a02626 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -75,7 +75,7 @@ testScript protocolFile submitMode = , InitWallet splitWallet3 , InitWallet doneWallet , DefineSigningKey key skey - , AddFund era genesisWallet + , AddFund sbe genesisWallet (TxIn "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162" (TxIx 0)) (L.Coin 90000000000000) key , createChange genesisWallet splitWallet1 1 10 @@ -88,7 +88,7 @@ testScript protocolFile submitMode = , createChange splitWallet3 splitWallet3 300 30 -} - , Submit era submitMode txParams $ Take 4000 $ Cycle + , Submit sbe submitMode txParams $ Take 4000 $ Cycle $ NtoM splitWallet3 (PayToAddr key doneWallet) 2 2 Nothing Nothing ] where @@ -99,7 +99,7 @@ testScript protocolFile submitMode = , teDescription = fromString "Genesis Initial UTxO Signing Key" , teRawCBOR = "X \vl1~\182\201v(\152\250A\202\157h0\ETX\248h\153\171\SI/m\186\242D\228\NAK\182(&\162" } - era = AnyCardanoEra AllegraEra + sbe = AnyShelleyBasedEra ShelleyBasedEraAllegra txParams = defaultTxGenTxParams {txParamFee = 1000000} genesisWallet = "genesisWallet" splitWallet1 = "SplitWallet-1" @@ -109,4 +109,4 @@ testScript protocolFile submitMode = key = "pass-partout" createChange :: String -> String -> Int -> Int -> Action createChange src dest txCount outputs - = Submit era submitMode txParams $ Take txCount $ Cycle $ SplitN src (PayToAddr key dest) outputs + = Submit sbe submitMode txParams $ Take txCount $ Cycle $ SplitN src (PayToAddr key dest) outputs diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 7d1a68583cf..ad95fd7376f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -96,7 +96,7 @@ data Action where -- 'Cardano.Benchmarking.Wallet.walletRefInsertFund' which in turn -- is just 'Control.Concurrent.modifyMVar' around -- 'Cardano.TxGenerator.FundQueue.insert'. - AddFund :: !AnyCardanoEra -> !String -> !TxIn -> !L.Coin -> !String -> Action + AddFund :: !AnyShelleyBasedEra -> !String -> !TxIn -> !L.Coin -> !String -> Action -- | 'WaitBenchmark' signifies a 'Control.Concurrent.Async.waitCatch' -- on the 'Cardano.Benchmarking.GeneratorTx.AsyncBenchmarkControl' -- for the environment and also folds tracers into the completion. @@ -108,7 +108,7 @@ data Action where -- in turn wraps -- 'Cardano.Benchmarking.GeneratorTx.SubmissionClient.txSubmissionClient' -- and functions local to that like @requestTxs@. - Submit :: !AnyCardanoEra -> !SubmitMode -> !TxGenTxParams -> !Generator -> Action + Submit :: !AnyShelleyBasedEra -> !SubmitMode -> !TxGenTxParams -> !Generator -> Action -- | 'CancelBenchmark' wraps a callback from the -- 'Cardano.Benchmarking.GeneratorTx.AsyncBenchmarkControl' type, -- which is a shutdown action. diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs index af2194e2d31..a19f46bfcae 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs @@ -2,7 +2,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-} {- HLINT ignore "Use map" -} @@ -39,45 +39,46 @@ genesisValidate :: ShelleyGenesis -> Either String () genesisValidate = validateGenesis -genesisSecureInitialFund :: forall era. IsShelleyBasedEra era => - NetworkId +genesisSecureInitialFund :: () + => ShelleyBasedEra era + -> NetworkId -> ShelleyGenesis -> SigningKey PaymentKey -> SigningKey PaymentKey -> TxGenTxParams -> Either TxGenError (Tx era, Fund) -genesisSecureInitialFund networkId genesis srcKey destKey TxGenTxParams{txParamFee, txParamTTL} - = case genesisInitialFundForKey @era networkId genesis srcKey of +genesisSecureInitialFund sbe networkId genesis srcKey destKey TxGenTxParams{txParamFee, txParamTTL} + = case genesisInitialFundForKey sbe networkId genesis srcKey of Nothing -> Left $ TxGenError "genesisSecureInitialFund: no fund found for given key in genesis" Just (_, lovelace) -> - let - txOutValue :: TxOutValue era - txOutValue = lovelaceToTxOutValue (shelleyBasedEra @era) $ lovelace - txParamFee - in genesisExpenditure networkId srcKey destAddr txOutValue txParamFee txParamTTL destKey + let txOutValue = lovelaceToTxOutValue sbe $ lovelace - txParamFee + in genesisExpenditure sbe networkId srcKey destAddr txOutValue txParamFee txParamTTL destKey where - destAddr = keyAddress @era networkId destKey + destAddr = keyAddress sbe networkId destKey -genesisInitialFunds :: forall era. IsShelleyBasedEra era - => NetworkId +genesisInitialFunds :: () + => ShelleyBasedEra era + -> NetworkId -> ShelleyGenesis -> [(AddressInEra era, L.Coin)] -genesisInitialFunds networkId g - = [ ( shelleyAddressInEra (shelleyBasedEra @era) $ +genesisInitialFunds sbe networkId g + = [ ( shelleyAddressInEra sbe $ makeShelleyAddress networkId (fromShelleyPaymentCredential pcr) (fromShelleyStakeReference stref) , coin ) | (Addr _ pcr stref, coin) <- ListMap.toList $ sgInitialFunds g ] -genesisInitialFundForKey :: forall era. IsShelleyBasedEra era - => NetworkId +genesisInitialFundForKey :: () + => ShelleyBasedEra era + -> NetworkId -> ShelleyGenesis -> SigningKey PaymentKey -> Maybe (AddressInEra era, L.Coin) -genesisInitialFundForKey networkId genesis key - = find (isTxOutForKey . fst) (genesisInitialFunds networkId genesis) +genesisInitialFundForKey sbe networkId genesis key + = find isTxOutForKey $ genesisInitialFunds sbe networkId genesis where - isTxOutForKey = (keyAddress networkId key ==) + isTxOutForKey = (keyAddress sbe networkId key ==) . fst genesisTxInput :: NetworkId @@ -90,8 +91,8 @@ genesisTxInput networkId . castKey genesisExpenditure :: - IsShelleyBasedEra era - => NetworkId + ShelleyBasedEra era + -> NetworkId -> SigningKey PaymentKey -> AddressInEra era -> TxOutValue era @@ -99,10 +100,10 @@ genesisExpenditure :: -> SlotNo -> SigningKey PaymentKey -> Either TxGenError (Tx era, Fund) -genesisExpenditure networkId inputKey addr value fee ttl outputKey - = second (\tx -> (tx, Fund $ InAnyCardanoEra cardanoEra $ fund tx)) eTx +genesisExpenditure sbe networkId inputKey addr value fee ttl outputKey + = second (\tx -> (tx, shelleyBasedEraConstraints sbe $ Fund $ InAnyCardanoEra (toCardanoEra sbe) $ fund tx)) eTx where - eTx = mkGenesisTransaction (castKey inputKey) ttl fee [pseudoTxIn] [txout] + eTx = mkGenesisTransaction sbe (castKey inputKey) ttl fee [pseudoTxIn] [txout] txout = TxOut addr value TxOutDatumNone ReferenceScriptNone pseudoTxIn = genesisTxInput networkId inputKey @@ -113,26 +114,26 @@ genesisExpenditure networkId inputKey addr value fee ttl outputKey , _fundSigningKey = Just outputKey } -mkGenesisTransaction :: forall era . - IsShelleyBasedEra era - => SigningKey GenesisUTxOKey +mkGenesisTransaction :: + ShelleyBasedEra era + -> SigningKey GenesisUTxOKey -> SlotNo -> L.Coin -> [TxIn] -> [TxOut CtxTx era] -> Either TxGenError (Tx era) -mkGenesisTransaction key ttl fee txins txouts +mkGenesisTransaction sbe key ttl fee txins txouts = bimap ApiError - (\b -> signShelleyTransaction (shelleyBasedEra @era) b [WitnessGenesisUTxOKey key]) - (createAndValidateTransactionBody (shelleyBasedEra @era) txBodyContent) + (\b -> signShelleyTransaction sbe b [WitnessGenesisUTxOKey key]) + (createAndValidateTransactionBody sbe txBodyContent) where - txBodyContent = defaultTxBodyContent shelleyBasedEra - & setTxIns (zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending) + txBodyContent = defaultTxBodyContent sbe + & setTxIns (map (, BuildTxWith $ KeyWitness KeyWitnessForSpending) txins) & setTxOuts txouts - & setTxFee (mkTxFee fee) + & setTxFee (mkTxFee sbe fee) & setTxValidityLowerBound TxValidityNoLowerBound - & setTxValidityUpperBound (mkTxValidityUpperBound ttl) + & setTxValidityUpperBound (mkTxValidityUpperBound sbe ttl) castKey :: SigningKey PaymentKey -> SigningKey GenesisUTxOKey castKey (PaymentSigningKey skey) = GenesisUTxOSigningKey skey diff --git a/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs b/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs index ed4f27d63d9..a7b7baa6b49 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs @@ -102,11 +102,13 @@ generateTx TxEnvironment{..} where TxFeeExplicit _ fee = txEnvFee + sbe = ShelleyBasedEraBabbage + generator :: TxGenerator BabbageEra generator = - case convertToLedgerProtocolParameters shelleyBasedEra txEnvProtocolParams of + case convertToLedgerProtocolParameters sbe txEnvProtocolParams of Right ledgerParameters -> - genTx ShelleyBasedEraBabbage ledgerParameters collateralFunds txEnvFee txEnvMetadata + genTx sbe ledgerParameters collateralFunds txEnvFee txEnvMetadata Left err -> \_ _ -> Left (ApiError err) where -- collateralFunds are needed for Plutus transactions @@ -127,7 +129,7 @@ generateTx TxEnvironment{..} computeOutputValues = inputsToOutputsWithFee fee numOfOutputs where numOfOutputs = 2 - computeUTxO = mkUTxOVariant txEnvNetworkId signingKey + computeUTxO = mkUTxOVariant sbe txEnvNetworkId signingKey generateTxM :: @@ -153,9 +155,11 @@ generateTxPure TxEnvironment{..} inQueue inputs = toList inQueue TxFeeExplicit _ fee = txEnvFee + sbe = ShelleyBasedEraBabbage + generator :: TxGenerator BabbageEra generator = - case convertToLedgerProtocolParameters shelleyBasedEra txEnvProtocolParams of + case convertToLedgerProtocolParameters sbe txEnvProtocolParams of Right ledgerParameters -> genTx ShelleyBasedEraBabbage ledgerParameters collateralFunds txEnvFee txEnvMetadata Left err -> \_ _ -> Left (ApiError err) @@ -171,4 +175,4 @@ generateTxPure TxEnvironment{..} inQueue computeOutputValues = inputsToOutputsWithFee fee numOfOutputs where numOfOutputs = 2 - computeUTxO = mkUTxOVariant txEnvNetworkId signingKey + computeUTxO = mkUTxOVariant sbe txEnvNetworkId signingKey diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs index 0effcfdf4fa..396f85b94e2 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} module Cardano.TxGenerator.Tx (module Cardano.TxGenerator.Tx) @@ -158,8 +157,7 @@ sourceTransactionPreview txGenerator inputFunds valueSplitter toStore = -- module are all partial applications of this to its first 5 arguments. -- The 7th argument comes from 'TxGenerator' being a being a type alias -- for a function type -- of two arguments. -genTx :: forall era. () - => IsShelleyBasedEra era +genTx :: () => ShelleyBasedEra era -> LedgerProtocolParameters era -> (TxInsCollateral era, [Fund]) @@ -169,11 +167,11 @@ genTx :: forall era. () genTx sbe ledgerParameters (collateral, collFunds) fee metadata inFunds outputs = bimap ApiError - (\b -> (signShelleyTransaction (shelleyBasedEra @era) b $ map WitnessPaymentKey allKeys, getTxId b)) - (createAndValidateTransactionBody (shelleyBasedEra @era) txBodyContent) + (\b -> (signShelleyTransaction sbe b $ map WitnessPaymentKey allKeys, getTxId b)) + (createAndValidateTransactionBody sbe txBodyContent) where allKeys = mapMaybe getFundKey $ inFunds ++ collFunds - txBodyContent = defaultTxBodyContent sbe + txBodyContent = shelleyBasedEraConstraints sbe $ defaultTxBodyContent sbe & setTxIns (map (\f -> (getFundTxIn f, BuildTxWith $ getFundWitness f)) inFunds) & setTxInsCollateral collateral & setTxOuts outputs @@ -184,8 +182,9 @@ genTx sbe ledgerParameters (collateral, collFunds) fee metadata inFunds outputs & setTxProtocolParams (BuildTxWith (Just ledgerParameters)) -txSizeInBytes :: forall era. IsShelleyBasedEra era => - Tx era +txSizeInBytes :: + ShelleyBasedEra era + -> Tx era -> Int -txSizeInBytes - = BS.length . serialiseToCBOR +txSizeInBytes sbe tx = + shelleyBasedEraConstraints sbe $ BS.length $ serialiseToCBOR tx diff --git a/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs b/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs index 6eb93f471fa..b492ab9d1da 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs @@ -26,22 +26,23 @@ makeToUTxOList fkts values = let (o, f ) = toUTxO value in (o, f idx) -mkUTxOVariant :: forall era. IsShelleyBasedEra era - => NetworkId +mkUTxOVariant :: () + => ShelleyBasedEra era + -> NetworkId -> SigningKey PaymentKey -> ToUTxO era -mkUTxOVariant networkId key value +mkUTxOVariant sbe networkId key value = ( mkTxOut value , mkNewFund value ) where - mkTxOut v = TxOut (keyAddress @era networkId key) (lovelaceToTxOutValue (shelleyBasedEra @era) v) TxOutDatumNone ReferenceScriptNone + mkTxOut v = TxOut (keyAddress sbe networkId key) (lovelaceToTxOutValue sbe v) TxOutDatumNone 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 = KeyWitness KeyWitnessForSpending - , _fundVal = lovelaceToTxOutValue (shelleyBasedEra @era ) val + , _fundVal = lovelaceToTxOutValue sbe val , _fundSigningKey = Just key } diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs index 0631d1fc768..b99fea0d6cc 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs @@ -32,10 +32,10 @@ liftAnyEra f x = case x of InAnyCardanoEra ConwayEra a -> InAnyCardanoEra ConwayEra $ f a -- | `keyAddress` determines an address for the relevant era. -keyAddress :: forall era. IsShelleyBasedEra era => NetworkId -> SigningKey PaymentKey -> AddressInEra era -keyAddress networkId k +keyAddress :: ShelleyBasedEra era -> NetworkId -> SigningKey PaymentKey -> AddressInEra era +keyAddress sbe networkId k = makeShelleyAddressInEra - (shelleyBasedEra @era) + sbe networkId (PaymentCredentialByKey $ verificationKeyHash $ getVerificationKey k) NoStakeAddress @@ -66,14 +66,14 @@ includeChange fee spend have = case compare changeValue 0 of -- | `mkTxFee` reinterprets the `Either` returned by -- `txFeesExplicitInEra` with `TxFee` constructors. -mkTxFee :: IsShelleyBasedEra era => L.Coin -> TxFee era -mkTxFee = TxFeeExplicit shelleyBasedEra +mkTxFee :: ShelleyBasedEra era -> L.Coin -> TxFee era +mkTxFee = TxFeeExplicit -- | `mkTxValidityUpperBound` rules out needing the --- `TxValidityNoUpperBound` with the constraint of `IsShelleyBasedEra`. -mkTxValidityUpperBound :: forall era. IsShelleyBasedEra era => SlotNo -> TxValidityUpperBound era -mkTxValidityUpperBound slotNo = - TxValidityUpperBound (fromJust $ forEraMaybeEon (cardanoEra @era)) (Just slotNo) +-- `TxValidityNoUpperBound` with the `ShelleyBasedEra` witness. +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.